(module downstroke-tween *
  (import scheme
          (chicken base)
          (chicken keyword)
          (only srfi-1 fold)
          defstruct
          downstroke-entity)

  ;; ── Easing: t in [0,1] → eased factor in [0,1] for linear interpolation ──

  (define (ease-linear t) t)

  (define (ease-quad-in t) (* t t))

  (define (ease-quad-out t)
    (- 1 (* (- 1 t) (- 1 t))))

  (define (ease-quad-in-out t)
    (if (< t 0.5)
        (* 2 t t)
        (- 1 (* 2 (- 1 t) (- 1 t)))))

  (define (ease-cubic-in t) (* t t t))

  (define (ease-cubic-out t)
    (- 1 (expt (- 1 t) 3)))

  (define (ease-cubic-in-out t)
    (if (< t 0.5)
        (* 4 t t t)
        (- 1.0 (/ (expt (- 2 (* 2 t)) 3) 2))))

  (define (ease-sine-in-out t)
    (- 0.5 (* 0.5 (cos (* 3.14159265358979323846 t)))))

  (define (ease-expo-in t)
    (if (zero? t) 0.0 (expt 2 (* 10 (- t 1)))))

  (define (ease-expo-out t)
    (if (>= t 1) 1.0 (- 1.0 (expt 2 (* -10 t)))))

  (define (ease-expo-in-out t)
    (cond ((<= t 0) 0.0)
          ((>= t 1) 1.0)
          ((< t 0.5) (/ (expt 2 (- (* 20 t) 10)) 2))
          (else (- 1 (/ (expt 2 (+ (* -20 t) 10)) 2)))))

  ;; Overshoots past 1 then settles (Robert Penner back-out, s ≈ 1.70158)
  (define (ease-back-out t)
    (let ((s 1.70158)
          (u (- t 1)))
      (+ 1 (* (+ 1 s) (expt u 3)) (* s (expt u 2)))))

  ;; ── Symbol → ease procedure ───────────────────────────────────────────────

  (define *ease-table*
    `((linear . ,ease-linear)
      (quad-in . ,ease-quad-in)
      (quad-out . ,ease-quad-out)
      (quad-in-out . ,ease-quad-in-out)
      (cubic-in . ,ease-cubic-in)
      (cubic-out . ,ease-cubic-out)
      (cubic-in-out . ,ease-cubic-in-out)
      (sine-in-out . ,ease-sine-in-out)
      (expo-in . ,ease-expo-in)
      (expo-out . ,ease-expo-out)
      (expo-in-out . ,ease-expo-in-out)
      (back-out . ,ease-back-out)))

  (define (ease-named sym)
    (cond ((assq sym *ease-table*) => cdr)
          (else (error "ease-named: unknown ease symbol" sym))))

  (define (ease-resolve ease)
    (cond ((procedure? ease) ease)
          ((symbol? ease) (ease-named ease))
          (else (error "ease-resolve: expected symbol or procedure" ease))))

  ;; ── Tween struct (internal) ───────────────────────────────────────────────

  (defstruct tw
    starts          ;; alist: (key . start-num)
    ends            ;; alist: (key . end-num)
    duration        ;; ms, > 0
    delay           ;; ms, >= 0
    ease-fn         ;; number → number
    elapsed         ;; ms since tween started (includes delay period)
    done?           ;; boolean
    callback        ;; (entity → unspecified) or #f; invoked once at completion
    repeat          ;; -1 = infinite, 0 = no more repeats, N = N repeats remaining
    yoyo?)          ;; swap starts/ends on each repeat cycle

  ;; ── Public API ────────────────────────────────────────────────────────────

  (define (tween-finished? t) (tw-done? t))

  (define (tween-active? t) (not (tw-done? t)))

  ;; props: alist of (keyword . target-number), e.g. ((#:x . 200) (#:y . 40))
  (define (make-tween entity #!key props (duration 500) (delay 0) (ease 'linear)
                      (on-complete #f) (repeat 0) (yoyo? #f))
    (unless (and (integer? duration) (> duration 0))
      (error "make-tween: duration must be a positive integer (ms)" duration))
    (unless (and (integer? delay) (>= delay 0))
      (error "make-tween: delay must be a non-negative integer (ms)" delay))
    (unless (pair? props)
      (error "make-tween: props must be a non-empty alist" props))
    (unless (and (integer? repeat) (>= repeat -1))
      (error "make-tween: repeat must be -1 (infinite) or a non-negative integer" repeat))
    (let ((ease-fn (ease-resolve ease))
          (starts (map (lambda (p)
                         (let ((k (car p)))
                           (unless (keyword? k)
                             (error "make-tween: property keys must be keywords" k))
                           (cons k (entity-ref entity k 0))))
                       props)))
      (make-tw starts: starts
               ends: props
               duration: duration
               delay: delay
               ease-fn: ease-fn
               elapsed: 0
               done?: #f
               callback: on-complete
               repeat: repeat
               yoyo?: yoyo?)))

  ;; Linear interpolation with eased factor u in [0,1]
  (define (lerp a b u)
    (+ a (* (- b a) u)))

  (define (apply-props entity starts ends u)
    (fold (lambda (end-pair ent)
            (let* ((k (car end-pair))
                   (end (cdr end-pair))
                   (start (cdr (assq k starts))))
              (entity-set ent k (lerp start end u))))
          entity
          ends))

  (define (tw-with-elapsed tw elapsed)
    (make-tw starts: (tw-starts tw) ends: (tw-ends tw)
             duration: (tw-duration tw) delay: (tw-delay tw)
             ease-fn: (tw-ease-fn tw) elapsed: elapsed
             done?: #f callback: (tw-callback tw)
             repeat: (tw-repeat tw) yoyo?: (tw-yoyo? tw)))

  (define (tw-finish tw elapsed)
    (make-tw starts: (tw-starts tw) ends: (tw-ends tw)
             duration: (tw-duration tw) delay: (tw-delay tw)
             ease-fn: (tw-ease-fn tw) elapsed: elapsed
             done?: #t callback: #f
             repeat: 0 yoyo?: (tw-yoyo? tw)))

  (define (tw-next-cycle tw overflow)
    (let* ((yoyo? (tw-yoyo? tw))
           (starts (tw-starts tw))
           (ends   (tw-ends tw)))
      (make-tw starts: (if yoyo? ends starts)
               ends:   (if yoyo? starts ends)
               duration: (tw-duration tw) delay: 0
               ease-fn: (tw-ease-fn tw) elapsed: overflow
               done?: #f callback: (tw-callback tw)
               repeat: (let ((r (tw-repeat tw))) (if (= r -1) -1 (- r 1)))
               yoyo?: yoyo?)))

  (define (tween-complete tw entity elapsed)
    (let ((final (apply-props entity (tw-starts tw) (tw-ends tw) 1.0)))
      (if (zero? (tw-repeat tw))
          (begin
            (when (tw-callback tw) ((tw-callback tw) final))
            (values (tw-finish tw elapsed) final))
          (let ((overflow (- (- elapsed (tw-delay tw)) (tw-duration tw))))
            (values (tw-next-cycle tw overflow) final)))))

  (define (tween-interpolate tw entity elapsed)
    (let* ((t0    (- elapsed (tw-delay tw)))
           (u     (min 1.0 (max 0.0 (/ t0 (tw-duration tw)))))
           (eased ((tw-ease-fn tw) u))
           (ent2  (apply-props entity (tw-starts tw) (tw-ends tw) eased)))
      (if (>= u 1.0)
          (tween-complete tw entity elapsed)
          (values (tw-with-elapsed tw elapsed) ent2))))

  (define (tween-step tw entity dt)
    (unless (tw? tw) (error "tween-step: expected tween struct" tw))
    (if (tw-done? tw)
        (values tw entity)
        (let ((elapsed (+ (tw-elapsed tw) dt)))
          (if (< elapsed (tw-delay tw))
              (values (tw-with-elapsed tw elapsed) entity)
              (tween-interpolate tw entity elapsed)))))

  ;; ── Pipeline step ──────────────────────────────────────────────────────────
  ;; Auto-advance #:tween on an entity. Call from update: as part of the
  ;; per-entity pipeline, e.g. (step-tweens entity dt). Removes #:tween
  ;; when the tween finishes.

  (define-pipeline (step-tweens tweens) (entity scene dt)
      guard: (entity-ref entity #:tween #f)
    (let ((tw (entity-ref entity #:tween)))
      (receive (tw2 ent2) (tween-step tw entity dt)
        (if (tween-finished? tw2)
            (entity-set ent2 #:tween #f)
            (entity-set ent2 #:tween tw2)))))

) ;; end module