(import scheme
        (chicken base)
        (chicken random)
        (only srfi-1 iota take)
        (only srfi-197 chain)
        (prefix sdl2 "sdl2:")
        (prefix sdl2-ttf "ttf:")
        (prefix sdl2-image "img:")
        downstroke-engine
        downstroke-world
        downstroke-tilemap
        downstroke-physics
        downstroke-assets
        downstroke-entity
        downstroke-scene-loader
        downstroke-tween
        downstroke-prefabs)

;; ── Constants ────────────────────────────────────────────────────────────────

(define +game-width+  600)
(define +game-height+ 400)

(define +demo-bot-cycle-ms+          2600.0)
(define +demo-bot-half-cycle-ms+     (/ +demo-bot-cycle-ms+ 2.0))
(define +demo-bot-jump-interval-ms+  720.0)

;; ── Mutable demo state ──────────────────────────────────────────────────────

(define *demo-t*        0.0)
(define *shelf-endpoints* #f)
(define *shelf-tween*     #f)
(define *shelf-origin*    #f)

;; ── Tween helpers ────────────────────────────────────────────────────────────

(define (other-endpoint x endpoints)
  (let ((lo (car endpoints))
        (hi (cdr endpoints)))
    (if (< (abs (- x lo)) (abs (- x hi))) hi lo)))

(define (make-ping-pong-tween leader endpoints)
  (make-tween leader
    props: `((#:x . ,(other-endpoint (entity-ref leader #:x 0) endpoints)))
    duration: 3500 ease: 'sine-in-out))

(define (scene-replace-group-origin! scene gid new-origin)
  (scene-entities-set! scene
    (map (lambda (e)
           (if (and (entity-ref e #:group-origin? #f)
                    (eq? (entity-ref e #:group-id) gid))
               new-origin
               e))
         (scene-entities scene))))

(define (advance-shelf-tween! scene dt)
  (when (and *shelf-tween* *shelf-origin*)
    (let ((gid (entity-ref *shelf-origin* #:group-id)))
      (receive (tw2 e0) (tween-step *shelf-tween* *shelf-origin* dt)
        (set! *shelf-tween* (if (tween-finished? tw2)
                                (make-ping-pong-tween e0 *shelf-endpoints*)
                                tw2))
        (set! *shelf-origin* e0)
        (scene-replace-group-origin! scene gid e0)))))

;; ── Tilemap builder ──────────────────────────────────────────────────────────

(define (make-sandbox-tilemap ts tw th gw gh)
  (let* ((ncols     (inexact->exact (ceiling (/ gw tw))))
         (nrows     (inexact->exact (ceiling (/ gh th))))
         (empty-row (map (lambda (_) 0) (iota ncols)))
         (floor-row (map (lambda (_) 20) (iota ncols)))
         (map-data  (append (map (lambda (_) empty-row) (iota (- nrows 1)))
                            (list floor-row))))
    (make-tilemap
      width: ncols height: nrows
      tilewidth: tw tileheight: th
      tileset-source: "" tileset: ts
      layers: (list (make-layer name: "ground"
                                width: ncols height: nrows
                                map: map-data))
      objects: '())))

;; ── Entity factories ─────────────────────────────────────────────────────────

(define (make-box x y tw th)
  (list #:type 'box
        #:x x #:y y #:width tw #:height th
        #:vx 0 #:vy 0
        #:gravity? #t #:on-ground? #f
        #:solid? #t #:immovable? #f
        #:tile-id 29))

(define (spawn-boxes tw th)
  (map (lambda (i)
         (make-box (+ 30 (* i 55))
                   (+ 10 (* (pseudo-random-integer 4) 20))
                   tw th))
       (iota 8)))

(define (make-demo-bot x y tw th id)
  (list #:type 'demo-bot
        #:x x #:y y #:width tw #:height th
        #:vx 0 #:vy 0
        #:gravity? #t #:on-ground? #f
        #:solid? #t #:immovable? #f
        #:tile-id 1
        #:demo-id id #:demo-since-jump 0))

;; ── Per-entity physics ──────────────────────────────────────────────────────

(define (run-physics e tm)
  (chain e
         (apply-gravity _)
         (apply-velocity-x _)
         (resolve-tile-collisions-x _ tm)
         (apply-velocity-y _)
         (resolve-tile-collisions-y _ tm)))

(define (update-demo-bot e dt tm)
  (let* ((id       (entity-ref e #:demo-id 0))
         (phase    (modulo (+ *demo-t* (* id 400.0)) +demo-bot-cycle-ms+))
         (vx       (if (< phase +demo-bot-half-cycle-ms+) 3.0 -3.0))
         (e        (entity-set e #:vx vx))
         (ground?  (entity-ref e #:on-ground? #f))
         (since    (+ (entity-ref e #:demo-since-jump 0) dt))
         (jump?    (and ground? (>= since +demo-bot-jump-interval-ms+)))
         (since    (if jump? 0 since)))
    (chain (entity-set e #:demo-since-jump since)
           (apply-jump _ jump?)
           (apply-acceleration _)
           (run-physics _ tm))))

(define (integrate-entity e dt tm)
  (case (entity-type e)
    ((demo-bot) (update-demo-bot e dt tm))
    ((box)      (run-physics e tm))
    (else
      (if (and (entity-ref e #:group-origin? #f)
               (entity-ref e #:gravity? #f))
          (run-physics e tm)
          e))))

;; ── Scene builder ───────────────────────────────────────────────────────────

(define (init-shelf-tween! shelf-list tw)
  (let* ((origin  (car shelf-list))
         (x-left  (entity-ref origin #:x 0))
         (x-right (+ x-left (* 6 tw))))
    (set! *shelf-origin*    origin)
    (set! *shelf-endpoints* (cons x-left x-right))
    (set! *shelf-tween*     (make-ping-pong-tween origin *shelf-endpoints*))))

(define (make-sandbox-scene game)
  (let* ((reg  (load-prefabs "demo/assets/sandbox-groups.scm" (engine-mixins) '()))
         (ts   (game-load-tileset! game 'tileset "demo/assets/monochrome_transparent.tsx"))
         (tw   (tileset-tilewidth ts))
         (th   (tileset-tileheight ts))
         (tex  (create-texture-from-tileset (game-renderer game) ts))
         (gw   (game-width game))
         (gh   (game-height game))
         (tm   (make-sandbox-tilemap ts tw th gw gh))
         (shelf-list (instantiate-group-prefab reg 'shelf-platform
                       (* 10 tw) (- gh (* 6 th))))
         (raft-list  (instantiate-group-prefab reg 'collision-raft
                       120 (- gh (* 14 th))))
         (bots  (list (make-demo-bot  80 80 tw th 0)
                      (make-demo-bot 220 60 tw th 1)
                      (make-demo-bot 380 100 tw th 2))))
    (init-shelf-tween! shelf-list tw)
    (make-scene
      entities:        (append shelf-list raft-list (spawn-boxes tw th) bots)
      tilemap:         tm
      tileset:         #f
      camera:          (make-camera x: 0 y: 0)
      tileset-texture: tex
      camera-target:   #f
      background:      '(32 34 40))))

;; ── Game ─────────────────────────────────────────────────────────────────────

(define *game*
  (make-game
    title: "Demo: Physics Sandbox"
    width: +game-width+ height: +game-height+

    create: (lambda (game)
      (game-scene-set! game (make-sandbox-scene game)))

    update: (lambda (game dt)
      (set! *demo-t* (+ *demo-t* dt))
      (let* ((scene (game-scene game))
             (tm    (scene-tilemap scene)))
        (advance-shelf-tween! scene dt)
        (scene-update-entities scene (lambda (e) (integrate-entity e dt tm)))
        (scene-sync-groups! scene)
        (scene-resolve-collisions scene)
        (scene-update-entities scene
          (lambda (e)
            (if (entity-ref e #:gravity? #f)
                (detect-on-solid e tm (scene-entities scene))
                e)))))))

(game-run! *game*)