diff options
Diffstat (limited to 'src/interactive')
-rw-r--r-- | src/interactive/button.lisp | 89 | ||||
-rw-r--r-- | src/interactive/frameset.lisp | 3 | ||||
-rw-r--r-- | src/interactive/sprite.lisp | 3 |
3 files changed, 25 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 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))) |