basis/unicode/script/script.factor

   1 USING: accessors values kernel sequences assocs io.files
   2 io.encodings ascii math.ranges io splitting math.parser
   3 namespaces make byte-arrays locals math sets io.encodings.ascii
   4 words compiler.units arrays interval-maps unicode.data ;
   5 IN: unicode.script
   6
   7 <PRIVATE
   8 VALUE: script-table
   9 SYMBOL: interned
  10
  11 : parse-script ( stream -- assoc )
  12     ! assoc is code point/range => name
  13     lines filter-comments [ split-; ] map ;
  14
  15 : range, ( value key -- )
  16     swap interned get
  17     [ name>> = ] with find nip 2array , ;
  18
  19 : expand-ranges ( assoc -- interval-map )
  20     [
  21         [
  22             CHAR: . pick member? [
  23                 swap ".." split1 [ hex> ] bi@ 2array
  24             ] [ swap hex> ] if range,
  25         ] assoc-each
  26     ] { } make <interval-map> ;
  27
  28 : >symbols ( strings -- symbols )
  29     [
  30         [ "unicode.script" create dup define-symbol ] map
  31     ] with-compilation-unit ;
  32
  33 : process-script ( ranges -- )
  34     dup values prune >symbols interned [
  35         expand-ranges to: script-table
  36     ] with-variable ;
  37
  38 : load-script ( -- )
  39     "resource:basis/unicode/script/Scripts.txt"
  40     ascii <file-reader> parse-script process-script ;
  41
  42 load-script
  43 PRIVATE>
  44
  45 SYMBOL: Unknown
  46
  47 : script-of ( char -- script )
  48     script-table interval-at [ Unknown ] unless* ;