io.streams.256color: adding a xterm-256color style stream.

slavapestov · Jul 23, 2012 · 2a087c5 · 2a087c5
1 parent 126a3e4
commit 2a087c5
Showing 1 changed file with 108 additions and 0 deletions.
diff --git a/extra/io/streams/256color/256color.factor 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
+
+<PRIVATE
+
+CONSTANT: intensities { 0x00 0x5F 0x87 0xAF 0xD7 0xFF }
+
+CONSTANT: 256colors H{
+
+    ! System colors (8 colors)
+    { {   0   0   0 } 0 }
+    { { 128   0   0 } 1 }
+    { {   0 128   0 } 2 }
+    { { 128 128   0 } 3 }
+    { {   0   0 128 } 4 }
+    { { 128   0 128 } 5 }
+    { {   0 128 128 } 6 }
+    { { 192 192 192 } 7 }
+
+    ! "Bright" version of 8 colors
+    { { 128 128 128 } 8 }
+    { { 255   0   0 } 9 }
+    { {   0 255   0 } 10 }
+    { { 255 255   0 } 11 }
+    { {   0   0 255 } 12 }
+    { { 255   0 255 } 13 }
+    { {   0 255 255 } 14 }
+    { { 255 255 255 } 15 }
+}
+
+! Add the RGB colors
+intensities [| r i |
+    intensities [| g j |
+        intensities [| b k |
+            i 36 * j 6 * + k + 16 +
+            r g b 3array
+            256colors set-at
+        ] each-index
+    ] each-index
+] each-index
+
+! Add the Grayscale colors
+0x08 0xee over - 10 /i 10 <range> [
+    [ 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 <style-stream> <ignore-close-stream> ;
+
+M: 256color make-block-stream
+    swap <style-stream> <ignore-close-stream> ;
+
+! 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 <string-writer> <256color> ;
+
+M: 256color dispose drop ;
+
+PRIVATE>
+
+: with-256color ( quot -- )
+    output-stream get <256color> swap with-output-stream* ; inline