aboutsummaryrefslogtreecommitdiffhomepage
path: root/src/interactive/sprite.lisp
blob: 03bba8d78c04a80be4a9116ad025efb4bc3be8b3 (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
;;;; sprite.lisp

(in-package #:wheelwork)

(defclass/std sprite (unit interactive)
  ((framesets :with :doc "A PLIST whose values are framesets.")
   (frameset-key)))

(defun current-frameset (sprite)
  (getf (sprite-framesets 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-container 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)))