diff options
Diffstat (limited to 'src/core-units')
| -rw-r--r-- | src/core-units/unit.lisp | 34 |
1 files changed, 26 insertions, 8 deletions
diff --git a/src/core-units/unit.lisp b/src/core-units/unit.lisp index 6ccd31e..31f268c 100644 --- a/src/core-units/unit.lisp +++ b/src/core-units/unit.lisp @@ -3,13 +3,21 @@ (in-package #:wheelwork) (defclass/std unit () - ((cached-model cached-projected-matrix :a) + ((cached-model cached-projected-matrix cached-application :a) (container :with :a) (base-width base-height :r :std 1.0 :doc "Determined by content.") (scale-x scale-y :with :std 1.0) (rotation x y :with :std 0.0) (opacity :std 1.0 :doc "0.0 indicates it will not be rendred."))) +(defmethod (setf closer-mop:slot-value-using-class) :after + (newval class (unit unit) slot) + (case (closer-mop:slot-definition-name slot) + ((x y scale-x scale-y rotation) + (setf (cached-model unit) nil + (cached-projected-matrix unit) nil)) + (container + (setf (cached-application unit) nil)))) (defun scale-by (unit amount) (with-slots (scale-x scale-y) unit @@ -38,12 +46,7 @@ (with-slots (scale-y base-height) unit (setf scale-y (coerce (/ newval base-height) 'single-float)))) -(defmethod (setf closer-mop:slot-value-using-class) :after - (newval class (unit unit) slot) - (case (closer-mop:slot-definition-name slot) - ((x y scale-x scale-y rotation) - (setf (cached-model unit) nil - (cached-projected-matrix unit) nil)))) + (defmethod model-matrix :around ((u unit)) (or (cached-model u) @@ -64,8 +67,23 @@ (mat:nmscale m (vec:vec uw uh 1.0)))) m)) + +(defun app-of-unit (unit) + "Returns the APPLICATION instance, if any, of which this UNIT is a +part. NIL indicates that the unit has not been added to any container +in this application." + (or (cached-application unit) + (setf (cached-application unit) + (labels ((rec (u) + (when-let (c (unit-container u)) + (etypecase c + (application c) + (unit (rec c)) + (null nil))))) + (rec unit))))) + (defun projected-matrix (unit) (or (cached-projected-matrix unit) (setf (cached-projected-matrix unit) - (mat:marr (mat:m* (application-projection *application*) + (mat:marr (mat:m* (application-projection (app-of-unit unit)) (model-matrix unit)))))) |