version 1.18, 2007/12/31 17:34:58
|
version 1.20, 2008/11/08 15:54:06
|
Line 1
|
Line 1
|
\ ekey etc. |
\ ekey etc. |
|
|
\ Copyright (C) 1999,2002,2003,2004,2005,2006,2007 Free Software Foundation, Inc. |
\ Copyright (C) 1999,2002,2003,2004,2005,2006,2007,2008 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
\ Gforth is free software; you can redistribute it and/or |
\ Gforth is free software; you can redistribute it and/or |
\ modify it under the terms of the GNU General Public License |
\ modify it under the terms of the GNU General Public License |
\ as published by the Free Software Foundation; either version 2 |
\ as published by the Free Software Foundation, either version 3 |
\ of the License, or (at your option) any later version. |
\ of the License, or (at your option) any later version. |
|
|
\ This program is distributed in the hope that it will be useful, |
\ This program is distributed in the hope that it will be useful, |
Line 15
|
Line 15
|
\ GNU General Public License for more details. |
\ GNU General Public License for more details. |
|
|
\ You should have received a copy of the GNU General Public License |
\ You should have received a copy of the GNU General Public License |
\ along with this program; if not, write to the Free Software |
\ along with this program. If not, see http://www.gnu.org/licenses/. |
\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. |
|
|
|
|
|
\ this implementation of EKEY just translates VT100/ANSI escape |
\ this implementation of EKEY just translates VT100/ANSI escape |
Line 32
|
Line 31
|
|
|
\ The keycode names are compatible with pfe-0.9.14 |
\ The keycode names are compatible with pfe-0.9.14 |
|
|
|
$80000000 constant keycode-start |
|
$80000016 constant keycode-limit |
|
|
|
create keycode-table keycode-limit keycode-start - cells allot |
|
|
: keycode ( u1 "name" -- u2 ; name execution: -- u ) |
: keycode ( u1 "name" -- u2 ; name execution: -- u ) |
dup constant 1+ ; |
dup keycode-limit keycode-start within -11 and throw |
|
dup constant |
|
dup latest keycode-table rot keycode-start - th ! |
|
1+ ; |
|
|
\ most of the keys are also in pfe, except: |
\ most of the keys are also in pfe, except: |
\ k-insert, k-delete, k11, k12, s-k11, s-k12 |
\ k-insert, k-delete, k11, k12, s-k11, s-k12 |
Line 42 $40000000 constant k-shift-mask ( -- u )
|
Line 49 $40000000 constant k-shift-mask ( -- u )
|
$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 |
|
|
$80000000 |
: simple-fkey-string ( u -- c-addr u ) |
|
dup keycode-limit keycode-start within -24 and throw |
|
keycode-table swap keycode-start - th @ name>string ; |
|
|
|
: fkey. ( u -- ) |
|
dup [ k-shift-mask k-ctrl-mask k-alt-mask or or invert ] literal and |
|
simple-fkey-string type |
|
dup k-shift-mask and if ." k-shift-mask or" then |
|
dup k-ctrl-mask and if ." k-ctrl-mask or" then |
|
k-alt-mask and if ." k-alt-mask or" then ; |
|
|
|
keycode-start |
keycode k-left ( -- u ) \ X:ekeys |
keycode k-left ( -- u ) \ X:ekeys |
keycode k-right ( -- u ) \ X:ekeys |
keycode k-right ( -- u ) \ X:ekeys |
keycode k-up ( -- u ) \ X:ekeys |
keycode k-up ( -- u ) \ X:ekeys |