add color>hex

found basically the same thing in the color-table extra, but this one can
round-trip an alpha channel.

diff --git a/basis/colors/colors-tests.factor b/basis/colors/colors-tests.factor
index e8e1763d3b804a187d6512744522cfc93f486fb9..18a69b2ad197ce9f37da692debfd88a908db2679 100644 (file)
--- a/basis/colors/colors-tests.factor
+++ b/basis/colors/colors-tests.factor
@@ -18,3 +18,8 @@ ${ "ABCDEF" hex>rgba } [ COLOR: #abcdef value>> ] unit-test
 ${ "cafebabe" hex>rgba } [ COLOR: #cafebabe value>> ] unit-test
 ${ "112233" hex>rgba } [ COLOR: #112233 value>> ] unit-test
 ${ "11223344" hex>rgba } [ COLOR: #11223344 value>> ] unit-test
+
+{ "#00000000" } [ transparent color>hex ] unit-test
+{ "#cafebabe" } [ COLOR: #cafebabe color>hex ] unit-test
+{ "#112233" } [ COLOR: #112233 color>hex ] unit-test
+{ "#11223344" } [ COLOR: #11223344 color>hex ] unit-test

diff --git a/basis/colors/colors.factor b/basis/colors/colors.factor
index 7b3844c3014b944ed5205e7dcd9172309b4e38d0..413b087f0cfe27a3d8bc67eef5b6d82520da53f4 100644 (file)
--- a/basis/colors/colors.factor
+++ b/basis/colors/colors.factor
@@ -71,8 +71,21 @@ ERROR: invalid-hex-color hex ;
         [ drop invalid-hex-color ]
     } case <rgba> ;
 
+: component>hex ( f -- s )
+    255 * round >integer >hex
+    2 CHAR: 0 pad-head ;
+
+: (color>hex) ( seq -- hex )
+    [ component>hex ] map concat
+    "#" prepend ;
+
 PRIVATE>
 
+: color>hex ( color -- hex )
+    [ >rgba-components 4array ] [ opaque? ] bi
+    [ but-last ] when
+    (color>hex) ;
+
 : named-colors ( -- keys ) colors keys ;
 
 ERROR: no-such-color name ;

diff --git a/extra/color-table/color-table.factor b/extra/color-table/color-table.factor
index 03914c67d3ab45d67958538dbefbe9bbd7301697..6f518eea56046a4ab4bb3a1abb34868cff4caee8 100644 (file)
--- a/extra/color-table/color-table.factor
+++ b/extra/color-table/color-table.factor
@@ -13,10 +13,6 @@ SINGLETON: color-renderer
 
 CONSTANT: full-block-string $[ 10 CHAR: full-block <string> ]
 
-: rgba>hex ( rgba -- hex )
-    [ red>> ] [ green>> ] [ blue>> ] tri
-    [ 255 * round >integer ] tri@ "%02X%02X%02X" sprintf ;
-
 PRIVATE>
 
 M: color-renderer filled-column
@@ -32,7 +28,7 @@ M: color-renderer row-columns
             [ red>> "%.5f" sprintf ]
             [ green>> "%.5f" sprintf ]
             [ blue>> "%.5f" sprintf ]
-            [ rgba>hex ]
+            [ color>hex ]
         } cleave
     ] output>array ;