From 2d9298e36d3606895ecd5d548f03009305cd1a2c Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Thu, 23 Jun 2022 11:54:12 -0500 Subject: [add] perframe event handling --- wheelwork.lisp | 35 +++++++++++++++++++++++++++++------ 1 file changed, 29 insertions(+), 6 deletions(-) (limited to 'wheelwork.lisp') 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.")) -- cgit v1.2.3