io.encodings.korean iso2022kr encode-char working...

db4
Yun, Jonghyouk 2009-03-01 02:24:03 +09:00
parent 5d70cdfd27
commit c763d92e12
1 changed files with 66 additions and 2 deletions

View File

@ -3,7 +3,8 @@
USING: assocs byte-arrays combinators io io.encodings USING: assocs byte-arrays combinators io io.encodings
io.encodings.ascii io.encodings.iana io.files kernel locals math io.encodings.ascii io.encodings.iana io.files kernel locals math
math.order math.parser values multiline sequences splitting math.order math.parser values multiline sequences splitting
values hashtables io.binary io.encodings.asian ; values hashtables io.binary io.encodings.asian math.ranges
namespaces ;
IN: io.encodings.korean IN: io.encodings.korean
@ -13,7 +14,8 @@ cp949 "EUC-KR" register-encoding
SINGLETON: johab SINGLETON: johab
! johab "JOHAB" register-encoding SINGLETON: iso2022kr
<PRIVATE <PRIVATE
@ -99,6 +101,68 @@ M: johab decode-char ( stream encoding -- char/f )
drop [ johab>unicode ] [ johab-1st? ] decode-char-mb ; drop [ johab>unicode ] [ johab-1st? ] decode-char-mb ;
! iso-2022-kr encodings
: shift-in ( -- c ) HEX: 0F ;
: shift-out ( -- c ) HEX: 0E ;
: designator ( -- s ) { CHAR: $ CHAR: \ CHAR: ) CHAR: C } ;
: GR-range ( -- r ) HEX: A1 HEX: FE [a,b] ;
: GL-range ( -- r ) HEX: 21 HEX: 7E [a,b] ;
: GR>GL ( -- assoc )
GR-range GL-range zip >hashtable ;
: GL>GR ( -- assoc )
GL-range GR-range zip >hashtable ;
SYMBOL: *iso2022kr-status*
H{ } *iso2022kr-status* set-global
: iso2022kr-stream-get-status ( stream -- so/si/f )
*iso2022kr-status* get-global swap at ;
: iso2022kr-stream-get-status* ( stream -- so/si )
iso2022kr-stream-get-status
[ shift-in ] unless* ;
:: iso2022kr-stream-set-status ( stream so/si -- )
so/si stream *iso2022kr-status* get-global set-at ;
: iso2022kr-stream-shift-out? ( stream -- ? )
iso2022kr-stream-get-status* shift-out = ;
M: iso2022kr encode-char ( char stream encoding -- )
drop
[let | stream [ ]
char [ ] |
char unicode>cp949 byte?
[
! if <SO> written, then enclose with <SI>.
stream iso2022kr-stream-shift-out?
[ shift-in 1byte-array stream stream-write ] [ ] if
! plain ascii
char 1byte-array stream stream-write
]
[
! if <SO> is closed, then start it.
stream iso2022kr-stream-shift-out? not
[ shift-out 1byte-array stream stream-write ] [ ] if
!
char unicode>cp949 h>b/b swap 2byte-array
! GR -> GL
[ GR>GL at ] map
!
stream stream-write
] if
] ;
PRIVATE> PRIVATE>