1 ! Copyright (C) 2009 Daniel Ehrenberg
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs biassocs byte-arrays combinators
4 combinators.short-circuit io io.binary io.encodings kernel
5 literals locals math namespaces sequences simple-flat-file ;
6 IN: io.encodings.iso2022
16 "vocab:io/encodings/iso2022/201.txt" load-codetable-file jis201 set-global
17 "vocab:io/encodings/iso2022/208.txt" load-codetable-file jis208 set-global
18 "vocab:io/encodings/iso2022/212.txt" load-codetable-file jis212 set-global
21 128 iota dup zip >biassoc ascii set-global
23 TUPLE: iso2022-state type ;
25 : make-iso-coder ( encoding -- state )
26 drop ascii get-global iso2022-state boa ;
29 make-iso-coder <encoder> ;
32 make-iso-coder <decoder> ;
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 get-global value? ] [ drop switch-ascii ascii get-global ] }
44 { [ dup jis201 get-global value? ] [ drop switch-jis201 jis201 get-global ] }
45 { [ dup jis208 get-global value? ] [ drop switch-jis208 jis208 get-global ] }
46 { [ dup jis212 get-global value? ] [ drop switch-jis212 jis212 get-global ] }
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 )
67 { CHAR: B [ ascii get-global ] }
68 { CHAR: J [ jis201 get-global ] }
74 { CHAR: @ [ drop jis208 get-global ] } ! want: JIS X 0208-1978
75 { CHAR: B [ drop jis208 get-global ] }
77 stream-read1 CHAR: D = jis212 get-global f ?
85 : double-width? ( type -- ? )
86 { [ jis208 get-global eq? ] [ jis212 get-global 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