diff options
| -rw-r--r-- | wheelwork.lisp | 86 |
1 files changed, 46 insertions, 40 deletions
diff --git a/wheelwork.lisp b/wheelwork.lisp index 059db18..2968cc7 100644 --- a/wheelwork.lisp +++ b/wheelwork.lisp @@ -14,17 +14,28 @@ (defmethod (setf closer-mop:slot-value-using-class) :after (newval class (unit unit) slot) - (when (member (closer-mop:slot-definition-name slot) - '(x y width height rotation )) - (setf (cached-model unit) nil))) + (case (closer-mop:slot-definition-name slot) + ((x y width height rotation ) + (setf (cached-model unit) nil)))) (defclass/std container () ((units :with :a)) - (:documentation "Just a list of units. Made into a class so that transformation affine transformations methods can be specialzied on whole groups of units")) + (:documentation "Just a list of units. Made into a class so that + transformation affine transformations methods can be specialzied on + whole groups of units")) + +(defun remove-unit (unit) + "Removes a unit from its container. Returns T if the unit actually was removed." + (when (unit-container unit) + (setf + (container-units (unit-container unit)) (delete unit (container-units (unit-container units))) + (unit-container unit) nil) + t)) (defun add-unit (container unit) "Adds a unit to the end of a container (thus affecting render -order). Makes sure to remove the unit from its current container if necessary." +order). Makes sure to remove the unit from its current container if +necessary." (when (unit-container unit) (remove-unit unit)) (setf (container-units container) @@ -32,16 +43,37 @@ order). Makes sure to remove the unit from its current container if necessary." (list unit))) unit) -(defun remove-unit (unit) - "Removes a unit from its container. Returns T if the unit actually was removed." - (when (unit-container unit) - (setf - (container-units (unit-container unit)) (delete unit (container-units (unit-container units))) - (unit-container unit) nil) - t)) - +(defclass/std event-handler () + ((event-type handler-function :ri)) + (:metaclass closer-mop:funcallable-standard-class)) + +(defmethod initialize-instance :after ((eh event-handler) &key) + (with-slots (handler-function) eh + (closer-mop:set-funcallable-instance-function eh handler-function))) + +(defclass/std listener () + ((keydown keyup mousedown mouseup mousemotion mousewheel focus blur perframe + :r :with :type (or null event-handler) :std nil) + (keydown-table + keyup-table + mousedown-table + mouseup-table + mousemotion-table + mousewheel-table + focus-table + blur-table + perframe-table + :static + :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.")) + + + (defclass/std interactive () - ((listener :type (or null listener) :std nil :a))) + ((listener :type (or null listener) :std nil :a)) + (:documentation "Supplies an object with a listener slot.")) (defun set-handler (interactive handler) (when (null (listener interactive)) @@ -303,32 +335,6 @@ order). Makes sure to remove the unit from its current container if necessary." (gl:generate-mipmap :texture-2d))))) -(defclass/std event-handler () - ((event-type handler-function :ri)) - (:metaclass closer-mop:funcallable-standard-class)) - -(defmethod initialize-instance :after ((eh event-handler) &key) - (with-slots (handler-function) eh - (closer-mop:set-funcallable-instance-function eh handler-function))) - - -(defclass/std listener () - ((keydown keyup mousedown mouseup mousemotion mousewheel focus blur perframe - :r :with :type (or null event-handler) :std nil) - (keydown-table - keyup-table - mousedown-table - mouseup-table - mousemotion-table - mousewheel-table - focus-table - blur-table - perframe-table - :static - :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.")) (defun refocus-on (target &optional (app *application*)) |