1 ! Copyright (C) 2009 Daniel Ehrenberg
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: sequences kernel io io.files combinators.short-circuit
4 math.order assocs io.encodings io.binary fry strings math
5 io.encodings.ascii arrays byte-arrays accessors splitting
6 math.parser biassocs io.encodings.iana namespaces
7 locals multiline combinators simple-flat-file ;
8 IN: io.encodings.shift-jis
12 shift-jis "Shift_JIS" register-encoding
14 SINGLETON: windows-31j
16 windows-31j "Windows-31J" register-encoding
20 SYMBOL: shift-jis-table
22 M: shift-jis <encoder> drop shift-jis-table get-global <encoder> ;
23 M: shift-jis <decoder> drop shift-jis-table get-global <decoder> ;
25 SYMBOL: windows-31j-table
27 M: windows-31j <encoder> drop windows-31j-table get-global <encoder> ;
28 M: windows-31j <decoder> drop windows-31j-table get-global <decoder> ;
32 : ch>jis ( ch tuple -- jis ) assoc>> value-at [ throw-encode-error ] unless* ;
33 : jis>ch ( jis tuple -- string ) assoc>> at replacement-char or ;
35 : make-jis ( filename -- jis )
36 flat-file>biassoc sift-values jis boa ;
38 "vocab:io/encodings/shift-jis/CP932.txt"
39 make-jis windows-31j-table set-global
41 "vocab:io/encodings/shift-jis/sjis-0208-1997-std.txt"
42 make-jis shift-jis-table set-global
44 : small? ( char -- ? )
45 ! ASCII range or single-byte halfwidth katakana
46 { [ 0 0x7F between? ] [ 0xA1 0xDF between? ] } 1|| ;
48 : write-halfword ( stream halfword -- )
49 h>b/b swap 2byte-array swap stream-write ;
54 [ swap stream-write1 ]
55 [ write-halfword ] if ;
58 swap dup stream-read1 [
59 dup small? [ nip swap jis>ch ] [
61 [ 2array be> swap jis>ch ]
62 [ 2drop replacement-char ] if*