diff options
author | Colin Okay <colin@cicadas.surf> | 2022-06-30 09:29:28 -0500 |
---|---|---|
committer | Colin Okay <colin@cicadas.surf> | 2022-06-30 09:29:28 -0500 |
commit | 98b5811d8b50d20f8c15e9b202f0d3f0457df58b (patch) | |
tree | 6562850bbd01236cac901208d528ca2dacf83dc0 /src/core | |
parent | 642c0c594a8abe05be1cb887110ed3e602cd0e48 (diff) |
[modify] affine fns are generic; [add] safe-slot util
Diffstat (limited to 'src/core')
-rw-r--r-- | src/core/affine.lisp | 12 | ||||
-rw-r--r-- | src/core/unit.lisp | 8 |
2 files changed, 13 insertions, 7 deletions
diff --git a/src/core/affine.lisp b/src/core/affine.lisp index cabe17c..4585a81 100644 --- a/src/core/affine.lisp +++ b/src/core/affine.lisp @@ -15,7 +15,9 @@ (setf (cached-model affine) nil (cached-projected-matrix affine) nil)))) -(defun scale-by (affine amount) + + +(defmethod scale-by ((affine affine) amount) (with-slots (scale-x scale-y) affine (setf scale-x (* amount scale-x) scale-y (* amount scale-y)))) @@ -26,19 +28,19 @@ (defun set-height-preserve-aspect (affine new-height) (scale-by affine (/ new-height (height affine) ))) -(defun width (affine) +(defmethod width ((affine affine)) (with-slots (scale-x base-width) affine (* scale-x base-width))) -(defun height (affine) +(defmethod height ((affine affine)) (with-slots (scale-y base-height) affine (* scale-y base-height))) -(defun (setf width) (newval affine) +(defmethod (setf width) (newval (affine affine)) (with-slots (scale-x base-width) affine (setf scale-x (coerce (/ newval base-width) 'single-float)))) -(defun (setf height) (newval affine) +(defmethod (setf height) (newval (affine affine)) (with-slots (scale-y base-height) affine (setf scale-y (coerce (/ newval base-height) 'single-float)))) diff --git a/src/core/unit.lisp b/src/core/unit.lisp index 20e05e2..fb02f08 100644 --- a/src/core/unit.lisp +++ b/src/core/unit.lisp @@ -3,8 +3,9 @@ (in-package #:wheelwork) (defclass/std unit () - ((cached-application :a) - (container :with :a))) + ((cached-application :a) + (container :with :a) + (visiblep :with :std t))) (defmethod (setf closer-mop:slot-value-using-class) :after (newval class (unit unit) slot) @@ -28,3 +29,6 @@ in this application." (rec unit))))) +(defmethod render :around ((unit unit)) + (when (unit-visiblep unit) + (call-next-method))) |