From b46890f66a25e3f28bfb16e0b1fa8fabe8067556 Mon Sep 17 00:00:00 2001
From: Colin Okay <colin@cicadas.surf>
Date: Fri, 1 Jul 2022 10:20:48 -0500
Subject: [refactor] generating frameset accessors using macrolet

---
 src/interactive/frameset.lisp | 85 +++++++++----------------------------------
 1 file changed, 17 insertions(+), 68 deletions(-)

(limited to 'src/interactive/frameset.lisp')

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)
-- 
cgit v1.2.3