aboutsummaryrefslogtreecommitdiffhomepage
path: root/src/interactive/frameset.lisp
diff options
context:
space:
mode:
authorColin Okay <colin@cicadas.surf>2022-07-01 09:47:16 -0500
committerColin Okay <colin@cicadas.surf>2022-07-01 09:47:16 -0500
commit867703d82c6e8b7a2b424845fcb30537061de45a (patch)
tree1f3180042222e819a91dcc3c8aa2810bc69efc2c /src/interactive/frameset.lisp
parentf93d073f8cd06fbccb1285ae04c8b9d2d5c5a7b0 (diff)
[add] frameset class and an [exmaple] using it
Diffstat (limited to 'src/interactive/frameset.lisp')
-rw-r--r--src/interactive/frameset.lisp142
1 files changed, 142 insertions, 0 deletions
diff --git a/src/interactive/frameset.lisp b/src/interactive/frameset.lisp
new file mode 100644
index 0000000..521b73c
--- /dev/null
+++ b/src/interactive/frameset.lisp
@@ -0,0 +1,142 @@
+;;;; frameset.lisp
+
+(in-package #:wheelwork)
+
+(defclass/std frameset (unit interactive)
+ ((frames :with :doc "an array of renderable frames")
+ (sequence :with :doc "an array of indices into frames")
+ (runningp :std t)
+ (wait-time :std (/ 1000.0 2) :with :doc "milliseconds between frames")
+ (count index next-time :with :std 0 :a)))
+
+(defmethod (setf fps) (newval (fs frameset))
+ (setf (frameset-wait-time fs) (/ 1000.0 newval)))
+
+(defmethod (setf frameset-index) :before (newval (fs frameset))
+ (setf (unit-visiblep (current-frame-unit fs)) nil))
+
+(defmethod (setf frameset-index) :after (newval (fs frameset))
+ (with-slots (count index) fs
+ (setf (unit-visiblep (current-frame-unit fs)) t
+ index (mod index count))))
+
+(defmethod (setf runningp) :after (newval (fs frameset))
+ ;; to prevent speedup after restart
+ (setf (frameset-next-time fs) (sdl2:get-ticks)))
+
+(defhandler check-advance-frameset-index
+ (on-perframe (target time)
+ (when (and (runningp target)
+ (<= (frameset-next-time target) time))
+ (incf (frameset-index target))
+ (incf (frameset-next-time target) (frameset-wait-time target)))))
+
+(defmethod cleanup ((frameset frameset))
+ (loop for frame across (frameset-frames frameset) do (cleanup frame)))
+
+(defmethod initialize-instance :after ((fs frameset) &key)
+ (add-handler fs #'check-advance-frameset-index)
+ (with-slots (index sequence count frames) fs
+ (setf index 0
+ count (length sequence))
+ (loop for frame across frames
+ when frame
+ do (setf (unit-container frame) fs
+ (unit-visiblep frame) nil))))
+
+(defun current-frame-unit (fs)
+ "Returns the unit be currently displaayed as the animation's frame."
+ (with-slots (index sequence count frames) fs
+ (aref frames (aref sequence (mod index count )))))
+
+(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)
+
+
+(defun make-frameset (sequenced-assets &key (fps 2) asset-args)
+ (let* ((asset-names
+ (remove-duplicates sequenced-assets :test #'equal))
+ (assets
+ (loop for name in asset-names
+ collect
+ (make-instance
+ 'bitmap
+ :texture (get-asset name :asset-args asset-args))))
+ (sequence
+ (loop for name in sequenced-assets
+ collect (position name asset-names :test #'equal))))
+ (make-instance
+ 'frameset
+ :frames (make-array (length assets) :initial-contents assets)
+ :sequence (make-array (length sequence) :initial-contents sequence)
+ :wait-time (/ 1000.0 fps))))