From 2d9298e36d3606895ecd5d548f03009305cd1a2c Mon Sep 17 00:00:00 2001
From: Colin Okay <colin@cicadas.surf>
Date: Thu, 23 Jun 2022 11:54:12 -0500
Subject: [add] perframe event handling

---
 examples/02-moving-bitmp.lisp | 33 ++++++++++++++++++++++++++++++++-
 1 file changed, 32 insertions(+), 1 deletion(-)

(limited to 'examples')

diff --git a/examples/02-moving-bitmp.lisp b/examples/02-moving-bitmp.lisp
index 200a1d1..8e5f55b 100644
--- a/examples/02-moving-bitmp.lisp
+++ b/examples/02-moving-bitmp.lisp
@@ -8,6 +8,35 @@
 
 (defclass bitmap-display (ww::application ) ())
 
+(defvar *shared-anim-table* (make-hash-table :synchronized t))
+
+(ww::defhandler animate-move-thing
+    (ww::on-keydown ()
+      (when (member scancode '(:scancode-left :scancode-right :scancode-down :scancode-up)) 
+        (unless (gethash target *shared-anim-table*)
+          (setf (gethash target *shared-anim-table*) t)
+          (let* ((tx (ww::unit-x target))
+                 (ty (ww::unit-y target))
+                 (destx tx)
+                 (desty ty)
+                 (dx 0)
+                 (dy 0))
+            (case scancode
+              (:scancode-down (setf dy -1 desty (- ty (ww::unit-height target))))
+              (:scancode-up (setf dy 1 desty (+ ty (ww::unit-height target))))
+              (:scancode-left (setf dx -1 destx (- tx (ww::unit-width target))))
+              (:scancode-right (setf dx 1 destx (+ tx (ww::unit-width target)))))
+            (ww::set-handler
+             target
+             (ww::on-perframe ()
+               (with-slots ((cx ww::x) (cy ww::y)) target 
+                 (if (and (= cx destx) (= cy desty))
+                     (progn
+                       (remhash target *shared-anim-table*)
+                       (ww::unset-handler target 'ww::perframe))
+                     (setf cx (+ cx dx)
+                           cy (+ cy dy)))))))))))
+
 (ww::defhandler move-thing
     (ww::on-keydown ()
       (case scancode
@@ -33,6 +62,8 @@
     (ww::on-mousemotion ()
       (print (list target x y xrel yrel state))))
 
+
+
 (defmethod ww::boot ((app bitmap-display))
   (let ((bm
           (make-instance 'ww::bitmap
@@ -42,7 +73,7 @@
                          :texture (ww::get-asset "RootBear.png"))))
     ;; first 
     (ww::refocus-on bm)
-    (ww::set-handler bm #'move-thing)
+    (ww::set-handler bm #'animate-move-thing )
     (ww::set-handler bm #'thing-clicked)
     (ww::set-handler bm #'mouse-over)
     (ww::add-unit app bm)
-- 
cgit v1.2.3