From fda1d9d08349dfe103b7af3ef8f305c1701933f6 Mon Sep 17 00:00:00 2001
From: Colin Okay <colin@cicadas.surf>
Date: Wed, 6 Jul 2022 09:33:14 -0500
Subject: [refactor] containers have render bounds
---
src/interactive/button.lisp | 89 +++++++++----------------------------------
src/interactive/frameset.lisp | 3 ++
src/interactive/sprite.lisp | 3 ++
3 files changed, 25 insertions(+), 70 deletions(-)
(limited to 'src/interactive')
diff --git a/src/interactive/button.lisp b/src/interactive/button.lisp
index e8fd4fa..87779f0 100644
--- a/src/interactive/button.lisp
+++ b/src/interactive/button.lisp
@@ -61,76 +61,25 @@
(render up)
(render down))))
-(defmethod x ((button button))
- (x (button-up button)))
-
-(defmethod (setf x) (newval (button button))
- (with-slots (up down bg) button
- (when bg
- (setf (x bg) newval))
- (setf (x up) newval
- (x down) newval)))
-
-(defmethod y ((button button))
- (y (button-up button)))
-
-(defmethod (setf y) (newval (button button))
- (with-slots (up down bg) button
- (when bg
- (setf (y bg) newval))
- (setf (y up) newval
- (y down) newval)))
-
-(defmethod scale-x ((thing button))
- (scale-x (button-up thing)))
-
-(defmethod (setf scale-x) (newval (button button))
- (with-slots (up down bg) button
- (when bg
- (setf (scale-x bg) newval))
- (setf (scale-x up) newval
- (scale-x down) newval)))
-
-
-(defmethod scale-y ((thing button))
- (scale-y (button-up thing)))
-
-(defmethod (setf scale-y) (newval (button button))
- (with-slots (up down bg) button
- (when bg
- (setf (scale-y bg) newval))
- (setf (scale-y up) newval
- (scale-y down) newval)))
-
-(defmethod rotation ((thing button))
- (rotation (button-up thing)))
-
-(defmethod (setf rotation) (newval (button button))
- (with-slots (up down bg) button
- (when bg
- (setf (rotation bg) newval))
- (setf (rotation up) newval
- (rotation down) newval)))
-
-(defmethod width ((thing button))
- (width (button-up thing)))
-
-(defmethod (setf width) (newval (button button))
- (with-slots (up down bg) button
- (when bg
- (setf (width bg) newval))
- (setf (width up) newval
- (width down) newval)))
-
-(defmethod height ((thing button))
- (height (button-up thing)))
-
-(defmethod (setf height) (newval (button button))
- (with-slots (up down bg) button
- (when bg
- (setf (height bg) newval))
- (setf (height up) newval
- (height down) newval)))
+(macrolet
+ ((def-accessors (&rest accessor-names)
+ (let ((defs
+ (loop for accessor-name in accessor-names
+ collect
+ `(defmethod ,accessor-name ((button button))
+ (,accessor-name (button-up button)))
+
+ collect
+ `(defmethod (setf ,accessor-name) (newval (button button))
+ (setf (,accessor-name (button-up button)) newval
+ (,accessor-name (button-down button)) newval
+ (,accessor-name (button-bg button)) newval)))))
+ `(progn ,@defs))))
+
+ (def-accessors x y scale-x scale-y width height rotation))
+
+(defmethod get-rect ((button button))
+ (get-rect (button-up button)))
(defun make-texture-button (up down &key pressed released)
"UP and DOWN should be strings naming assets to use as the up and
diff --git a/src/interactive/frameset.lisp b/src/interactive/frameset.lisp
index 51c7ecd..a8ba079 100644
--- a/src/interactive/frameset.lisp
+++ b/src/interactive/frameset.lisp
@@ -67,6 +67,9 @@
(def-frameset-accessors x y scale-x scale-y width height rotation))
+(defmethod get-rect ((fs frameset))
+ (get-rect (current-frame-unit fs)))
+
(defun make-frameset (sequenced-assets &key (fps 2) asset-args)
(let* ((asset-names
(remove-duplicates sequenced-assets :test #'equal))
diff --git a/src/interactive/sprite.lisp b/src/interactive/sprite.lisp
index 81f5715..03bba8d 100644
--- a/src/interactive/sprite.lisp
+++ b/src/interactive/sprite.lisp
@@ -40,3 +40,6 @@
`(progn ,@defs))))
(def-sprite-accessors x y scale-x scale-y width height rotation))
+
+(defmethod get-rect ((sprite sprite))
+ (get-rect (current-frameset sprite)))
--
cgit v1.2.3