;;;; 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) :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) fs 
    (setf index 0
          count (length sequence))
    (loop for frame across frames
          when frame
            do (setf (unit-in-scene-p frame) fs))))

(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))))