version 1.4, 2006/02/19 17:27:13
|
version 1.8, 2007/09/15 20:11:44
|
Line 1
|
Line 1
|
\ extended characters (either 8bit or UTF-8, possibly other encodings) |
\ extended characters (either 8bit or UTF-8, possibly other encodings) |
\ and their fixed-size variant |
\ and their fixed-size variant |
|
|
\ Copyright (C) 2005 Free Software Foundation, Inc. |
\ Copyright (C) 2005,2006 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
Line 28 DEFER XKEY ( -- xc )
|
Line 28 DEFER XKEY ( -- xc )
|
DEFER XCHAR+ ( xc-addr1 -- xc-addr2 ) |
DEFER XCHAR+ ( xc-addr1 -- xc-addr2 ) |
DEFER XCHAR- ( xc-addr1 -- xc-addr2 ) |
DEFER XCHAR- ( xc-addr1 -- xc-addr2 ) |
DEFER +X/STRING ( xc-addr1 u1 -- xc-addr2 u2 ) |
DEFER +X/STRING ( xc-addr1 u1 -- xc-addr2 u2 ) |
DEFER -X/STRING ( xc-addr1 u1 -- xc-addr2 u2 ) |
DEFER X\STRING- ( xc-addr1 u1 -- xc-addr1 u2 ) |
DEFER XC@ ( xc-addr -- xc ) |
DEFER XC@ ( xc-addr -- xc ) |
DEFER XC!+? ( xc xc-addr1 u1 -- xc-addr2 u2 f ) \ f if operation succeeded |
DEFER XC!+? ( xc xc-addr1 u1 -- xc-addr2 u2 f ) \ f if operation succeeded |
DEFER XC@+ ( xc-addr1 -- xc-addr2 xc ) |
DEFER XC@+ ( xc-addr1 -- xc-addr2 xc ) |
DEFER XC-SIZE ( xc -- u ) \ size in cs |
DEFER XC-SIZE ( xc -- u ) \ size in cs |
|
DEFER X-SIZE ( xc-addr u1 -- u2 ) \ size in cs |
DEFER X-WIDTH ( addr u -- n ) \ size in fixed chars |
DEFER X-WIDTH ( addr u -- n ) \ size in fixed chars |
DEFER -TRAILING-GARBAGE ( addr u1 -- addr u2 ) \ remove trailing incomplete xc |
DEFER -TRAILING-GARBAGE ( addr u1 -- addr u2 ) \ remove trailing incomplete xc |
|
|
\ derived words, faster implementations are probably possible |
\ derived words, faster implementations are probably possible |
|
|
: X@+/string ( xc-addr1 u1 -- xc-addr2 u2 xc ) |
: x@+/string ( xc-addr1 u1 -- xc-addr2 u2 xc ) |
\ !! check for errors? |
\ !! check for errors? |
over >r +x/string |
over >r +x/string |
r> xc@ ; |
r> xc@ ; |
Line 48 DEFER -TRAILING-GARBAGE ( addr u1 -- add
|
Line 49 DEFER -TRAILING-GARBAGE ( addr u1 -- add
|
: char- ( c-addr1 -- c-addr2 ) |
: char- ( c-addr1 -- c-addr2 ) |
[ 1 chars ] literal - ; |
[ 1 chars ] literal - ; |
|
|
: 1/string ( c-addr1 u1 -- c-addr2 u2 ) |
: +string ( c-addr1 u1 -- c-addr2 u2 ) |
1 /string ; |
1 /string ; |
|
: string- ( c-addr1 u1 -- c-addr1 u2 ) |
: -1/string ( c-addr1 u1 -- c-addr2 u2 ) |
1- ; |
-1 /string ; |
|
|
|
: c!+? ( c c-addr1 u1 -- c-addr2 u2 f ) |
: c!+? ( c c-addr1 u1 -- c-addr2 u2 f ) |
dup 1 chars u< if \ or use < ? |
dup 1 chars u< if \ or use < ? |
Line 70 DEFER -TRAILING-GARBAGE ( addr u1 -- add
|
Line 70 DEFER -TRAILING-GARBAGE ( addr u1 -- add
|
['] key is xkey |
['] key is xkey |
['] char+ is xchar+ |
['] char+ is xchar+ |
['] char- is xchar- |
['] char- is xchar- |
['] 1/string is +x/string |
['] +string is +x/string |
['] -1/string is -x/string |
['] string- is x\string- |
['] c@ is xc@ |
['] c@ is xc@ |
['] c!+? is xc!+? |
['] c!+? is xc!+? |
['] count is xc@+ |
['] count is xc@+ |
['] c-size is xc-size |
['] c-size is xc-size |
|
['] c-size is x-size |
['] nip IS x-width |
['] nip IS x-width |
['] noop is -trailing-garbage |
['] noop is -trailing-garbage |
; |
; |