diff options
author | Colin Okay <colin@cicadas.surf> | 2022-06-30 07:57:54 -0500 |
---|---|---|
committer | Colin Okay <colin@cicadas.surf> | 2022-06-30 07:57:54 -0500 |
commit | 642c0c594a8abe05be1cb887110ed3e602cd0e48 (patch) | |
tree | 2f4aced5b03abb0b8e4532f2676a18f8387895f7 /src/core-units | |
parent | 099c3f927c11fe7ae4d12933d6f72abc0b53e973 (diff) |
[structure] renamed some asd modules
Diffstat (limited to 'src/core-units')
-rw-r--r-- | src/core-units/affine.lisp | 69 | ||||
-rw-r--r-- | src/core-units/container.lisp | 32 | ||||
-rw-r--r-- | src/core-units/unit.lisp | 30 |
3 files changed, 0 insertions, 131 deletions
diff --git a/src/core-units/affine.lisp b/src/core-units/affine.lisp deleted file mode 100644 index cabe17c..0000000 --- a/src/core-units/affine.lisp +++ /dev/null @@ -1,69 +0,0 @@ -;;;; affine.lisp - -(in-package #:wheelwork) - -(defclass/std affine (unit) - ((cached-model cached-projected-matrix cached-application :a) - (base-width base-height :r :std 1.0 :doc "Determined by content.") - (scale-x scale-y :std 1.0) - (rotation x y :std 0.0))) - -(defmethod (setf closer-mop:slot-value-using-class) :after - (newval class (affine affine) slot) - (case (closer-mop:slot-definition-name slot) - ((x y scale-x scale-y rotation) - (setf (cached-model affine) nil - (cached-projected-matrix affine) nil)))) - -(defun scale-by (affine amount) - (with-slots (scale-x scale-y) affine - (setf scale-x (* amount scale-x) - scale-y (* amount scale-y)))) - -(defun set-width-preserve-aspect (affine new-width) - (scale-by affine (/ new-width (width affine)))) - -(defun set-height-preserve-aspect (affine new-height) - (scale-by affine (/ new-height (height affine) ))) - -(defun width (affine) - (with-slots (scale-x base-width) affine - (* scale-x base-width))) - -(defun height (affine) - (with-slots (scale-y base-height) affine - (* scale-y base-height))) - -(defun (setf width) (newval affine) - (with-slots (scale-x base-width) affine - (setf scale-x (coerce (/ newval base-width) 'single-float)))) - -(defun (setf height) (newval affine) - (with-slots (scale-y base-height) affine - (setf scale-y (coerce (/ newval base-height) 'single-float)))) - -(defmethod model-matrix :around ((u affine)) - (or (cached-model u) - (setf (cached-model u) - (call-next-method)))) - -(defmethod model-matrix ((u affine)) - (let ((m (mat:meye 4))) - (with-slots (x y base-width scale-x base-height scale-y rotation) u - (let ((uw (* base-width scale-x)) - (uh (* base-height scale-y))) - (mat:nmtranslate m (vec:vec x y 0.0)) - - (mat:nmtranslate m (vec:v* 0.5 (vec:vec uw uh 0.0))) - (mat:nmrotate m vec:+vz+ rotation) - (mat:nmtranslate m (vec:v* -0.5 (vec:vec uw uh 0.0))) - - (mat:nmscale m (vec:vec uw uh 1.0)))) - m)) - - -(defun projected-matrix (affine) - (or (cached-projected-matrix affine) - (setf (cached-projected-matrix affine) - (mat:marr (mat:m* (application-projection (app-of-unit affine)) - (model-matrix affine)))))) diff --git a/src/core-units/container.lisp b/src/core-units/container.lisp deleted file mode 100644 index af01ff1..0000000 --- a/src/core-units/container.lisp +++ /dev/null @@ -1,32 +0,0 @@ -;;;; units/container.lisp - -(in-package #:wheelwork) - - -(defclass/std container (unit) - ((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")) - -(defmethod drop-unit ((unit unit)) - "Removes a unit from its container. Returns T if the unit actually was removed." - (when-let (container (unit-container unit)) - (setf - (container-units container) (delete unit (container-units container)) - (unit-container unit) nil) - t)) - -(defmethod add-unit ((container container) (unit 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." - (when (unit-container unit) - (drop-unit unit)) - (push unit (container-units container)) - (setf (unit-container unit) container) - unit) - -(defmethod cleanup ((container container)) - (dolist (u (container-units container)) - (cleanup u))) diff --git a/src/core-units/unit.lisp b/src/core-units/unit.lisp deleted file mode 100644 index 20e05e2..0000000 --- a/src/core-units/unit.lisp +++ /dev/null @@ -1,30 +0,0 @@ -;;;; units/unit.lisp - -(in-package #:wheelwork) - -(defclass/std unit () - ((cached-application :a) - (container :with :a))) - -(defmethod (setf closer-mop:slot-value-using-class) :after - (newval class (unit unit) slot) - (case (closer-mop:slot-definition-name slot) - (container - (setf (cached-application unit) nil)))) - - -(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))))) - - |