diff options
Diffstat (limited to 'engine.scm')
| -rw-r--r-- | engine.scm | 105 |
1 files changed, 57 insertions, 48 deletions
@@ -6,13 +6,14 @@ (prefix sdl2-ttf "ttf:") (prefix sdl2-image "img:") (srfi 69) - (only srfi-197 chain) + (only srfi-197 chain) defstruct downstroke-world downstroke-input downstroke-physics downstroke-tween downstroke-assets + downstroke-animation downstroke-renderer) ;; ── Game struct ──────────────────────────────────────────────────────────── @@ -52,46 +53,47 @@ (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)))))) + (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) + (scene-map-entities _ (cut apply-animation <> <> dt))))))) (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)) + (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?)) + 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 ────────────────────────────────────────────────── @@ -165,10 +167,10 @@ (if (not target) scene (update-scene scene - camera: (camera-follow (scene-camera scene) - target - (game-width game) - (game-height game)))))))) + 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)) @@ -196,15 +198,15 @@ (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) '())) + (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))) + (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))))) + (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)) @@ -219,9 +221,16 @@ (let ((scene (game-scene game))) (when scene (let ((eu (scene-engine-update scene))) + ;; engine-update dispatch: + ;; #f → run default-engine-update (implicit opt-in) + ;; 'none → run no engine update at all (explicit opt-out) + ;; <proc> → run the user procedure (cond - ((procedure? eu) (eu game dt)) - ((not eu) (default-engine-update game dt)))))) + ((eq? eu 'none)) + ((procedure? eu) (eu game dt)) + ((not eu) (default-engine-update game dt)) + (else + (error "engine-update must be #f, 'none, or a procedure" eu)))))) (receive (update-fn render-fn) (resolve-hooks game) (when update-fn (update-fn game dt)) (when (game-scene game) |