[add] perframe event handling

1 files changed, 29 insertions, 6 deletions

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."))