1 ! Copyright (C) 2010 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
4 USING: accessors colors combinators formatting grouping kernel
5 lexer math math.parser sequences vocabs.loader ;
9 ERROR: invalid-hex-color hex ;
11 : hex>rgba ( hex -- rgba )
13 { 6 [ 2 group [ hex> 255 /f ] map first3 1.0 ] }
14 { 8 [ 2 group [ hex> 255 /f ] map first4 ] }
15 { 3 [ [ digit> 15 /f ] { } map-as first3 1.0 ] }
16 { 4 [ [ digit> 15 /f ] { } map-as first4 ] }
17 [ drop invalid-hex-color ]
20 : rgba>hex ( rgba -- hex )
21 [ red>> ] [ green>> ] [ blue>> ] tri
22 [ 255 * >integer ] tri@ "%02X%02X%02X" sprintf ;
24 TUPLE: hex-color < color hex value ;
26 M: hex-color >rgba value>> >rgba ;
28 SYNTAX: HEXCOLOR: scan-token dup hex>rgba hex-color boa suffix! ;
30 { "colors.hex" "prettyprint" } "colors.hex.prettyprint" require-when