(import srfi-64
        (chicken base))
(include "entity.scm")
(include "tween.scm")
(import downstroke-entity downstroke-tween)

(test-begin "tween")

(test-group "ease functions"
  (test-equal "linear mid" 0.5 (ease-linear 0.5))
  (test-equal "quad-in mid" 0.25 (ease-quad-in 0.5))
  (test-equal "quad-out mid" 0.75 (ease-quad-out 0.5))
  (test-equal "quad-in-out mid" 0.5 (ease-quad-in-out 0.5))
  (test-equal "cubic-in mid" 0.125 (ease-cubic-in 0.5))
  (test-assert "sine-in-out endpoints"
    (and (= 0.0 (ease-sine-in-out 0)) (= 1.0 (ease-sine-in-out 1))))
  (test-equal "expo-in at 0" 0.0 (ease-expo-in 0))
  (test-equal "expo-out at 1" 1.0 (ease-expo-out 1))
  (test-equal "expo-in-out mid" 0.5 (ease-expo-in-out 0.5))
  (test-equal "cubic-in-out mid" 0.5 (ease-cubic-in-out 0.5))
  (test-equal "cubic-out mid" 0.875 (ease-cubic-out 0.5))
  (test-assert "cubic-in-out stays in [0,1]"
    (let loop ((i 0) (ok #t))
      (if (> i 100) ok
          (let* ((t (/ i 100))
                 (v (ease-cubic-in-out t)))
            (loop (+ i 1) (and ok (>= v 0) (<= v 1))))))))

(test-group "ease-named"
  (test-equal "quad-in-out proc" ease-quad-in-out (ease-named 'quad-in-out)))

(test-group "ease-resolve"
  (test-equal "symbol" ease-cubic-out (ease-resolve 'cubic-out))
  (test-equal "procedure passthrough" ease-linear (ease-resolve ease-linear)))

(test-group "make-tween / tween-step"
  (test-group "linear completes to target"
    (let* ((ent (list #:type 'a #:x 0 #:y 10))
           (tw (make-tween ent props: '((#:x . 100)) duration: 100 delay: 0 ease: 'linear)))
      (receive (tw2 e2) (tween-step tw ent 100)
        (test-assert "finished" (tween-finished? tw2))
        (test-equal "x at end" 100.0 (entity-ref e2 #:x))
        (test-equal "y preserved" 10 (entity-ref e2 #:y)))))

  (test-group "delay holds props"
    (let* ((ent (list #:type 'a #:x 0))
           (tw (make-tween ent props: '((#:x . 50)) duration: 100 delay: 40 ease: 'linear)))
      (receive (tw2 e2) (tween-step tw ent 30)
        (test-assert "not finished" (not (tween-finished? tw2)))
        (test-equal "x unchanged during delay" 0 (entity-ref e2 #:x))
        (receive (tw3 e3) (tween-step tw2 e2 9)
          (test-assert "still in delay at 39ms" (not (tween-finished? tw3)))
          (test-equal "x still 0" 0 (entity-ref e3 #:x))
          (receive (_tw4 e4) (tween-step tw3 e3 50)
            (test-assert "past delay, moved" (> (entity-ref e4 #:x) 0)))))))

  (test-group "midpoint linear"
    (let* ((ent (list #:type 'a #:x 0))
           (tw (make-tween ent props: '((#:x . 100)) duration: 100 delay: 0 ease: 'linear)))
      (receive (_ e2) (tween-step tw ent 50)
        (test-equal "halfway x" 50.0 (entity-ref e2 #:x)))))

  (test-group "on-complete runs once"
    (let ((calls 0))
      (let* ((ent (list #:type 'a #:x 0))
             (tw (make-tween ent props: '((#:x . 10)) duration: 10 delay: 0 ease: 'linear
                              on-complete: (lambda (_) (set! calls (+ calls 1))))))
        (receive (tw2 e2) (tween-step tw ent 10)
          (test-equal "one call" 1 calls)
          (receive (tw3 e3) (tween-step tw2 e2 5)
            (test-equal "still one call" 1 calls)
            (test-equal "entity stable" e3 e2))))))

  (test-group "idempotent after finish"
    (let* ((ent (list #:type 'a #:x 0))
           (tw (make-tween ent props: '((#:x . 20)) duration: 10 delay: 0 ease: 'linear)))
      (receive (tw2 e2) (tween-step tw ent 10)
        (receive (tw3 e3) (tween-step tw2 e2 999)
          (test-assert (tween-finished? tw3))
          (test-equal "x stays" 20.0 (entity-ref e3 #:x)))))))

(test-group "repeat"
  (test-group "repeat: 1 plays twice"
    (let* ((ent (list #:type 'a #:x 0))
           (tw (make-tween ent props: '((#:x . 100)) duration: 100
                            ease: 'linear repeat: 1)))
      (receive (tw2 e2) (tween-step tw ent 100)
        (test-assert "not finished after first play" (not (tween-finished? tw2)))
        (test-equal "x at target" 100.0 (entity-ref e2 #:x))
        (receive (tw3 e3) (tween-step tw2 e2 100)
          (test-assert "finished after second play" (tween-finished? tw3))
          (test-equal "x at target again" 100.0 (entity-ref e3 #:x))))))

  (test-group "repeat: -1 never finishes"
    (let* ((ent (list #:type 'a #:x 0))
           (tw (make-tween ent props: '((#:x . 10)) duration: 10
                            ease: 'linear repeat: -1)))
      (let loop ((tw tw) (ent ent) (i 0))
        (if (>= i 5) (test-assert "still active after 5 cycles" (tween-active? tw))
            (receive (tw2 e2) (tween-step tw ent 10)
              (test-assert "not finished" (not (tween-finished? tw2)))
              (loop tw2 e2 (+ i 1)))))))

  (test-group "repeat: 0 is default (no repeat)"
    (let* ((ent (list #:type 'a #:x 0))
           (tw (make-tween ent props: '((#:x . 50)) duration: 50 ease: 'linear)))
      (receive (tw2 _e2) (tween-step tw ent 50)
        (test-assert "finished immediately" (tween-finished? tw2)))))

  (test-group "on-complete fires after last repeat"
    (let ((calls 0))
      (let* ((ent (list #:type 'a #:x 0))
             (tw (make-tween ent props: '((#:x . 10)) duration: 10
                              ease: 'linear repeat: 1
                              on-complete: (lambda (_) (set! calls (+ calls 1))))))
        (receive (tw2 e2) (tween-step tw ent 10)
          (test-equal "no call after first play" 0 calls)
          (receive (tw3 e3) (tween-step tw2 e2 10)
            (test-equal "one call after last repeat" 1 calls))))))

  (test-group "on-complete does not fire with repeat: -1"
    (let ((calls 0))
      (let* ((ent (list #:type 'a #:x 0))
             (tw (make-tween ent props: '((#:x . 10)) duration: 10
                              ease: 'linear repeat: -1
                              on-complete: (lambda (_) (set! calls (+ calls 1))))))
        (let loop ((tw tw) (ent ent) (i 0))
          (if (>= i 5) (test-equal "never called" 0 calls)
              (receive (tw2 e2) (tween-step tw ent 10)
                (loop tw2 e2 (+ i 1)))))))))

(test-group "yoyo"
  (test-group "yoyo: #t with repeat: 1 reverses"
    (let* ((ent (list #:type 'a #:x 0))
           (tw (make-tween ent props: '((#:x . 100)) duration: 100
                            ease: 'linear repeat: 1 yoyo?: #t)))
      (receive (tw2 e2) (tween-step tw ent 100)
        (test-equal "x at target after forward" 100.0 (entity-ref e2 #:x))
        (receive (tw3 e3) (tween-step tw2 e2 50)
          (test-equal "x halfway back" 50.0 (entity-ref e3 #:x))
          (receive (tw4 e4) (tween-step tw3 e3 50)
            (test-assert "finished after reverse" (tween-finished? tw4))
            (test-equal "x back to start" 0.0 (entity-ref e4 #:x)))))))

  (test-group "yoyo: #t with repeat: -1 ping-pongs forever"
    (let* ((ent (list #:type 'a #:x 0))
           (tw (make-tween ent props: '((#:x . 100)) duration: 100
                            ease: 'linear repeat: -1 yoyo?: #t)))
      ;; Forward
      (receive (tw2 e2) (tween-step tw ent 100)
        (test-equal "at target" 100.0 (entity-ref e2 #:x))
        ;; Reverse
        (receive (tw3 e3) (tween-step tw2 e2 100)
          (test-equal "back to start" 0.0 (entity-ref e3 #:x))
          ;; Forward again
          (receive (tw4 e4) (tween-step tw3 e3 100)
            (test-equal "at target again" 100.0 (entity-ref e4 #:x))
            (test-assert "still active" (tween-active? tw4)))))))

  (test-group "yoyo: #f with repeat: 1 replays same direction"
    (let* ((ent (list #:type 'a #:x 0))
           (tw (make-tween ent props: '((#:x . 100)) duration: 100
                            ease: 'linear repeat: 1 yoyo?: #f)))
      (receive (tw2 e2) (tween-step tw ent 100)
        (test-equal "x at target" 100.0 (entity-ref e2 #:x))
        ;; Second play starts from same starts (0→100), but entity is at 100
        ;; The tween replays 0→100 using original start values
        (receive (tw3 e3) (tween-step tw2 e2 50)
          (test-assert "not finished mid-repeat" (not (tween-finished? tw3)))))))

  (test-group "yoyo: #t without repeat has no effect"
    (let* ((ent (list #:type 'a #:x 0))
           (tw (make-tween ent props: '((#:x . 100)) duration: 100
                            ease: 'linear repeat: 0 yoyo?: #t)))
      (receive (tw2 e2) (tween-step tw ent 100)
        (test-assert "finishes normally" (tween-finished? tw2))
        (test-equal "x at target" 100.0 (entity-ref e2 #:x))))))

(test-group "step-tweens pipeline"
  (test-group "advances #:tween on entity"
    (let* ((ent (list #:type 'a #:x 0
                      #:tween (make-tween (list #:x 0) props: '((#:x . 100))
                                duration: 100 ease: 'linear)))
           (e2 (step-tweens ent #f 50)))
      (test-equal "x moved to midpoint" 50.0 (entity-ref e2 #:x))
      (test-assert "tween still attached" (entity-ref e2 #:tween #f))))

  (test-group "removes #:tween when finished"
    (let* ((ent (list #:type 'a #:x 0
                      #:tween (make-tween (list #:x 0) props: '((#:x . 100))
                                duration: 100 ease: 'linear)))
           (e2 (step-tweens ent #f 100)))
      (test-equal "x at target" 100.0 (entity-ref e2 #:x))
      (test-equal "tween removed" #f (entity-ref e2 #:tween #f))))

  (test-group "no-op without #:tween"
    (let* ((ent (list #:type 'a #:x 42))
           (e2 (step-tweens ent #f 100)))
      (test-equal "x unchanged" 42 (entity-ref e2 #:x))))

  (test-group "keeps repeating tween attached"
    (let* ((ent (list #:type 'a #:x 0
                      #:tween (make-tween (list #:x 0) props: '((#:x . 100))
                                duration: 100 ease: 'linear repeat: -1 yoyo?: #t)))
           (e2 (step-tweens ent #f 100)))
      (test-equal "x at target" 100.0 (entity-ref e2 #:x))
      (test-assert "tween still attached (repeating)" (entity-ref e2 #:tween #f))))

  (test-group "respects #:skip-pipelines"
    (let* ((ent (list #:type 'a #:x 0
                      #:skip-pipelines '(tweens)
                      #:tween (make-tween (list #:x 0) props: '((#:x . 100))
                                duration: 100 ease: 'linear)))
           (e2 (step-tweens ent #f 100)))
      (test-equal "x unchanged (skipped)" 0 (entity-ref e2 #:x))
      (test-assert "tween still there" (entity-ref e2 #:tween #f)))))

(test-end "tween")