diff options
author | Colin Okay <colin@cicadas.surf> | 2022-07-01 10:20:48 -0500 |
---|---|---|
committer | Colin Okay <colin@cicadas.surf> | 2022-07-01 10:20:48 -0500 |
commit | b46890f66a25e3f28bfb16e0b1fa8fabe8067556 (patch) | |
tree | 916f41455ca52c10936373920f82deb8ff356298 /src | |
parent | 867703d82c6e8b7a2b424845fcb30537061de45a (diff) |
[refactor] generating frameset accessors using macrolet
Diffstat (limited to 'src')
-rw-r--r-- | src/interactive/frameset.lisp | 85 | ||||
-rw-r--r-- | src/wheelwork.lisp | 4 |
2 files changed, 17 insertions, 72 deletions
diff --git a/src/interactive/frameset.lisp b/src/interactive/frameset.lisp index 521b73c..3a81bb8 100644 --- a/src/interactive/frameset.lisp +++ b/src/interactive/frameset.lisp @@ -52,75 +52,24 @@ (defmethod render ((fs frameset)) (render (current-frame-unit fs))) -(defmethod x ((fs frameset)) - (x (current-frame-unit fs))) -(defmethod (setf x) (newval (frameset frameset)) - (with-slots (frames) frameset - (loop for frame across frames - when frame - do (setf (x frame) newval))) - newval) - -(defmethod y ((frameset frameset)) - (y (current-frame-unit frameset))) - -(defmethod (setf y) (newval (frameset frameset)) - (with-slots (frames) frameset - (loop for frame across frames - when frame - do (setf (y frame) newval))) - newval) - -(defmethod scale-x ((frameset frameset)) - (scale-x (current-frame-unit frameset))) - -(defmethod (setf scale-x) (newval (frameset frameset)) - (with-slots (frames) frameset - (loop for frame across frames - when frame - do (setf (scale-x frame) newval))) - newval) - -(defmethod scale-y ((frameset frameset)) - (scale-y (current-frame-unit frameset))) - -(defmethod (setf scale-y) (newval (frameset frameset)) - (with-slots (frames) frameset - (loop for frame across frames - when frame - do (setf (scale-y frame) newval))) - newval) - -(defmethod rotation ((frameset frameset)) - (rotation (current-frame-unit frameset))) - -(defmethod (setf rotation) (newval (frameset frameset)) - (with-slots (frames) frameset - (loop for frame across frames - when frame - do (setf (rotation frame) newval))) - newval) - -(defmethod width ((frameset frameset)) - (width (current-frame-unit frameset))) - -(defmethod (setf width) (newval (frameset frameset)) - (with-slots (frames) frameset - (loop for frame across frames - when frame - do (setf (width frame) newval))) - newval) - -(defmethod height ((frameset frameset)) - (height (current-frame-unit frameset))) - -(defmethod (setf height) (newval (frameset frameset)) - (with-slots (frames) frameset - (loop for frame across frames - when frame - do (setf (height frame) newval))) - newval) +(macrolet + ((def-sprite-accessors (&rest accessor-names) + (let ((defs + (loop for accessor-name in accessor-names + collect + `(defmethod ,accessor-name ((fs frameset)) + (,accessor-name (current-frame-unit fs))) + + collect + `(defmethod (setf ,accessor-name) (newval (fs frameset)) + (loop for frame across (frameset-frames fs) + when frame + do (setf (,accessor-name frame) newval)) + newval)))) + `(progn ,@defs)))) + + (def-sprite-accessors x y scale-x scale-y width height rotation)) (defun make-frameset (sequenced-assets &key (fps 2) asset-args) diff --git a/src/wheelwork.lisp b/src/wheelwork.lisp index 849e2c7..b139f9d 100644 --- a/src/wheelwork.lisp +++ b/src/wheelwork.lisp @@ -254,11 +254,7 @@ ASSET-ARGS is a plist to pass to make-instance for the given resource. :path (uiop:merge-pathnames* asset-id (asset-root app)) asset-args))))) -(defun fps (&optional (app *application*)) - (application-fps app)) -(defun (setf fps) (new-val &optional (app *application*)) - (setf (application-fps app) new-val)) |