(import scheme
        (chicken base)
        (chicken random)
        (only srfi-1 drop iota take)
        (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)

(define *demo-t* 0.0)

;; Programmatic level: same geometry as the old static-tile floor + mid shelf,
;; but as a real tile layer so tile collisions and detect-on-solid work.
(define (make-sandbox-tilemap ts tw th gw gh)
  (let* ((ncols (inexact->exact (ceiling (/ gw tw))))
         (nrows (inexact->exact (ceiling (/ gh th))))
         (floor-tile 20)
         (shelf-tile 20)
         (air (map (lambda (_) (map (lambda (_) 0) (iota ncols))) (iota nrows)))
         (floor-row (map (lambda (_) floor-tile) (iota ncols)))
         (with-floor (append (take air (- nrows 1)) (list floor-row)))
         ;; Shelf top at same Y as before: gh - 6*th pixels from top
         (shelf-r (inexact->exact (floor (/ (- gh (* 6 th)) th))))
         (shelf-c0 10)
         (shelf-n 10)
         (row-before (list-ref with-floor shelf-r))
         (shelf-row
           (map (lambda (c)
                  (if (and (>= c shelf-c0) (< c (+ shelf-c0 shelf-n)))
                      shelf-tile
                      (list-ref row-before c)))
                (iota ncols)))
         (map-data (append (take with-floor shelf-r)
                           (list shelf-row)
                           (drop with-floor (+ shelf-r 1))))
         (layer (make-layer name: "ground"
                            width: ncols height: nrows
                            map: map-data)))
    (make-tilemap width: ncols height: nrows
                  tilewidth: tw tileheight: th
                  tileset-source: ""
                  tileset: ts
                  layers: (list layer)
                  objects: '())))

(define (spawn-boxes tw th)
  (map (lambda (i)
         (list #:type 'box
               #:x (+ 30 (* i 55)) #:y (+ 10 (* (pseudo-random-integer 4) 20))
               #:width tw #:height th
               #:vx 0 #:vy 0
               #:gravity? #t #:on-ground? #f
               #:solid? #t #:immovable? #f
               #:tile-id 29))
       (iota 8)))

;; #:demo-id offsets phase; #:demo-since-jump accumulates ms for jump cadence.
(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))

(define (update-demo-bot e dt tm)
  (let* ((id (entity-ref e #:demo-id 0))
         (cycle 2600.0)
         (phase (modulo (+ *demo-t* (* id 400.0)) cycle))
         (vx (if (< phase (/ cycle 2.0)) 3.0 -3.0))
         (e (entity-set e #:vx vx))
         ;; Set last frame by final pass: detect-on-solid after entity–entity resolve.
         (ground? (entity-ref e #:on-ground? #f))
         (since (+ (entity-ref e #:demo-since-jump 0) dt))
         (jump-every 720.0)
         (do-jump? (and ground? (>= since jump-every)))
         (since (if do-jump? 0 since))
         (e (entity-set e #:demo-since-jump since))
         (e (apply-jump e do-jump?))
         (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))

(define (update-box e tm)
  (let* ((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))

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

    create: (lambda (game)
      (let* ((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))
             (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)))
             (entities (append (spawn-boxes tw th) bots))
             (scene (make-scene
                      entities:        entities
                      tilemap:         tm
                      tileset:         #f
                      camera:          (make-camera x: 0 y: 0)
                      tileset-texture: tex
                      camera-target:   #f
                      background:      '(32 34 40))))
        (game-scene-set! game scene)))

    update: (lambda (game dt)
      (set! *demo-t* (+ *demo-t* dt))
      (let* ((scene (game-scene game))
             (tm    (scene-tilemap scene)))
        (scene-update-entities scene
          (lambda (e)
            (cond
              ((eq? (entity-type e) 'demo-bot)
               (update-demo-bot e dt tm))
              ((eq? (entity-type e) 'box)
               (update-box e tm))
              (else e))))
        (scene-resolve-collisions scene)
        (let ((post (scene-entities scene)))
          (scene-update-entities scene
            (lambda (e)
              (if (entity-ref e #:gravity? #f)
                  (detect-on-solid e tm post)
                  e))))))))

(game-run! *game*)