1 ! Copyright (C) 2014 John Benediktsson
2 ! See https://factorcode.org/license.txt for BSD license
4 USING: accessors arrays assocs destructors formatting io
5 io.streams.escape-codes io.streams.string io.styles kernel math
6 math.functions math.vectors namespaces sequences strings
14 ! System colors (8 colors)
24 ! "Bright" version of 8 colors
32 { { 255 255 255 } 15 }
35 : color>rgb ( color -- rgb )
36 [ red>> ] [ green>> ] [ blue>> ] tri
37 [ 255 * round >integer ] tri@ 3array ;
39 : color>ansi ( color -- ansi bold? )
40 color>rgb '[ _ distance ]
41 colors [ keys swap minimum-by ] [ at ] bi
42 dup 8 >= [ 8 - t ] [ f ] if ;
44 MEMO: color>foreground ( color -- string )
45 color>ansi [ 30 + ] [ "m" ";1m" ? ] bi* "\e[%d%s" sprintf ;
47 MEMO: color>background ( color -- string )
48 color>ansi [ 40 + ] [ "m" ";1m" ? ] bi* "\e[%d%s" sprintf ;
50 TUPLE: ansi < filter-writer ;
54 M:: ansi stream-format ( str style stream -- )
55 stream stream>> :> out
56 style foreground of [ color>foreground out stream-write t ] [ f ] if*
57 style background of [ color>background out stream-write drop t ] when*
58 style font-style of [ font-styles out stream-write drop t ] when*
60 [ "\e[0m" out stream-write ] when ;
62 M: ansi make-span-stream
63 swap <style-stream> <ignore-close-stream> ;
65 M: ansi make-block-stream
66 swap <style-stream> <ignore-close-stream> ;
68 ! FIXME: color codes take up formatting space
70 M: ansi stream-write-table
73 [ [ stream>> >string ] map ] map format-table
74 [ nl ] [ write ] interleave
75 ] with-output-stream* ;
77 M: ansi make-cell-stream
78 2drop <string-writer> <ansi> ;
80 M: ansi dispose drop ;
84 : with-ansi ( quot -- )
85 output-stream get <ansi> swap with-output-stream* ; inline