colors: some cleanup, adding ?named-color

diff --git a/basis/colors/colors.factor b/basis/colors/colors.factor
index e31f228779c011a224533517821414378b2bc991..8a9319445631ed188b16a9e01e89828a031ca4c6 100644 (file)
--- a/basis/colors/colors.factor
+++ b/basis/colors/colors.factor
@@ -72,26 +72,25 @@ ERROR: invalid-hex-color hex ;
     } case <rgba> ;
 
 : component>hex ( f -- s )
-    255 * round >integer >hex
-    2 CHAR: 0 pad-head ;
+    255 * round >integer >hex 2 CHAR: 0 pad-head ;
 
 : (color>hex) ( seq -- hex )
-    [ component>hex ] map concat
-    "#" prepend ;
+    [ component>hex ] map concat "#" prepend ;
 
 PRIVATE>
 
 : color>hex ( color -- hex )
-    [ >rgba-components 4array ] [ opaque? ] bi
-    [ but-last ] when
-    (color>hex) ;
+    >rgba-components dup 1 number=
+    [ drop 3array ] [ 4array ] if (color>hex) ;
 
 : named-colors ( -- keys ) colors keys ;
 
+: ?named-color ( name -- color/f ) colors at ;
+
 ERROR: no-such-color name ;
 
 : named-color ( name -- color )
-    [ colors at ] [ no-such-color ] ?unless ;
+    [ ?named-color ] [ no-such-color ] ?unless ;
 
 : parse-color ( str -- color )
     "#" ?head [ hex>rgba ] [ named-color ] if ;