| $20000000 constant k-ctrl-mask ( -- u ) \ X:ekeys |
$20000000 constant k-ctrl-mask ( -- u ) \ X:ekeys |
| $10000000 constant k-alt-mask ( -- u ) \ X:ekeys |
$10000000 constant k-alt-mask ( -- u ) \ X:ekeys |
| |
|
| : simple-fkey-string ( u -- c-addr u ) |
: simple-fkey-string ( u1 -- c-addr u ) \ gforth |
| |
\G @i{c-addr u} is the string name of the function key @i{u1}. |
| |
\G Only works for simple function keys without modifier masks. |
| |
\G Any @i{u1} that does not correspond to a simple function key |
| |
\G currently produces an exception. |
| dup keycode-limit keycode-start within -24 and throw |
dup keycode-limit keycode-start within -24 and throw |
| keycode-table swap keycode-start - th @ name>string ; |
keycode-table swap keycode-start - th @ name>string ; |
| |
|
| : fkey. ( u -- ) |
: fkey. ( u -- ) \ gforth fkey-dot |
| |
\G Print a string representation for the function key @i{u}. |
| |
\G @i{U} must be a function key (possibly with modifier masks), |
| |
\G otherwise there may be an exception. |
| dup [ k-shift-mask k-ctrl-mask k-alt-mask or or invert ] literal and |
dup [ k-shift-mask k-ctrl-mask k-alt-mask or or invert ] literal and |
| simple-fkey-string type |
simple-fkey-string type |
| dup k-shift-mask and if ." k-shift-mask or" then |
dup k-shift-mask and if ." k-shift-mask or" then |
| |
|
| create ekey-buffer 8 chars allot |
create ekey-buffer 8 chars allot |
| 2variable ekey-buffered |
2variable ekey-buffered |
| |
|
| [IFUNDEF] #esc 27 Constant #esc [THEN] |
[IFUNDEF] #esc 27 Constant #esc [THEN] |
| |
|
| : esc-prefix ( -- u ) |
: esc-prefix ( -- u ) |
| : clear-ekey-buffer ( -- ) |
: clear-ekey-buffer ( -- ) |
| ekey-buffer 0 ekey-buffered 2! ; |
ekey-buffer 0 ekey-buffered 2! ; |
| |
|
| |
[IFDEF] max-single-byte |
| |
: read-xkey ( key -- flag ) |
| |
clear-ekey-buffer |
| |
ekey-buffered char-append-buffer |
| |
ekey-buffer 1 u8addrlen 1 +do |
| |
key? 0= ?leave |
| |
key ekey-buffered char-append-buffer |
| |
loop |
| |
ekey-buffer 1 u8addrlen ekey-buffered @ = ; |
| |
: get-xkey ( u -- xc ) |
| |
dup max-single-byte u>= if |
| |
read-xkey if |
| |
ekey-buffer xc@+ nip else |
| |
ekey-buffered 2@ unkeys key then |
| |
then ; |
| |
: xkey? ( -- flag ) |
| |
key? dup if |
| |
drop key read-xkey ekey-buffered 2@ unkeys |
| |
clear-ekey-buffer then ; |
| |
[THEN] |
| |
|
| : ekey ( -- u ) \ facility-ext e-key |
: ekey ( -- u ) \ facility-ext e-key |
| \G Receive a keyboard event @var{u} (encoding implementation-defined). |
\G Receive a keyboard event @var{u} (encoding implementation-defined). |
| key dup #esc = |
key dup #esc = |
| if |
if |
| drop clear-ekey-buffer |
drop clear-ekey-buffer |
| esc-prefix |
esc-prefix exit |
| then ; |
then |
| |
[IFDEF] max-single-byte |
| |
get-xkey |
| |
[THEN] |
| |
; |
| |
|
| |
[IFDEF] max-single-byte |
| : ekey>char ( u -- u false | c true ) \ facility-ext e-key-to-char |
: ekey>char ( u -- u false | c true ) \ facility-ext e-key-to-char |
| \G Convert keyboard event @var{u} into character @code{c} if possible. |
\G Convert keyboard event @var{u} into character @code{c} if possible. |
| |
dup max-single-byte u< ; \ k-left must be first! |
| |
: ekey>xchar ( u -- u false | xc true ) \ xchar-ext e-key-to-xchar |
| |
\G Convert keyboard event @var{u} into xchar @code{xc} if possible. |
| dup k-left u< ; \ k-left must be first! |
dup k-left u< ; \ k-left must be first! |
| |
: ekey>fkey ( u1 -- u2 f ) \ X:ekeys |
| |
\G If u1 is a keyboard event in the special key set, convert |
| |
\G keyboard event @var{u1} into key id @var{u2} and return true; |
| |
\G otherwise return @var{u1} and false. |
| |
ekey>xchar 0= ; |
| |
|
| |
' xkey? alias ekey? ( -- flag ) \ facility-ext e-key-question |
| |
[ELSE] |
| |
: ekey>char ( u -- u false | c true ) \ facility-ext e-key-to-char |
| |
\G Convert keyboard event @var{u} into character @code{c} if possible. |
| |
dup k-left u< ; \ k-left must be first! |
| : ekey>fkey ( u1 -- u2 f ) \ X:ekeys |
: ekey>fkey ( u1 -- u2 f ) \ X:ekeys |
| \G If u1 is a keyboard event in the special key set, convert |
\G If u1 is a keyboard event in the special key set, convert |
| \G keyboard event @var{u1} into key id @var{u2} and return true; |
\G keyboard event @var{u1} into key id @var{u2} and return true; |
| ekey>char 0= ; |
ekey>char 0= ; |
| |
|
| ' key? alias ekey? ( -- flag ) \ facility-ext e-key-question |
' key? alias ekey? ( -- flag ) \ facility-ext e-key-question |
| |
[THEN] |
| |
|
| \G True if a keyboard event is available. |
\G True if a keyboard event is available. |
| |
|
| \ : esc? ( -- flag ) recursive |
\ : esc? ( -- flag ) recursive |
