1 ! Copyright (C) 2012 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
4 USING: accessors arrays assocs destructors environment
5 formatting fry io io.streams.string io.styles kernel locals
6 math math.functions math.ranges math.vectors namespaces
7 sequences sequences.extras 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 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 -- string )
64 color>256color "\e[38;5;%sm" sprintf ;
66 : color>background ( color -- string )
67 color>256color "\e[48;5;%sm" sprintf ;
69 : font-styles ( font-style -- string )
73 { bold-italic "\e[1m\e[3m" }
76 TUPLE: 256color stream ;
78 C: <256color> 256color
80 M: 256color stream-write1 stream>> stream-write1 ;
81 M: 256color stream-write stream>> stream-write ;
82 M: 256color stream-flush stream>> stream-flush ;
83 M: 256color stream-nl stream>> stream-nl ;
85 M: 256color stream-format
87 [ foreground of [ color>foreground ] [ "" ] if* ]
88 [ background of [ color>background ] [ "" ] if* ]
89 [ font-style of [ font-styles ] [ "" ] if* ]
90 tri 3append [ "\e[0m" surround ] unless-empty
91 ] dip stream>> stream-write ;
93 M: 256color make-span-stream
94 swap <style-stream> <ignore-close-stream> ;
96 M: 256color make-block-stream
97 swap <style-stream> <ignore-close-stream> ;
99 ! FIXME: color codes take up formatting space
101 M: 256color stream-write-table
104 [ [ stream>> >string ] map ] map format-table
105 [ nl ] [ write ] interleave
106 ] with-output-stream* ;
108 M: 256color make-cell-stream
109 2drop <string-writer> <256color> ;
111 M: 256color dispose drop ;
115 : 256color-terminal? ( -- ? )
116 "TERM" os-env "-256color" tail? ;
118 : with-256color ( quot -- )
119 output-stream get <256color> swap with-output-stream* ; inline