1 ! Copyright (C) 2009 Daniel Ehrenberg
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: io.encodings kernel sequences io simple-flat-file sets math
4 combinators.short-circuit io.binary values arrays assocs
5 locals accessors combinators biassocs byte-arrays parser ;
6 IN: io.encodings.iso2022
16 "vocab:io/encodings/iso2022/201.txt" flat-file>biassoc to: jis201
17 "vocab:io/encodings/iso2022/208.txt" flat-file>biassoc to: jis208
18 "vocab:io/encodings/iso2022/212.txt" flat-file>biassoc to: jis212
21 128 unique >biassoc to: ascii
23 TUPLE: iso2022-state type ;
25 : make-iso-coder ( encoding -- state )
26 drop ascii iso2022-state boa ;
29 make-iso-coder <encoder> ;
32 make-iso-coder <decoder> ;
34 << SYNTAX: ESC HEX: 16 suffix! ; >>
36 CONSTANT: switch-ascii B{ ESC CHAR: ( CHAR: B }
37 CONSTANT: switch-jis201 B{ ESC CHAR: ( CHAR: J }
38 CONSTANT: switch-jis208 B{ ESC CHAR: $ CHAR: B }
39 CONSTANT: switch-jis212 B{ ESC CHAR: $ CHAR: ( CHAR: D }
41 : find-type ( char -- code type )
43 { [ dup ascii value? ] [ drop switch-ascii ascii ] }
44 { [ dup jis201 value? ] [ drop switch-jis201 jis201 ] }
45 { [ dup jis208 value? ] [ drop switch-jis208 jis208 ] }
46 { [ dup jis212 value? ] [ drop switch-jis212 jis212 ] }
50 : stream-write-num ( num stream -- )
52 [ [ h>b/b swap 2byte-array ] dip stream-write ]
53 [ stream-write1 ] if ;
55 M:: iso2022-state encode-char ( char stream encoding -- )
56 char encoding type>> value? [
58 [ stream stream-write ]
59 [ encoding (>>type) ] bi*
61 char encoding type>> value-at stream stream-write-num ;
63 : read-escape ( stream -- type/f )
68 { CHAR: J [ jis201 ] }
74 { CHAR: @ [ drop jis208 ] } ! want: JIS X 0208-1978
75 { CHAR: B [ drop jis208 ] }
77 stream-read1 CHAR: D = jis212 f ?
85 : double-width? ( type -- ? )
86 { [ jis208 eq? ] [ jis212 eq? ] } 1|| ;
88 : finish-decode ( num encoding -- char )
89 type>> at replacement-char or ;
91 M:: iso2022-state decode-char ( stream encoding -- char )
96 stream encoding decode-char
97 ] [ replacement-char ] if*
101 encoding type>> double-width? [
103 [ 2byte-array be> encoding finish-decode ]
104 [ drop replacement-char ] if*
105 ] [ encoding finish-decode ] if