diff options
author | Colin Okay <colin@cicadas.surf> | 2022-07-06 09:33:14 -0500 |
---|---|---|
committer | Colin Okay <colin@cicadas.surf> | 2022-07-06 09:33:14 -0500 |
commit | fda1d9d08349dfe103b7af3ef8f305c1701933f6 (patch) | |
tree | 5cb896cf87d140df5bd05cb1f56566cfb0f17407 /src/interactive/button.lisp | |
parent | 8c94460d8c8f8b44ca9bcdebbf2906e84c969b19 (diff) |
[refactor] containers have render bounds
Diffstat (limited to 'src/interactive/button.lisp')
-rw-r--r-- | src/interactive/button.lisp | 89 |
1 files changed, 19 insertions, 70 deletions
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 |