basis/colors/constants/constants.factor

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