add color>hex

[factor.git] / basis / colors / colors.factor

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 ;