(module (downstroke animation) *
(import scheme
        (chicken base)
	(chicken pretty-print)
	(only srfi-1 filter)
        (downstroke entity)
        (downstroke world))

;; Animation definitions are alists (converted from plist form in the user's
;; prefab data file by load-prefabs). Each animation is an alist with keys
;; #:name, #:frames, optional #:duration.

;; Look up a key in an animation alist. Mirrors entity-ref:
;; a non-procedure default is returned as-is on miss; a procedure default
;; is invoked as a thunk.
(define (animation-ref anim key #!optional default)
  (cond ((assq key anim) => cdr)
        ((procedure? default) (default))
        (else default)))

(define +default-anim-duration+ 100) ; 100ms

(define (animation-frames anim) (animation-ref anim #:frames 1))
(define (animation-duration anim) (animation-ref anim #:duration +default-anim-duration+))

(define (frame-by-idx frames frame-idx)
  (list-ref frames (modulo frame-idx (length frames))))

;; A "timed" frame is =(tile-id tick-budget)= — a two-element proper list.
;; A bare tile id is a number (or other atom).
(define (timed-frame? frame-def)
  (and (pair? frame-def)
       (pair? (cdr frame-def))
       (null? (cddr frame-def))))

;; The tile ID is 1-indexed.
(define (frame->tile-id frames frame-idx)
  (let ((frame-def (frame-by-idx frames frame-idx)))
    (if (timed-frame? frame-def)
	(car frame-def)
	frame-def)))

;; Tick budget for one frame, in this order:
;; 1. Per-frame duration from =(tile duration)= in #:frames
;; 2. Else the animation alist's #:duration
;; 3. Else +default-anim-duration+ (global default)
(define (animation-frame-duration animation frame-idx)
  (let ((frame-def (frame-by-idx (animation-frames animation) frame-idx)))
    (if (timed-frame? frame-def)
	(cadr frame-def)
	(animation-ref animation #:duration +default-anim-duration+))))

;; ---- set-animation ----
;; Switch to a new animation, resetting frame and tick counters.
;; No-op if the animation is already active (avoids restart mid-loop).

(define (set-animation entity name)
  (if (eq? (entity-ref entity #:anim-name #f) name)
      entity
      (entity-set (entity-set (entity-set entity #:anim-name name)
                              #:anim-frame 0)
                  #:anim-tick 0)))


(define (animation-by-name animations name)
  (let ((matching-anims
         (filter (lambda (anim) (eq? (animation-ref anim #:name) name))
                 animations)))
    (if (pair? matching-anims)
	(car matching-anims)
	#f)))

;; ---- animate-entity ----
;; Advance the animation tick/frame counter for one game tick.
;; Pass the animation table for this entity's type.
;; Entities without #:anim-name are returned unchanged.
;; Tick threshold is always (animation-frame-duration anim frame) — per-frame pair,
;; then animation #:duration, then +default-anim-duration+. #:anim-duration
;; on the entity is set every step to that resolved value.

(define (advance-animation entity anim dt)
  (let* ((frame    (entity-ref entity #:anim-frame 0))
         (frames   (animation-frames anim))
         (duration (animation-frame-duration anim frame))
         (tick     (+ dt (entity-ref entity #:anim-tick 0))))
    (if (>= tick duration)
        (let ((new-frame-id (modulo (+ frame 1) (length frames))))
          (entity-set-many entity
			   `((#:anim-tick . 0)
			     (#:anim-frame . ,new-frame-id)
			     (#:tile-id . ,(frame->tile-id frames new-frame-id))
			     (#:anim-duration . ,(animation-frame-duration anim new-frame-id)))))
        (entity-set-many entity
			 `((#:anim-tick . ,tick)
			   (#:tile-id . ,(frame->tile-id frames frame))
			   (#:anim-duration . ,duration))))))

(define (animate-entity entity animations dt)
  (let* ((anim-name (entity-ref entity #:anim-name #f))
         (anim      (and anim-name (animation-by-name animations anim-name))))
    (if anim
        (advance-animation entity anim dt)
        entity)))

(define-pipeline (apply-animation animation) (scene entity dt)
  guard: (entity-ref entity #:animations #f)
  (let ((animations (entity-ref entity #:animations #f)))
    (animate-entity entity animations dt)))

) ;; End of animation module