(module downstroke-engine * (import scheme (chicken base) (prefix sdl2 "sdl2:") (prefix sdl2-ttf "ttf:") (prefix sdl2-image "img:") (srfi 69) (only srfi-197 chain) 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 (game-scene-set! game (chain scene (scene-map-entities _ (cut step-tweens <> <> dt)) (scene-map-entities _ (cut apply-acceleration <> <> dt)) (scene-map-entities _ (cut apply-gravity <> <> dt)) (scene-map-entities _ (cut apply-velocity-x <> <> dt)) (scene-map-entities _ (cut resolve-tile-collisions-x <> <> dt)) (scene-map-entities _ (cut apply-velocity-y <> <> dt)) (scene-map-entities _ (cut resolve-tile-collisions-y <> <> dt)) (scene-map-entities _ (cut detect-on-solid <> <> dt)) (scene-transform-entities _ resolve-entity-collisions) (scene-transform-entities _ sync-groups)))))) (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 alist with lifecycle hooks. (define (make-game-state #!key (create #f) (update #f) (render #f)) `((#:create . ,create) (#:update . ,update) (#:render . ,render))) ;; Retrieve a value from a state alist. (define (state-hook state key) (cond ((assq key state) => cdr) (else #f))) ;; Register a named state. name is a symbol; state is a make-game-state alist. (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