From afc30a12e25215ff5e9226c3b4f8fd127d9a4d68 Mon Sep 17 00:00:00 2001 From: Gene Pasquet Date: Wed, 8 Apr 2026 07:08:54 +0100 Subject: Move the engine-update to the scene --- demo/platformer.scm | 35 +++++++++++++---------------------- demo/sandbox.scm | 46 +++++++++++----------------------------------- demo/scaling.scm | 3 ++- demo/shmup.scm | 5 +++-- demo/topdown.scm | 17 ++++------------- demo/tweens.scm | 8 +------- 6 files changed, 34 insertions(+), 80 deletions(-) (limited to 'demo') diff --git a/demo/platformer.scm b/demo/platformer.scm index 3bad9bd..1a24a8f 100644 --- a/demo/platformer.scm +++ b/demo/platformer.scm @@ -1,14 +1,11 @@ (import scheme (chicken base) (chicken process-context) - (only srfi-197 chain) (prefix sdl2 "sdl2:") (prefix sdl2-ttf "ttf:") (prefix sdl2-image "img:") downstroke-engine downstroke-world - downstroke-tilemap - downstroke-renderer downstroke-input downstroke-physics downstroke-assets @@ -31,19 +28,14 @@ ((input-held? input 'right) 3) (else 0))) -(define (update-player player input tm) - (let ((jump? (input-pressed? input 'a))) - (when (and jump? (entity-ref player #:on-ground? #f)) - (play-sound 'jump)) - (chain (entity-set player #:vx (player-vx input)) - (apply-jump _ jump?) - (apply-acceleration _) - (apply-gravity _) - (apply-velocity-x _) - (resolve-tile-collisions-x _ tm) - (apply-velocity-y _) - (resolve-tile-collisions-y _ tm) - (detect-on-solid _ tm)))) +(define (update-player player input) + (let* ((jump? (and (input-pressed? input 'a) + (entity-ref player #:on-ground? #f))) + (player (entity-set player #:vx (player-vx input)))) + (when jump? (play-sound 'jump)) + (if jump? + (entity-set player #:ay (- *jump-force*)) + player))) (define *game* (make-game @@ -55,16 +47,15 @@ (load-sounds! '((jump . "demo/assets/jump.wav")))) create: (lambda (game) - (game-scene-set! game - (chain (game-load-scene! game "demo/assets/level-0.tmx") - (scene-add-entity _ (make-player)) - (update-scene _ camera-target: 'player)))) + (let* ((s0 (game-load-scene! game "demo/assets/level-0.tmx")) + (s1 (scene-add-entity s0 (make-player))) + (s2 (update-scene s1 camera-target: 'player))) + (game-scene-set! game s2))) update: (lambda (game dt) (let* ((input (game-input game)) (scene (game-scene game)) - (tm (scene-tilemap scene)) - (player (update-player (car (scene-entities scene)) input tm))) + (player (update-player (car (scene-entities scene)) input))) (game-scene-set! game (update-scene scene entities: (list player))))))) diff --git a/demo/sandbox.scm b/demo/sandbox.scm index a34ebd9..09c31fb 100644 --- a/demo/sandbox.scm +++ b/demo/sandbox.scm @@ -2,7 +2,6 @@ (chicken base) (chicken random) (only srfi-1 iota take) - (only srfi-197 chain) (prefix sdl2 "sdl2:") (prefix sdl2-ttf "ttf:") (prefix sdl2-image "img:") @@ -73,39 +72,18 @@ #:tile-id 1 #:demo-id id #:demo-since-jump 0)) -;; ── Per-entity physics ────────────────────────────────────────────────────── +;; ── Per-entity intent ─────────────────────────────────────────────────────── -(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) +(define (update-demo-bot e dt) (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)))) + (since (if jump? 0 since)) + (ay (if jump? (- *jump-force*) 0))) + (entity-set (entity-set (entity-set e #:vx vx) #:demo-since-jump since) #:ay ay))) ;; ── Scene builder ─────────────────────────────────────────────────────────── @@ -159,14 +137,12 @@ update: (lambda (game dt) (set! *demo-t* (+ *demo-t* dt)) - (let ((tm (scene-tilemap (game-scene game)))) + (let ((scene (game-scene game))) (game-scene-set! game - (chain (game-scene game) - (scene-map-entities _ (cut step-tweens <> dt)) - (scene-map-entities _ (cut integrate-entity <> dt tm)) - (scene-transform-entities _ sync-groups) - (scene-transform-entities _ resolve-entity-collisions) - (scene-map-entities _ - (lambda (e) (detect-on-solid e tm (scene-entities _)))))))))) + (scene-map-entities scene + (lambda (e) + (if (eq? (entity-type e) 'demo-bot) + (update-demo-bot e dt) + e)))))))) (game-run! *game*) diff --git a/demo/scaling.scm b/demo/scaling.scm index f8bfdfb..982817a 100644 --- a/demo/scaling.scm +++ b/demo/scaling.scm @@ -36,7 +36,8 @@ camera: (make-camera x: 0 y: 0) tileset-texture: #f camera-target: #f - background: '(30 30 50)))) + background: '(30 30 50) + engine-update: 'none))) update: (lambda (game dt) (let* ((input (game-input game)) diff --git a/demo/shmup.scm b/demo/shmup.scm index fdffd71..f4897ae 100644 --- a/demo/shmup.scm +++ b/demo/shmup.scm @@ -79,7 +79,7 @@ (define (update-player player input) (let ((updated (chain player (entity-set _ #:vx (player-vx input)) - (apply-velocity-x _) + (apply-velocity-x _ #f 0) (clamp-player-x _)))) (when (input-pressed? input 'a) (play-sound 'shoot)) @@ -133,7 +133,8 @@ tilemap: #f camera: (make-camera x: 0 y: 0) tileset-texture: #f - camera-target: #f))) + camera-target: #f + engine-update: 'none))) update: (lambda (game dt) (set! *frame-count* (+ *frame-count* 1)) diff --git a/demo/topdown.scm b/demo/topdown.scm index 1bf6536..7fa9b7e 100644 --- a/demo/topdown.scm +++ b/demo/topdown.scm @@ -1,15 +1,13 @@ (import scheme (chicken base) + srfi-8 (only srfi-197 chain) (prefix sdl2 "sdl2:") (prefix sdl2-ttf "ttf:") (prefix sdl2-image "img:") downstroke-engine downstroke-world - downstroke-tilemap - downstroke-renderer downstroke-input - downstroke-physics downstroke-assets downstroke-entity downstroke-scene-loader) @@ -28,15 +26,9 @@ (+ (if (input-held? input 'up) -3 0) (if (input-held? input 'down) 3 0)))) -(define (update-player player input tm) +(define (update-player player input) (receive (dx dy) (input->velocity input) - (chain player - (entity-set _ #:vx dx) - (entity-set _ #:vy dy) - (apply-velocity-x _) - (resolve-tile-collisions-x _ tm) - (apply-velocity-y _) - (resolve-tile-collisions-y _ tm)))) + (entity-set (entity-set player #:vx dx) #:vy dy))) (define *game* (make-game @@ -51,8 +43,7 @@ update: (lambda (game dt) (let* ((input (game-input game)) (scene (game-scene game)) - (player (update-player (car (scene-entities scene)) - input (scene-tilemap scene)))) + (player (update-player (car (scene-entities scene)) input))) (game-scene-set! game (update-scene scene entities: (list player))))))) diff --git a/demo/tweens.scm b/demo/tweens.scm index b2a22cc..609c541 100644 --- a/demo/tweens.scm +++ b/demo/tweens.scm @@ -6,8 +6,7 @@ downstroke-engine downstroke-world downstroke-renderer - downstroke-entity - downstroke-tween) + downstroke-entity) ;; ── Constants ──────────────────────────────────────────────────────────────── @@ -81,11 +80,6 @@ camera-target: #f background: '(26 28 34)))) - update: (lambda (game dt) - (game-scene-set! game - (scene-map-entities (game-scene game) - (cut step-tweens <> dt)))) - render: (lambda (game) (draw-ease-labels! (game-renderer game) (scene-entities (game-scene game)))))) -- cgit v1.2.3