diff options
| -rw-r--r-- | src/interactive/frameset.lisp | 85 | ||||
| -rw-r--r-- | src/wheelwork.lisp | 4 | ||||
| -rw-r--r-- | wheelwork.asd | 4 |
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"))) |