2020-02-02 23:33:07 +00:00
|
|
|
( K E Y B O A R D )
|
|
|
|
|
1 const ^ESC
|
|
|
|
|
15 const ^TAB
|
|
|
|
|
28 const ^ENTER
|
|
|
|
|
29 const ^CTRL
|
|
|
|
|
51 const ^<
|
|
|
|
|
52 const ^>
|
|
|
|
|
56 const ^ALT
|
|
|
|
|
57 const ^SPACE
|
|
|
|
|
72 const ^UP
|
|
|
|
|
75 const ^LEFT
|
|
|
|
|
77 const ^RIGHT
|
|
|
|
|
80 const ^DOWN
|
|
|
|
|
|
|
|
|
|
: wait-key ( k -- ) begin dup key-pressed not while suspend repeat drop ;
|
|
|
|
|
: udelta ( u u -- u )
|
|
|
|
|
2dup u> if
|
|
|
|
|
swap -1 swap - + 1 +
|
|
|
|
|
else
|
|
|
|
|
swap -
|
|
|
|
|
then ;
|
|
|
|
|
|
2020-02-02 23:30:11 +00:00
|
|
|
: current-arrows
|
|
|
|
|
^UP key-down if 0x01 else 0 then
|
|
|
|
|
^DOWN key-down if 0x02 else 0 then |
|
|
|
|
|
^LEFT key-down if 0x04 else 0 then |
|
|
|
|
|
^RIGHT key-down if 0x08 else 0 then | ;
|
|
|
|
|
|
|
|
|
|
: wait-for-arrow-up
|
|
|
|
|
current-arrows begin dup current-arrows & while suspend repeat drop ;
|
|
|
|
|
|
2020-02-02 23:33:07 +00:00
|
|
|
( M O U S E )
|
|
|
|
|
var prevbutton
|
|
|
|
|
: tick-debounce
|
|
|
|
|
mousebuttons prevbutton ! ;
|
|
|
|
|
|
|
|
|
|
1 const MOUSEL
|
|
|
|
|
2 const MOUSER
|
|
|
|
|
: mousedown ( button -- bool ) mousebuttons & ;
|
|
|
|
|
: clicked ( button -- bool )
|
|
|
|
|
dup mousedown not swap
|
|
|
|
|
prevbutton @ & and ;
|
