basis/unicode/script/script.factor

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