diff --git a/ueforth/common/grf.fs b/ueforth/common/grf.fs index 55fb318..dc532e9 100644 --- a/ueforth/common/grf.fs +++ b/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 diff --git a/ueforth/common/grf_test.fs b/ueforth/common/grf_test.fs index 8aadd20..26e6aff 100644 --- a/ueforth/common/grf_test.fs +++ b/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 diff --git a/ueforth/windows/grf.fs b/ueforth/windows/grf.fs index a226df7..d80b2a7 100644 --- a/ueforth/windows/grf.fs +++ b/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