aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorColin Okay <colin@cicadas.surf>2022-07-01 10:20:48 -0500
committerColin Okay <colin@cicadas.surf>2022-07-01 10:20:48 -0500
commitb46890f66a25e3f28bfb16e0b1fa8fabe8067556 (patch)
tree916f41455ca52c10936373920f82deb8ff356298
parent867703d82c6e8b7a2b424845fcb30537061de45a (diff)
[refactor] generating frameset accessors using macrolet
-rw-r--r--src/interactive/frameset.lisp85
-rw-r--r--src/wheelwork.lisp4
-rw-r--r--wheelwork.asd4
3 files changed, 20 insertions, 73 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))
diff --git a/wheelwork.asd b/wheelwork.asd
index 3d37472..af2b10a 100644
--- a/wheelwork.asd
+++ b/wheelwork.asd
@@ -40,6 +40,8 @@
:components ((:file "interactive")
(:file "bitmap")
(:file "text")
- (:file "button")))
+ (:file "button")
+ (:file "frameset")
+ (:file "sprite")))
(:file "application")
(:file "wheelwork")))