Adding some button handling.

ueforth/common/grf.fs

@@ -29,10 +29,13 @@
 \   last-key ( -- n )
 \   last-keysym ( -- n )
 \   last-keycode ( -- n )
+\   pressed? ( k -- f )
 \   event ( -- n )
 \ Event constants:
 \   UNKNOWN TIMEOUT RESIZED EXPOSED
 \   MOTION PRESSED RELEASED FINISHED
+\ Key/Button constants:
+\   LEFT-BUTTON MIDDLE-BUTTON RIGHT-BUTTON
 
 vocabulary grf   grf definitions
 vocabulary internals
@@ -46,6 +49,10 @@ vocabulary internals
 6 constant RELEASED
 7 constant FINISHED
 
+255 constant LEFT-BUTTON
+254 constant MIDDLE-BUTTON
+253 constant RIGHT-BUTTON
+
 0 value mouse-x
 0 value mouse-y
 0 value last-key
@@ -59,10 +66,18 @@ internals definitions
 
 0 value backbuffer
 
+256 constant key-count
+create key-state key-count allot
+key-state key-count erase
+
+: key-state! ( f k ) key-state + c! ;
+
 grf definitions also internals
 
 : pixel ( w h -- a ) width * + 4* backbuffer + ;
 
+: pressed? ( k -- f ) key-state + c@ 0<> ;
+
 ( Rest of the core definitions per platform. )
 
 only forth definitions

ueforth/common/grf_test.fs

@@ -14,17 +14,13 @@
 
 grf
 
-0 value clicking
-
 -1 -1 window
 : run
   begin
     wait
-    PRESSED event = if 1 to clicking then
-    RELEASED event = if 0 to clicking then
     0 to color
     0 0 width height box
-    clicking if $ccccff else $ffccff then to color
+    LEFT-BUTTON pressed? if $ccccff else $ffccff then to color
     mouse-x mouse-y height heart
     flip
   event FINISHED = until

ueforth/windows/grf.fs

@@ -44,6 +44,26 @@ cell allocate throw to backbuffer
   RESIZED to event
 ;
 
+: msg>button ( n -- n )
+  dup WM_LBUTTONDOWN = over WM_LBUTTONUP = or if
+    drop LEFT-BUTTON exit
+  then
+  dup WM_MBUTTONDOWN = over WM_MBUTTONUP = or if
+    drop MIDDLE-BUTTON exit
+  then
+  dup WM_RBUTTONDOWN = over WM_RBUTTONUP = or if
+    drop RIGHT-BUTTON exit
+  then
+  drop 0
+;
+
+: msg>pressed ( n -- 0/1 )
+  dup WM_LBUTTONDOWN =
+  over WM_MBUTTONDOWN = or
+  over WM_RBUTTONDOWN = or if drop 1 exit then
+  drop 0
+;
+
 : GrfWindowProc { hwnd msg w l }
   WM_QUIT msg = if
     FINISHED to event
@@ -72,15 +92,12 @@ cell allocate throw to backbuffer
   then
   WM_CHAR msg = if
   then
-  WM_LBUTTONDOWN msg = if
+  msg msg>button if
     l GET_X_LPARAM to mouse-x
     l GET_Y_LPARAM to mouse-y
-    PRESSED to event
-  then
-  WM_LBUTTONUP msg = if
-    l GET_X_LPARAM to mouse-x
-    l GET_Y_LPARAM to mouse-y
-    RELEASED to event
+    msg msg>pressed msg msg>button key-state!
+    msg msg>button to last-keycode
+    msg msg>pressed if PRESSED else RELEASED then to event
   then
   WM_MOUSEMOVE msg = if
     l GET_X_LPARAM to mouse-x