blob: c212418c2e5b007b116e77758ac80d565c838f1f (
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
|
;;;; sprite.lisp
(in-package #:wheelwork)
(def:class sprite (unit interactive)
((framesets "A PLIST whose values are framesets")
:required :prefix)
((frameset-key "The name of the current frameset being displayed")
:required :prefix))
(defun current-frameset (sprite)
"Returns the current FRAMESET instance being displayed on SRPITE."
(getf (sprite-framesets sprite)
(sprite-frameset-key sprite)))
(defmethod initialize-instance :after ((sprite sprite) &key)
(with-slots (framesets frameset-key) sprite
(loop :for (name fs . more) :on framesets :by #'cddr :do
(setf (unit-in-scene-p fs) sprite))
(unless frameset-key
(setf frameset-key (first framesets)))))
(defmethod cleanup ((sprite sprite))
(mapc #'cleanup (sprite-framesets sprite)))
(defmethod render ((sprite sprite))
(when-let (fs (current-frameset sprite))
(render fs)))
(macrolet
((def-sprite-accessors (&rest accessor-names)
(let ((defs
(loop :for accessor-name :in accessor-names
:collect
`(defmethod ,accessor-name ((sprite sprite))
(,accessor-name (current-frameset sprite)))
:collect
`(defmethod (setf ,accessor-name) (newval (sprite sprite))
(loop :for (key fs . more) :on (sprite-framesets sprite) :by #'cddr
:do (setf (,accessor-name fs) newval))
newval))))
`(progn ,@defs))))
(def-sprite-accessors x y scale-x scale-y width height rotation))
(defmethod get-rect ((sprite sprite))
(get-rect (current-frameset sprite)))
|
