Commit 8e44499f authored by bp's avatar bp
Browse files

Added X:ekeys implementation

git-svn-id: https://forth-ev.de/repos/bigforth@1631 3b8d8251-53f3-0310-8f3b-fd1cb8370982
parent 9b894ea1
......@@ -47,7 +47,8 @@ KERNSRC = forth.fb target.fb
SYSSRC = assem486.fb stream.fb errore.fs hash.fs fileint.fb output.fb \
strings.fs savemod.fb tasker.fb vt100key.fs disass.fb \
tools.fb except.fs sedit.fb struct.fs lambda.fs idle.fs callback.fs \
startup.fb ftast.fb environ.fs random.fs version.h minos-version.h
startup.fb ftast.fb environ.fs random.fs version.h minos-version.h \
forth200x.fs
XCSRC = x.fs glconst.fs
XSRC = startx.fs minos.fs oof.fb x11.fs xpm.fs locals.fs editor.fs \
ediwind.fs edit.fs opengl.fs xstyle.fs status.fb \
......
......@@ -473,9 +473,9 @@ how: : dispose clicks HandleOff
ELSE XLookupString THEN
[ELSE] XLookupString [THEN]
?dup IF look_chars swap bounds ?DO
I xc@+ swap >r event XKeyEvent state @ keyed
I xc@+ swap >r event XKeyEvent state @ $3F and keyed
r> I - +LOOP EXIT THEN
look_key @ event XKeyEvent state @ keyed ]:
look_key @ event XKeyEvent state @ $3F and $80 or keyed ]:
KeyPress cells Handlers + !
\ Display 11sep05py
......
......@@ -11,3 +11,65 @@
: defer! ( xt1 xt2 -- ) >body ! ;
Synonym action-of what's
\ ekey stuff
: ekey ( -- ) key kbshift @ $18 lshift or ;
: ekey? ( -- ) key? ;
$01000000 Constant k-shift-mask
$02000000 Constant k-capslock-mask
$04000000 Constant k-ctrl-mask
$08000000 Constant k-alt-mask
$10000000 Constant k-numlock-mask
$40000000 Constant k-mouse-mask
$80000000 Constant k-fn-mask
: ekey>char ( u -- u false | c true )
dup $C0000000 and 0= over $FFFFFF and $100 < and
dup IF swap $FF and swap THEN ;
: ekey>xchar ( u -- u false | xc true )
dup $C0000000 and 0=
dup IF swap $FFFFFF and swap THEN ;
: ekey>fkey ( u1 -- u2 f )
dup k-fn-mask and 0<>
dup IF
drop [ k-capslock-mask k-numlock-mask or k-fn-mask or
k-mouse-mask or invert ] Literal and
true
THEN ;
: k-fns: ( start n -- ) bounds ?DO I Constant LOOP ;
0 AValue keycode-start
0 AValue keycode-end
: simple-fkey-string ( u -- addr u )
keycode-end BEGIN dup keycode-start > WHILE
2dup name> 4 + @ = IF nip count $1F and EXIT THEN
cell- @ cell+
REPEAT 2drop s" f-unknown" ;
: fkey. ( u -- ) \ gforth fkey-dot
\ Print an fkey as string
dup $FFFFFF 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 ;
last @ to keycode-start
$FF50 Constant k-home
$FF51 Constant k-left
$FF52 Constant k-up
$FF53 Constant k-right
$FF54 Constant k-down
$FF55 Constant k-prior
$FF56 Constant k-next
$FF57 Constant k-end
$FF63 Constant k-insert
$FFBE 12 k-fns: k-f1 k-f2 k-f3 k-f4 k-f5 k-f6 k-f7 k-f8 k-f9 k-f10 k-f11 k-f12
last @ to keycode-end
......@@ -604,14 +604,14 @@ how: 6 colors focuscol ! 1 colors defocuscol !
\ IO-Window 07jun03py
: keyed ( key state -- )
over shift-keys? IF 2drop EXIT THEN
BEGIN keys @ @ $1F >= WHILE pause REPEAT $10 << or
BEGIN keys @ @ $1F >= WHILE pause REPEAT $18 lshift or
keys @ dup @ 1+ $1F min dup keys @ ! cells + ! ;
boxchar :: handle-key?
: key? ( -- flag )
keys @ @ 0= IF pause THEN keys @ @ 0> ;
: getkey ( -- key ) keys @ @
IF keys @ cell+ @ keys @ 8 + dup cell- $78 move
-1 keys @ +! dup $10 rshift kbshift ! $FFFF and
-1 keys @ +! dup $18 rshift kbshift ! $FFFFFF and
ELSE 0 THEN ;
: key ( -- key ) flush 1 cursor# ! curon
BEGIN key? 0= WHILE
......@@ -622,7 +622,7 @@ how: 6 colors focuscol ! 1 colors defocuscol !
\ IO-Window 06jan05py
: decode ( m s addr pos char -- m s addr pos flag )
kbshift @ $100 and IF drop 0 EXIT THEN
kbshift @ $40 and IF drop 0 EXIT THEN
[defined] (Ftast [IF] dup $FFBE $FFCA within
IF $FFBE - cells (Ftast + -rot >r >r -rot >r >r
perform r> r> r> r> prompt cr save-cursor
......@@ -644,7 +644,7 @@ how: 6 colors focuscol ! 1 colors defocuscol !
1 and IF drop mark-selection EXIT THEN
1 and 0= IF 2drop (dpy @select paste-selection
EXIT THEN
8 << or kbshift @ $100 or keyed ]CK >callback
8 << or kbshift @ $40 or keyed ]CK >callback
assign defocuscol @ @ color ! ;
: close #cr 0 keyed S" bye" bounds ?DO i c@ 0 keyed LOOP ;
: dispose start HandleOff keys HandleOff
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment