]> gitweb.factorcode.org Git - factor.git/blobdiff - extra/io/streams/256color/256color.factor
io.streams.256color: faster by caching styles
[factor.git] / extra / io / streams / 256color / 256color.factor
index 6e030d2f8c75f1702dae9f8010f9216f13e8ccd1..6bce05a25d1ee31fc23d3984ab8a6924b496008b 100644 (file)
@@ -1,10 +1,10 @@
 ! 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 ;
+USING: accessors arrays assocs destructors environment
+formatting io io.streams.escape-codes io.streams.string
+io.styles kernel math math.functions math.vectors namespaces
+ranges sequences strings strings.tables ;
 
 IN: io.streams.256color
 
@@ -47,7 +47,7 @@ intensities [| r i |
 ] each-index
 
 ! Add the Grayscale colors
-0x08 0xee over - 10 /i 10 <range> [
+0x08 0xee 10 <range> [
     [ dup dup 3array ] dip 232 + swap
     256colors set-at
 ] each-index
@@ -60,27 +60,23 @@ intensities [| r i |
     color>rgb '[ _ distance ]
     256colors [ keys swap infimum-by ] [ at ] bi ;
 
-: color>foreground ( color -- str )
-    color>256color "\u00001b[38;5;%sm" sprintf ;
+MEMO: color>foreground ( color -- string )
+    color>256color "\e[38;5;%sm" sprintf ;
 
-: color>background ( color -- str )
-    color>256color "\u00001b[48;5;%sm" sprintf ;
+MEMO: color>background ( color -- string )
+    color>256color "\e[48;5;%sm" sprintf ;
 
-TUPLE: 256color stream ;
+TUPLE: 256color < filter-writer ;
 
 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 stream-format ( str style stream -- )
+    stream stream>> :> out
+    style foreground of [ color>foreground out stream-write t ] [ f ] if*
+    style background of [ color>background out stream-write t ] [ f ] if*
+    style font-style of [ font-styles out stream-write t ] [ f ] if*
+    or or [ "\e[0m" out stream-write ] unless
+    str out stream-write ;
 
 M: 256color make-span-stream
     swap <style-stream> <ignore-close-stream> ;
@@ -104,5 +100,8 @@ M: 256color dispose drop ;
 
 PRIVATE>
 
+: 256color-terminal? ( -- ? )
+    "TERM" os-env "-256color" tail? ;
+
 : with-256color ( quot -- )
     output-stream get <256color> swap with-output-stream* ; inline