More key things work.
This commit is contained in:
@ -69,7 +69,7 @@ internals definitions
|
|||||||
create key-state key-count allot
|
create key-state key-count allot
|
||||||
key-state key-count erase
|
key-state key-count erase
|
||||||
|
|
||||||
: key-state! ( f k ) key-state + c! ;
|
: key-state! ( f k ) key-count mod key-state + c! ;
|
||||||
|
|
||||||
grf definitions also internals
|
grf definitions also internals
|
||||||
|
|
||||||
|
|||||||
@ -35,6 +35,9 @@ also posix also x11
|
|||||||
0 value image
|
0 value image
|
||||||
0 value xevent-type
|
0 value xevent-type
|
||||||
create xevent xevent-size allot
|
create xevent xevent-size allot
|
||||||
|
256 constant keybuffer-size
|
||||||
|
create keybuffer keybuffer-size allot
|
||||||
|
0 value keybuffer-used
|
||||||
|
|
||||||
ExposureMask
|
ExposureMask
|
||||||
ButtonPressMask or
|
ButtonPressMask or
|
||||||
@ -52,7 +55,31 @@ StructureNotifyMask or constant EVENT-MASK
|
|||||||
width height 32 width 4* XCreateImage to image
|
width height 32 width 4* XCreateImage to image
|
||||||
;
|
;
|
||||||
|
|
||||||
|
: update-mouse
|
||||||
|
[ xbutton ]
|
||||||
|
xevent ->x sl@ to mouse-x
|
||||||
|
xevent ->y sl@ to mouse-y
|
||||||
|
;
|
||||||
|
|
||||||
|
: update-key
|
||||||
|
[ xkey ]
|
||||||
|
xevent keybuffer keybuffer-size
|
||||||
|
0 >r rp@ NULL XLookupString to keybuffer-used
|
||||||
|
r> to last-key
|
||||||
|
PRESSED event = negate last-key key-state!
|
||||||
|
;
|
||||||
|
|
||||||
|
: pending-key?
|
||||||
|
keybuffer-used 0 <= if 0 exit then
|
||||||
|
keybuffer c@ to last-char
|
||||||
|
keybuffer 1+ keybuffer keybuffer-size 1- cmove>
|
||||||
|
keybuffer-used 1- to keybuffer-used
|
||||||
|
TYPED to event
|
||||||
|
-1
|
||||||
|
;
|
||||||
|
|
||||||
: update-event
|
: update-event
|
||||||
|
UNKNOWN to event
|
||||||
xevent [ xany ] ->type sl@ to xevent-type
|
xevent [ xany ] ->type sl@ to xevent-type
|
||||||
Expose xevent-type = if
|
Expose xevent-type = if
|
||||||
EXPOSED to event
|
EXPOSED to event
|
||||||
@ -66,25 +93,37 @@ StructureNotifyMask or constant EVENT-MASK
|
|||||||
then
|
then
|
||||||
KeyPress xevent-type = if
|
KeyPress xevent-type = if
|
||||||
PRESSED to event
|
PRESSED to event
|
||||||
|
update-mouse
|
||||||
|
update-key
|
||||||
exit
|
exit
|
||||||
then
|
then
|
||||||
KeyRelease xevent-type = if
|
KeyRelease xevent-type = if
|
||||||
RELEASED to event
|
RELEASED to event
|
||||||
|
update-mouse
|
||||||
|
update-key
|
||||||
exit
|
exit
|
||||||
then
|
then
|
||||||
ButtonPress xevent-type = if
|
ButtonPress xevent-type = if
|
||||||
PRESSED to event
|
PRESSED to event
|
||||||
|
update-mouse
|
||||||
|
( uses carnal knowledge )
|
||||||
|
[ xbutton ] 256 xevent ->button sl@ - to last-key
|
||||||
|
1 last-key key-state!
|
||||||
exit
|
exit
|
||||||
then
|
then
|
||||||
ButtonRelease xevent-type = if
|
ButtonRelease xevent-type = if
|
||||||
RELEASED to event
|
RELEASED to event
|
||||||
|
update-mouse
|
||||||
|
( uses carnal knowledge )
|
||||||
|
[ xbutton ] 256 xevent ->button sl@ - to last-key
|
||||||
|
0 last-key key-state!
|
||||||
exit
|
exit
|
||||||
then
|
then
|
||||||
MotionNotify xevent-type = if
|
MotionNotify xevent-type = if
|
||||||
MOTION to event
|
MOTION to event
|
||||||
|
update-mouse
|
||||||
exit
|
exit
|
||||||
then
|
then
|
||||||
UNKNOWN to event
|
|
||||||
;
|
;
|
||||||
|
|
||||||
also grf definitions
|
also grf definitions
|
||||||
@ -113,11 +152,13 @@ also grf definitions
|
|||||||
;
|
;
|
||||||
|
|
||||||
: wait
|
: wait
|
||||||
|
pending-key? if exit then
|
||||||
display xevent XNextEvent drop
|
display xevent XNextEvent drop
|
||||||
update-event
|
update-event
|
||||||
;
|
;
|
||||||
|
|
||||||
: poll
|
: poll
|
||||||
|
pending-key? if exit then
|
||||||
display event-mask xevent XCheckMaskEvent
|
display event-mask xevent XCheckMaskEvent
|
||||||
if update-event else TIMEOUT to event then
|
if update-event else TIMEOUT to event then
|
||||||
;
|
;
|
||||||
|
|||||||
Reference in New Issue
Block a user