extra/colors/flex-hex/flex-hex.factor

   1 ! Copyright (C) 2013 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: colors.private grouping kernel lexer math regexp.classes
   5 sequences splitting ;
   6
   7 IN: colors.flex-hex
   8
   9 <PRIVATE
  10
  11 : hex-only ( str -- str' )
  12     [ dup hex-digit? [ drop CHAR: 0 ] unless ] map ;
  13
  14 : pad-length ( str -- n )
  15     length dup 3 mod [ 3 swap - + ] unless-zero ;
  16
  17 : three-groups ( str -- array )
  18     dup pad-length [ CHAR: 0 pad-tail ] [ 3 / group ] bi ;
  19
  20 : hex-rgb ( array -- array' )
  21     [
  22         8 short tail*
  23         2 short head
  24         2 CHAR: 0 pad-head
  25     ] map ;
  26
  27 PRIVATE>
  28
  29 : flex-hex ( str -- hex )
  30     "#" ?head drop hex-only three-groups hex-rgb "" join ;
  31
  32 : flex-hex>rgba ( str -- rgba )
  33     flex-hex hex>rgba ;
  34
  35 SYNTAX: FLEXHEXCOLOR: scan-token flex-hex>rgba suffix! ;