1 ! Copyright (C) 2012 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
4 USING: accessors arrays assocs destructors formatting fry io
5 io.streams.string io.styles kernel locals math math.functions
6 math.ranges math.vectors namespaces sequences sequences.extras
7 strings strings.tables ;
9 IN: io.streams.256color
13 CONSTANT: intensities { 0x00 0x5F 0x87 0xAF 0xD7 0xFF }
15 CONSTANT: 256colors H{
17 ! System colors (8 colors)
27 ! "Bright" version of 8 colors
35 { { 255 255 255 } 15 }
42 i 36 * j 6 * + k + 16 +
49 ! Add the Grayscale colors
50 0x08 0xee over - 10 /i 10 <range> [
51 [ dup dup 3array ] dip 232 + swap
55 : color>rgb ( color -- rgb )
56 [ red>> ] [ green>> ] [ blue>> ] tri
57 [ 255 * round >integer ] tri@ 3array ;
59 : color>256color ( color -- 256color )
60 color>rgb '[ _ distance ]
61 256colors [ keys swap infimum-by ] [ at ] bi ;
63 : color>foreground ( color -- str )
64 color>256color "\u00001b[38;5;%sm" sprintf ;
66 : color>background ( color -- str )
67 color>256color "\u00001b[48;5;%sm" sprintf ;
69 TUPLE: 256color stream ;
71 C: <256color> 256color
73 M: 256color stream-write1 stream>> stream-write1 ;
74 M: 256color stream-write stream>> stream-write ;
75 M: 256color stream-flush stream>> stream-flush ;
76 M: 256color stream-nl stream>> stream-nl ;
78 M: 256color stream-format
80 [ foreground swap at [ color>foreground ] [ "" ] if* ]
81 [ background swap at [ color>background ] [ "" ] if* ]
82 bi append "\u00001b[0m" surround
83 ] dip stream>> stream-write ;
85 M: 256color make-span-stream
86 swap <style-stream> <ignore-close-stream> ;
88 M: 256color make-block-stream
89 swap <style-stream> <ignore-close-stream> ;
91 ! FIXME: color codes take up formatting space
93 M: 256color stream-write-table
96 [ [ stream>> >string ] map ] map format-table
97 [ nl ] [ write ] interleave
98 ] with-output-stream* ;
100 M: 256color make-cell-stream
101 2drop <string-writer> <256color> ;
103 M: 256color dispose drop ;
107 : with-256color ( quot -- )
108 output-stream get <256color> swap with-output-stream* ; inline