gforth/utf-8.fs - diff

Return to utf-8.fs CVS log

Up to [gforth] / gforth

version 1.36, 2008/07/15 16:11:49	version 1.37, 2008/11/23 21:09:55
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