]> gitweb.factorcode.org Git - factor.git/blob - basis/colors/constants/constants.factor
factor: qualifying blank?, random fixes, renamed test file
[factor.git] / basis / colors / constants / constants.factor
1 ! Copyright (C) 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel assocs math math.parser memoize io.encodings.utf8
4 io.files lexer parser colors sequences splitting ascii ;
5 IN: colors.constants
6
7 <PRIVATE
8
9 : parse-color ( line -- name color )
10     first4
11     [ [ string>number 255 /f ] tri@ 1.0 <rgba> ] dip
12     [ ascii:blank? ] trim-head H{ { CHAR: \s CHAR: - } } substitute swap ;
13
14 : parse-colors ( lines -- assoc )
15     [ "!" head? ] reject
16     [ 11 cut [ " \t" split harvest ] dip suffix ] map
17     [ parse-color ] H{ } map>assoc ;
18
19 MEMO: colors ( -- assoc )
20     "resource:basis/colors/constants/rgb.txt"
21     "resource:basis/colors/constants/factor-colors.txt"
22     "resource:basis/colors/constants/solarized-colors.txt"
23     [ utf8 file-lines parse-colors ] tri@ assoc-union assoc-union ;
24
25 PRIVATE>
26
27 : named-colors ( -- keys ) colors keys ;
28
29 ERROR: no-such-color name ;
30
31 : named-color ( name -- color )
32     dup colors at [ ] [ no-such-color ] ?if ;
33
34 SYNTAX: COLOR: scan-token named-color suffix! ;