| 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 |
| |
|
