blob: 521b73cfbfe14361411994bdc655e658ca601b65 (
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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
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))))
|
