blob: 65762c7c9e75177ab2a2a7090d00391d51d39a38 (
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
|
;;;; frameset.lisp
(in-package #:wheelwork)
;; TODO: be more specific about vector types
(def:class frameset (unit interactive)
((frames "Vector of renderable frames.")
:prefix :type vector)
((sequence "Vector of indicies into the frame controlling order of display")
:prefix :type vector)
((runningp "Whether this set is animating by cycling through frames")
:type boolean :initform t)
((wait-time "Milliseconds between frames")
:prefix :initform (/ 1000.0 2))
((count "")
(index "")
(next-time "")
:prefix :initform 0))
(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 x y scale-x scale-y rotation) fs
(setf index 0
count (length sequence))
(loop for frame across frames
when frame
do (setf (unit-in-scene-p frame) fs
(x frame) x
(y frame) y
(scale-x frame) scale-x
(scale-y frame) scale-y
(rotation frame) rotation))))
(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))
(images
(loop for name in asset-names
collect
(make-instance
'image
: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 images) :initial-contents images)
:sequence (make-array (length sequence) :initial-contents sequence)
:wait-time (/ 1000.0 fps))))
|
