(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

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

  ;; 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 (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))
               (delay (tw-delay tw))
               (duration (tw-duration tw))
               (ease-fn (tw-ease-fn tw))
               (starts (tw-starts tw))
               (ends (tw-ends tw)))
          (cond ((< elapsed delay)
                 (values (make-tw starts: starts ends: ends duration: duration
                                  delay: delay ease-fn: ease-fn
                                  elapsed: elapsed done?: #f callback: (tw-callback tw))
                         entity))
                (else
                 (let* ((t0 (- elapsed delay))
                        (u-raw (/ t0 duration))
                        (u (min 1.0 (max 0.0 u-raw)))
                        (eased (ease-fn u))
                        (ent2 (apply-props entity starts ends eased)))
                   (if (>= u 1.0)
                       (let* ((final (apply-props entity starts ends 1.0))
                              (cb (tw-callback tw))
                              (_ (when cb (cb final)))
                              (tw2 (make-tw starts: starts ends: ends duration: duration
                                             delay: delay ease-fn: ease-fn
                                             elapsed: elapsed done?: #t callback: #f)))
                         (values tw2 final))
                       (values (make-tw starts: starts ends: ends duration: duration
                                        delay: delay ease-fn: ease-fn
                                        elapsed: elapsed done?: #f callback: (tw-callback tw))
                               ent2))))))))
) ;; end module