io.encodings.korean iso2022kr encode-char working...
parent
5d70cdfd27
commit
c763d92e12
|
@ -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>
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue