version 1.35, 2008/02/12 16:44:58
|
version 1.37, 2008/11/23 21:09:55
|
Line 1
|
Line 1
|
\ UTF-8 handling 12dec04py |
\ UTF-8 handling 12dec04py |
|
|
\ Copyright (C) 2004,2005,2006,2007 Free Software Foundation, Inc. |
\ Copyright (C) 2004,2005,2006,2007,2008 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
Line 73 $80 Value max-single-byte
|
Line 73 $80 Value max-single-byte
|
Defer check-xy ' noop IS check-xy |
Defer check-xy ' noop IS check-xy |
|
|
: u8key ( -- u ) |
: u8key ( -- u ) |
defers key dup max-single-byte u< ?EXIT \ special case ASCII |
key dup max-single-byte u< ?EXIT \ special case ASCII |
dup $FF = ?EXIT \ special resize character |
dup $FF = ?EXIT \ special resize character |
dup $C2 u< IF UTF-8-err throw THEN \ malformed character |
dup $C2 u< IF UTF-8-err throw THEN \ malformed character |
$7F and $40 >r |
$7F and $40 >r |
BEGIN dup r@ and WHILE r@ xor |
BEGIN dup r@ and WHILE r@ xor |
6 lshift r> 5 lshift >r >r defers key |
6 lshift r> 5 lshift >r >r key |
dup $C0 and $80 <> IF UTF-8-err throw THEN |
dup $C0 and $80 <> IF UTF-8-err throw THEN |
$3F and r> or |
$3F and r> or |
REPEAT rdrop ; |
REPEAT rdrop ; |
|
|
: u8emit ( u -- ) |
: u8emit ( u -- ) |
dup max-single-byte u< IF defers emit EXIT THEN \ special case ASCII |
dup max-single-byte u< IF emit EXIT THEN \ special case ASCII |
0 swap $3F |
0 swap $3F |
BEGIN 2dup u> WHILE |
BEGIN 2dup u> WHILE |
2/ >r dup $3F and $80 or swap 6 rshift r> |
2/ >r dup $3F and $80 or swap 6 rshift r> |
REPEAT $7F xor 2* or |
REPEAT $7F xor 2* or |
BEGIN dup $80 u>= WHILE defers emit REPEAT drop ; |
BEGIN dup $80 u>= WHILE emit REPEAT drop ; |
|
|
\ utf-8 stuff for xchars |
\ utf-8 stuff for xchars |
|
|