diff --git a/extra/io/streams/256color/256color.factor b/extra/io/streams/256color/256color.factor new file mode 100644 index 0000000000..6e030d2f8c --- /dev/null +++ b/extra/io/streams/256color/256color.factor @@ -0,0 +1,108 @@ +! Copyright (C) 2012 John Benediktsson +! See http://factorcode.org/license.txt for BSD license + +USING: accessors arrays assocs destructors formatting fry io +io.streams.string io.styles kernel locals math math.functions +math.ranges math.vectors namespaces sequences sequences.extras +strings strings.tables ; + +IN: io.streams.256color + + [ + [ dup dup 3array ] dip 232 + swap + 256colors set-at +] each-index + +: color>rgb ( color -- rgb ) + [ red>> ] [ green>> ] [ blue>> ] tri + [ 255 * round >integer ] tri@ 3array ; + +: color>256color ( color -- 256color ) + color>rgb '[ _ distance ] + 256colors [ keys swap infimum-by ] [ at ] bi ; + +: color>foreground ( color -- str ) + color>256color "\u00001b[38;5;%sm" sprintf ; + +: color>background ( color -- str ) + color>256color "\u00001b[48;5;%sm" sprintf ; + +TUPLE: 256color stream ; + +C: <256color> 256color + +M: 256color stream-write1 stream>> stream-write1 ; +M: 256color stream-write stream>> stream-write ; +M: 256color stream-flush stream>> stream-flush ; +M: 256color stream-nl stream>> stream-nl ; + +M: 256color stream-format + [ + [ foreground swap at [ color>foreground ] [ "" ] if* ] + [ background swap at [ color>background ] [ "" ] if* ] + bi append "\u00001b[0m" surround + ] dip stream>> stream-write ; + +M: 256color make-span-stream + swap ; + +M: 256color make-block-stream + swap ; + +! FIXME: color codes take up formatting space + +M: 256color stream-write-table + [ + drop + [ [ stream>> >string ] map ] map format-table + [ nl ] [ write ] interleave + ] with-output-stream* ; + +M: 256color make-cell-stream + 2drop <256color> ; + +M: 256color dispose drop ; + +PRIVATE> + +: with-256color ( quot -- ) + output-stream get <256color> swap with-output-stream* ; inline