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