1 ! Copyright (C) 2008 Daniel Ehrenberg
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: math.parser arrays io.encodings sequences kernel assocs
4 hashtables io.encodings.ascii generic parser classes.tuple words
5 io io.files splitting namespaces math compiler.units accessors ;
15 { "latin/cyrillic" "8859-5" }
16 { "latin/arabic" "8859-6" }
17 { "latin/greek" "8859-7" }
18 { "latin/hebrew" "8859-8" }
20 { "latin6" "8859-10" }
21 { "latin/thai" "8859-11" }
22 { "latin7" "8859-13" }
23 { "latin8" "8859-14" }
24 { "latin9" "8859-15" }
25 { "latin10" "8859-16" }
27 { "windows-1252" "CP1252" }
29 { "mac-roman" "ROMAN" }
32 : encoding-file ( file-name -- stream )
33 "resource:basis/io/encodings/8-bit/" swap ".TXT"
34 3append ascii <file-reader> ;
36 : process-contents ( lines -- assoc )
37 [ "#" split1 drop ] map harvest
38 [ "\t" split 2 head [ 2 short tail hex> ] map ] map ;
40 : byte>ch ( assoc -- array )
41 256 replacement-char <array>
42 [ [ swapd set-nth ] curry assoc-each ] keep ;
44 : ch>byte ( assoc -- newassoc )
45 [ swap ] assoc-map >hashtable ;
47 : parse-file ( path -- byte>ch ch>byte )
48 lines process-contents
49 [ byte>ch ] [ ch>byte ] bi ;
51 SYMBOL: 8-bit-encodings
53 TUPLE: 8-bit decode encode ;
55 : encode-8-bit ( char stream assoc -- )
57 [ swap stream-write1 ] [ nip encode-error ] if ; inline
59 M: 8-bit encode-char encode>> encode-8-bit ;
61 : decode-8-bit ( stream array -- char/f )
63 [ swap nth [ replacement-char ] unless* ] [ 2drop f ] if ; inline
65 M: 8-bit decode-char decode>> decode-8-bit ;
67 PREDICATE: 8-bit-encoding < word
68 8-bit-encodings get-global key? ;
70 M: 8-bit-encoding <encoder>
71 8-bit-encodings get-global at <encoder> ;
73 M: 8-bit-encoding <decoder>
74 8-bit-encodings get-global at <decoder> ;
80 [ "io.encodings.8-bit" create ]
81 [ encoding-file parse-file 8-bit boa ]
84 [ keys [ define-symbol ] each ]
85 [ 8-bit-encodings set-global ]
87 ] with-compilation-unit