1 ! Copyright (C) 2014 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
4 USING: accessors arrays assocs destructors formatting io
5 io.streams.string io.styles kernel math math.functions
6 math.vectors namespaces sequences strings strings.tables ;
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 infimum-by ] [ at ] bi
42 dup 8 >= [ 8 - t ] [ f ] if ;
44 : color>foreground ( color -- string )
45 color>ansi [ 30 + ] [ "m" ";1m" ? ] bi* "\e[%d%s" sprintf ;
47 : color>background ( color -- string )
48 color>ansi [ 40 + ] [ "m" ";1m" ? ] bi* "\e[%d%s" sprintf ;
50 : font-styles ( font-style -- string )
54 { bold-italic "\e[1m\e[3m" }
57 TUPLE: ansi < filter-writer ;
63 [ foreground of [ color>foreground ] [ "" ] if* ]
64 [ background of [ color>background ] [ "" ] if* ]
65 [ font-style of [ font-styles ] [ "" ] if* ]
66 tri 3append [ "\e[0m" surround ] unless-empty
67 ] dip stream>> stream-write ;
69 M: ansi make-span-stream
70 swap <style-stream> <ignore-close-stream> ;
72 M: ansi make-block-stream
73 swap <style-stream> <ignore-close-stream> ;
75 ! FIXME: color codes take up formatting space
77 M: ansi stream-write-table
80 [ [ stream>> >string ] map ] map format-table
81 [ nl ] [ write ] interleave
82 ] with-output-stream* ;
84 M: ansi make-cell-stream
85 2drop <string-writer> <ansi> ;
87 M: ansi dispose drop ;
91 : with-ansi ( quot -- )
92 output-stream get <ansi> swap with-output-stream* ; inline