io.streams.ansi: faster by caching styles

[factor.git] / extra / io / streams / ansi / ansi.factor

diff --git a/extra/io/streams/ansi/ansi.factor b/extra/io/streams/ansi/ansi.factor
index 65c47c30690a0a74910bd54237918e3433e02f61..1717f1b6bdab2693dc6298ae3104fa3f72b191aa 100644 (file)
--- a/extra/io/streams/ansi/ansi.factor
+++ b/extra/io/streams/ansi/ansi.factor
@@ -1,12 +1,12 @@
 ! Copyright (C) 2014 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 math math.functions
-math.vectors namespaces sequences strings strings.tables ;
+USING: accessors arrays assocs destructors formatting io
+io.streams.escape-codes io.streams.string io.styles kernel math
+math.functions math.vectors namespaces sequences strings
+strings.tables ;
 
 IN: io.streams.ansi
-
 <PRIVATE
 
 CONSTANT: colors H{
@@ -41,35 +41,23 @@ CONSTANT: colors H{
     colors [ keys swap infimum-by ] [ at ] bi
     dup 8 >= [ 8 - t ] [ f ] if ;
 
-: color>foreground ( color -- string )
+MEMO: color>foreground ( color -- string )
     color>ansi [ 30 + ] [ "m" ";1m" ? ] bi* "\e[%d%s" sprintf ;
 
-: color>background ( color -- string )
+MEMO: color>background ( color -- string )
     color>ansi [ 40 + ] [ "m" ";1m" ? ] bi* "\e[%d%s" sprintf ;
 
-: font-styles ( font-style -- string )
-    H{
-        { bold "\e[1m" }
-        { italic "\e[3m" }
-        { bold-italic "\e[1m\e[3m" }
-    } at "" or ;
-
-TUPLE: ansi stream ;
+TUPLE: ansi < filter-writer ;
 
 C: <ansi> ansi
 
-M: ansi stream-write1 stream>> stream-write1 ;
-M: ansi stream-write stream>> stream-write ;
-M: ansi stream-flush stream>> stream-flush ;
-M: ansi stream-nl stream>> stream-nl ;
-
-M: ansi stream-format
-    [
-        [ foreground of [ color>foreground ] [ "" ] if* ]
-        [ background of [ color>background ] [ "" ] if* ]
-        [ font-style of [ font-styles ] [ "" ] if* ]
-        tri 3append [ "\e[0m" surround ] unless-empty
-    ] dip stream>> stream-write ;
+M:: ansi 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: ansi make-span-stream
     swap <style-stream> <ignore-close-stream> ;