diff options
| -rw-r--r-- | examples/02-moving-bitmp.lisp | 33 | ||||
| -rw-r--r-- | wheelwork.lisp | 35 |
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.")) |