[add] perframe event handling

2 files changed, 61 insertions, 7 deletions

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)
diff --git a/wheelwork.lisp b/wheelwork.lisp
index f742fdd..a9f93bf 100644
--- a/wheelwork.lisp
+++ b/wheelwork.lisp
@@ -48,16 +48,18 @@ order). Makes sure to remove the unit from its current container if necessary."
     (setf (listener interactive) (make-instance 'listener)))
   (setf
    (slot-value (listener interactive) (event-type handler))        handler
-   (gethash interactive (listener-table-for (listener interactive) (event-type handler))) t))
+   (gethash interactive (listener-table-for (listener interactive) (event-type handler))) handler))
 
 (defun unset-handler (interactive handler-or-event-type)
   "Handler can be an instance of EVENT-HANDLER or can be a symbol
   whose name is an event type."
   (when (listener interactive)
     (let ((event-type (etypecase handler-or-event-type
-                        (keyword (intern (symbol-name handler-or-event-type)))
-                        (symbol (intern (symbol-name handler-or-event-type)))
+                        (keyword (intern (symbol-name handler-or-event-type) :wheelwork))
+                        (symbol (intern (symbol-name handler-or-event-type) :wheelwork))
                         (event-handler (event-type handler-or-event-type)))))
+      (print (list :event-type event-type
+                   :pacakge (symbol-package event-type)))
       (setf (slot-value (listener interactive) event-type) nil)
       (remhash interactive (listener-table-for (listener interactive) event-type)))))
 
@@ -121,13 +123,27 @@ order). Makes sure to remove the unit from its current container if necessary."
   resoruces are avaialble.")
   (:method ((app application)) nil))
 
+(defgeneric shutdown (app)
+  (:documentation "Specialzied for each subclass of
+  APPLICATION. Called just before cleanup.")
+  (:method ((app application)) nil))
+
+
 (defgeneric cleanup (thing)
   (:documentation "Clean up applications, textures, and so on.")
   (:method ((any t)) nil))
 
+(defconstant +listener-table-slot-names+
+  '(keydown-table keyup-table mousedown-table  mouseup-table  mousemotion-table
+    focus-table blur-table perframe-table))
+
 (defmethod cleanup ((app application))
   (loop for asset being the hash-value of (application-assets app)
         do (cleanup asset))
+  ;; drop all current handlers
+  (let ((listener (listener app))) 
+    (dolist (table +listener-table-slot-names+)
+      (setf (slot-value listener table) (make-hash-table :synchronized t))))
   (call-next-method))
 
 (defmethod cleanup ((container container))
@@ -157,7 +173,8 @@ order). Makes sure to remove the unit from its current container if necessary."
           (unwind-protect
                (progn 
                  (boot app)
-                 (eventloop app))
+                 (eventloop app)
+                 (shutdown app))
             (cleanup app)))))))
 
 (defvar *frame-time* nil
@@ -165,11 +182,17 @@ order). Makes sure to remove the unit from its current container if necessary."
 
 (defgeneric render (thing))
 (defmethod render ((app application))
+  (let ((table (perframe-table (listener app)))
+        (time (get-universal-time)))
+    (loop for target being the hash-key of table
+          for handler being the hash-value of table
+          do (funcall handler target time)))
   (gl:clear-color 0.0 0.0 0.0 1.0)
   (gl:clear :depth-buffer-bit :color-buffer-bit)
   (dolist (thing (container-units app))
     (render thing))
-  (sdl2:gl-swap-window (application-window app)))
+  (sdl2:gl-swap-window (application-window app))
+  (sleep (/ 1.0 30) ))
 
 
 
@@ -278,7 +301,7 @@ order). Makes sure to remove the unit from its current container if necessary."
     blur-table
     perframe-table
     :static
-    :std (make-hash-table)
+    :std (make-hash-table :synchronized t)
     :doc "Keyed by DISPLAY-UNIT instance, holds an EVENT-HANDLER if handler is defined for unit."))
   (:documentation "Event handlers per object. The static hash tables
   are keyed by UNIT and hold Event-Handler instances."))