aboutsummaryrefslogtreecommitdiffhomepage
path: root/src/interactive/frameset.lisp
blob: c6abb4be551dff47693bfff6bb0ce16a5bd6c01a (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))))