path: root/engine.scm

(module downstroke-engine *

(import scheme
        (chicken base)
        (chicken keyword)
        (prefix sdl2 "sdl2:")
        (prefix sdl2-ttf "ttf:")
        (prefix sdl2-image "img:")
        (srfi 69)
        defstruct
        downstroke-world
        downstroke-input
        downstroke-physics
        downstroke-tween
        downstroke-assets
        downstroke-renderer)

;; ── Game struct ────────────────────────────────────────────────────────────
;; defstruct auto-generates make-game, which we'll wrap with default values

(defstruct game
  title width height
  scale          ;; positive integer: whole-game pixel scaling factor
  window renderer
  input          ;; input-state record
  input-config   ;; input-config record
  assets         ;; asset registry (hash-table from assets.scm)
  frame-delay
  preload-hook   ;; (lambda (game) ...)
  create-hook    ;; (lambda (game) ...)
  update-hook    ;; (lambda (game dt) ...)
  render-hook    ;; (lambda (game) ...) — post-render overlay
  scene          ;; current scene struct; #f until create: runs
  states         ;; hash-table of name → state-plist
  active-state   ;; symbol or #f — currently active state name
  debug?)        ;; boolean: enable debug overlay drawing

;; Store the auto-generated constructor as make-game*
(define make-game* make-game)

;; ── Public constructor wrapper ─────────────────────────────────────────────
;; Wraps the auto-generated make-game (renamed to make-game*) with default values

;; ── Default engine update ────────────────────────────────────────────────
;; Standard physics pipeline: tweens → acceleration → gravity → velocity →
;; tile collisions → ground detection → entity collisions → group sync.
;; Runs automatically each frame unless overridden or disabled.

(define (default-engine-update game dt)
  (let ((scene (game-scene game)))
    (when scene
      (let* ((scene (scene-map-entities scene (cut step-tweens <> scene dt)))
             (scene (scene-map-entities scene (cut apply-acceleration <> scene dt)))
             (scene (scene-map-entities scene (cut apply-gravity <> scene dt)))
             (scene (scene-map-entities scene (cut apply-velocity-x <> scene dt)))
             (scene (scene-map-entities scene (cut resolve-tile-collisions-x <> scene dt)))
             (scene (scene-map-entities scene (cut apply-velocity-y <> scene dt)))
             (scene (scene-map-entities scene (cut resolve-tile-collisions-y <> scene dt)))
             (scene (scene-map-entities scene (cut detect-on-solid <> scene dt)))
             (scene (scene-transform-entities scene resolve-entity-collisions))
             (scene (scene-transform-entities scene sync-groups)))
        (game-scene-set! game scene)))))

(define (make-game #!key
    (title "Downstroke Game")
    (width 640) (height 480)
    (scale 1)
    (frame-delay 16)
    (input-config *default-input-config*)
    (preload #f) (create #f) (update #f) (render #f)
    (debug? #f))
  (unless (and (integer? scale) (positive? scale))
    (error "make-game: scale must be a positive integer" scale))
  (make-game*
    title:        title
    width:        width
    height:       height
    scale:        scale
    window:       #f
    renderer:     #f
    scene:        #f
    input:        (create-input-state input-config)
    input-config: input-config
    assets:       (make-asset-registry)
    frame-delay:  frame-delay
    preload-hook: preload
    create-hook:  create
    update-hook:  update
    render-hook:  render
    states:       (make-hash-table)
    active-state: #f
    debug?:       debug?))

;; ── Convenience accessors ──────────────────────────────────────────────────

;; game-camera: derived from the current scene (only valid after create: runs)
(define (game-camera game)
  (scene-camera (game-scene game)))

;; game-asset: retrieve an asset by key
(define (game-asset game key)
  (asset-ref (game-assets game) key))

;; game-asset-set!: store an asset by key
(define (game-asset-set! game key value)
  (asset-set! (game-assets game) key value))

;; ── Named scene states ────────────────────────────────────────────────────

;; Construct a state plist with lifecycle hooks.
(define (make-game-state #!key (create #f) (update #f) (render #f))
  (list #:create create #:update update #:render render))

;; Retrieve a value from a state plist.
(define (state-hook state key)
  (get-keyword key state (lambda () #f)))

;; Register a named state. name is a symbol; state is a make-game-state plist.
(define (game-add-state! game name state)
  (hash-table-set! (game-states game) name state))

;; Transition to a named state. Calls the state's create: hook if present.
(define (game-start-state! game name)
  (game-active-state-set! game name)
  (let* ((state  (hash-table-ref (game-states game) name))
         (create (state-hook state #:create)))
    (when create (create game))))

;; Set renderer draw color for SDL_RenderClear (called every frame before clear).
(define (renderer-set-clear-color! renderer scene)
  (let ((bg (and scene (scene-background scene))))
    (if (and (list? bg) (>= (length bg) 3))
        (let ((r (list-ref bg 0))
              (g (list-ref bg 1))
              (b (list-ref bg 2))
              (a (if (>= (length bg) 4) (list-ref bg 3) 255)))
          (set! (sdl2:render-draw-color renderer) (sdl2:make-color r g b a)))
        (set! (sdl2:render-draw-color renderer) (sdl2:make-color 0 0 0 255)))))

;; ── game-run! helpers ─────────────────────────────────────────────────────

(define (collect-sdl-events)
  (sdl2:pump-events!)
  (let collect ((lst '()))
    (if (not (sdl2:has-events?))
        (reverse lst)
        (let ((e (sdl2:make-event)))
          (sdl2:poll-event! e)
          (collect (cons e lst))))))

(define (resolve-hooks game)
  (let* ((active (game-active-state game))
         (state  (and active
                      (hash-table-ref/default (game-states game) active #f))))
    (values (or (and state (state-hook state #:update)) (game-update-hook game))
            (or (and state (state-hook state #:render)) (game-render-hook game)))))

(define (update-camera-follow scene game)
  (let ((target-tag (and scene (scene-camera-target scene))))
    (if (not target-tag)
        scene
        (let ((target (scene-find-tagged scene target-tag)))
          (if (not target)
              scene
              (update-scene scene
                camera: (camera-follow (scene-camera scene)
                                       target
                                       (game-width game)
                                       (game-height game))))))))

(define (game-render! game render-fn)
  (renderer-set-clear-color! (game-renderer game) (game-scene game))
  (sdl2:render-clear! (game-renderer game))
  (when (game-scene game)
    (render-scene! (game-renderer game) (game-scene game)))
  (when (and (game-debug? game) (game-scene game))
    (render-debug-scene! (game-renderer game) (game-scene game)))
  (when render-fn (render-fn game))
  (sdl2:render-present! (game-renderer game)))

;; ── game-run! ──────────────────────────────────────────────────────────────

(define (game-run! game)
  (sdl2:set-main-ready!)
  (sdl2:init! '(video joystick game-controller))
  (ttf:init!)
  (img:init! '(png))

  (let init-controllers ((i 0))
    (when (< i (sdl2:num-joysticks))
      (when (sdl2:is-game-controller? i)
        (sdl2:game-controller-open! i))
      (init-controllers (+ i 1))))

  (let ((scale (game-scale game)))
    (game-window-set! game
      (sdl2:create-window! (game-title game) 'centered 'centered
                           (* (game-width game) scale)
                           (* (game-height game) scale) '()))
    (game-renderer-set! game
      (sdl2:create-renderer! (game-window game) -1 '(accelerated)))
    (when (> scale 1)
      (sdl2:render-logical-size-set!
        (game-renderer game)
        (list (game-width game) (game-height game)))))

  (when (game-preload-hook game) ((game-preload-hook game) game))
  (when (game-create-hook game) ((game-create-hook game) game))

  (let loop ((last-ticks (sdl2:get-ticks)))
    (let* ((now   (sdl2:get-ticks))
           (dt    (- now last-ticks))
           (input (input-state-update (game-input game) (collect-sdl-events)
                                      (game-input-config game))))
      (game-input-set! game input)
      (unless (input-held? input 'quit)
        (let ((scene (game-scene game)))
          (when scene
            (let ((eu (scene-engine-update scene)))
              (cond
                ((procedure? eu) (eu game dt))
                ((not eu) (default-engine-update game dt))))))
        (receive (update-fn render-fn) (resolve-hooks game)
          (when update-fn (update-fn game dt))
          (when (game-scene game)
            (game-scene-set! game (update-camera-follow (game-scene game) game)))
          (game-render! game render-fn))
        (sdl2:delay! (game-frame-delay game))
        (loop now))))

  (sdl2:destroy-window! (game-window game))
  (sdl2:quit!))

) ;; end module