(import scheme
        (chicken base)
        (only srfi-1 iota map)
        (prefix sdl2 "sdl2:")
        (prefix sdl2-ttf "ttf:")
        downstroke-engine
        downstroke-world
        downstroke-renderer
        downstroke-physics
        downstroke-entity
        downstroke-tween)

;; One row per easing symbol: #(entity tween left-x right-x ease-sym to-right?)
(define *ease-cells* #f)

(define *knock-ent* #f)
(define *knock-tw* #f)
(define *knock-cd* 0)

(define +knock-skip+
  '(jump acceleration gravity velocity-x velocity-y))

(define *ease-syms*
  '(linear quad-in quad-out quad-in-out cubic-in cubic-out cubic-in-out
    sine-in-out expo-in expo-out expo-in-out back-out))

;; Distinct RGB triples for each easing row (no tileset).
(define *ease-colors*
  '((220 90 90)
    (240 140 60)
    (240 200 60)
    (180 220 70)
    (80 200 120)
    (70 180 200)
    (100 140 240)
    (160 100 220)
    (220 80 180)
    (100 100 110)
    (140 180 200)
    (200 120 80)))

(define *label-font* #f)
(define *title-font* #f)

(define (clamp-entity-to-screen e gw gh)
  "Clamp position and zero velocity on edges; set #:on-ground? on bottom when using gravity."
  (let* ((w  (entity-ref e #:width 0))
         (h  (entity-ref e #:height 0))
         (x  (entity-ref e #:x 0))
         (y  (entity-ref e #:y 0))
         (vx (entity-ref e #:vx 0))
         (vy (entity-ref e #:vy 0))
         (nx (max 0 (min (- gw w) x)))
         (ny (max 0 (min (- gh h) y)))
         (ground? (and (entity-ref e #:gravity? #f) (= ny (- gh h))))
         (e (entity-set e #:x nx))
         (e (entity-set e #:y ny))
         (e (entity-set e #:vx (if (= nx x) vx 0)))
         (e (entity-set e #:vy (if (= ny y) vy 0)))
         (e (entity-set e #:on-ground? ground?)))
    e))

(define (make-ease-cell ease-sym y rgb)
  (let* ((left 20)
         (right (+ left 120))
         (ent (list #:type 'tween-demo #:x left #:y y #:width 14 #:height 14
                    #:vx 0 #:vy 0 #:gravity? #f #:solid? #f #:color rgb))
         (tw (make-tween ent props: `((#:x . ,right)) duration: 2600 ease: ease-sym)))
    (vector ent tw left right ease-sym #t)))

(define (advance-ease-cell! cell dt)
  (let ((ent (vector-ref cell 0))
        (tw (vector-ref cell 1))
        (left (vector-ref cell 2))
        (right (vector-ref cell 3))
        (ease (vector-ref cell 4))
        (to-right? (vector-ref cell 5)))
    (receive (tw2 ent2) (tween-step tw ent dt)
      (vector-set! cell 0 ent2)
      (cond ((tween-finished? tw2)
             (let* ((next-to-right? (not to-right?))
                    (target-x (if next-to-right? right left))
                    (tw3 (make-tween ent2 props: `((#:x . ,target-x))
                                     duration: 2600 ease: ease)))
               (vector-set! cell 1 tw3)
               (vector-set! cell 5 next-to-right?)))
            (else (vector-set! cell 1 tw2))))))

(define (update-knockback! dt tm gw gh)
  (set! *knock-cd* (+ *knock-cd* dt))
  (when (and *knock-ent* (not *knock-tw*) (>= *knock-cd* 3200))
    (set! *knock-cd* 0)
    (let ((x (entity-ref *knock-ent* #:x 0)))
      (set! *knock-ent* (entity-set *knock-ent* #:skip-pipelines +knock-skip+))
      (set! *knock-tw* (make-tween *knock-ent*
                      props: `((#:x . ,(+ x 88)))
                      duration: 650
                      ease: 'back-out
                      on-complete: (lambda (e)
                                     (set! *knock-ent* (entity-set e #:skip-pipelines '())))))))
  (when *knock-tw*
    (receive (t2 e2) (tween-step *knock-tw* *knock-ent* dt)
      (set! *knock-tw* (if (tween-finished? t2) #f t2))
      (set! *knock-ent* e2)))
  (when *knock-ent*
    (set! *knock-ent*
      (if tm
          (let* ((e *knock-ent*)
                 (e (apply-jump e #f))
                 (e (apply-acceleration e))
                 (e (apply-gravity e))
                 (e (apply-velocity-x e))
                 (e (resolve-tile-collisions-x e tm))
                 (e (apply-velocity-y e))
                 (e (resolve-tile-collisions-y e tm))
                 (e (detect-on-solid e tm)))
            e)
          (let* ((e *knock-ent*)
                 (e (apply-jump e #f))
                 (e (apply-acceleration e))
                 (e (apply-gravity e))
                 (e (apply-velocity-x e))
                 (e (apply-velocity-y e)))
            (clamp-entity-to-screen e gw gh))))))

(define (tweens-demo-render-labels! renderer)
  (let ((white (sdl2:make-color 255 255 255 255)))
    (draw-ui-text renderer *title-font*
      "Tween demo - easing rows + knockback / skip-pipelines" white 12 6)
    (draw-ui-text renderer *label-font*
      "Each box loops on X; bottom crate tweens right with physics skipped, screen bounds only."
      white 12 32)
    (do ((i 0 (+ i 1))) ((>= i (vector-length *ease-cells*)))
      (let* ((cell (vector-ref *ease-cells* i))
             (ent (vector-ref cell 0))
             (lab (symbol->string (vector-ref cell 4))))
        (draw-ui-text renderer *label-font* lab white 158 (- (entity-ref ent #:y 0) 2))))))

(define *game*
  (make-game
    title: "Demo: Tweens" width: 640 height: 480
    preload: (lambda (_game)
      (set! *title-font* (ttf:open-font "demo/assets/DejaVuSans.ttf" 22))
      (set! *label-font* (ttf:open-font "demo/assets/DejaVuSans.ttf" 13)))
    create: (lambda (game)
      (let ((scene (make-scene entities: '()
                               tilemap: #f
                               camera: (make-camera x: 0 y: 0)
                               tileset-texture: #f
                               camera-target: #f
                               background: '(26 28 34))))
        (set! *ease-cells*
          (list->vector
            (map (lambda (ease i)
                   (make-ease-cell ease (+ 52 (* i 20))
                     (list-ref *ease-colors* i)))
                 *ease-syms*
                 (iota (length *ease-syms*)))))
        (set! *knock-ent*
          (list #:type 'knock-crate #:x 200 #:y 80 #:width 18 #:height 18
                #:vx 0 #:vy 0 #:gravity? #t #:on-ground? #f #:solid? #f
                #:color '(140 110 70)))
        (set! *knock-tw* #f)
        (set! *knock-cd* 2500)
        (scene-entities-set! scene
          (append (map (lambda (i) (vector-ref (vector-ref *ease-cells* i) 0))
                       (iota (vector-length *ease-cells*)))
                  (list *knock-ent*)))
        (game-scene-set! game scene)))
    update: (lambda (game dt)
      (let* ((scene (game-scene game))
             (tm (scene-tilemap scene))
             (gw (game-width game))
             (gh (game-height game)))
        (do ((i 0 (+ i 1))) ((>= i (vector-length *ease-cells*)))
          (advance-ease-cell! (vector-ref *ease-cells* i) dt))
        (update-knockback! dt tm gw gh)
        (scene-entities-set! scene
          (append (map (lambda (i) (vector-ref (vector-ref *ease-cells* i) 0))
                       (iota (vector-length *ease-cells*)))
                  (list *knock-ent*)))))
    render: (lambda (game)
      (tweens-demo-render-labels! (game-renderer game)))))

(game-run! *game*)