blob: a8ba0795b558ef143d594bb9d91bd18301bf9911 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
;;;; 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) :after (newval (fs frameset))
(with-slots (count index) fs
(setf 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))))
(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)))
(macrolet
((def-frameset-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-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))
(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))))
|
