diff options
Diffstat (limited to 'demo')
| -rw-r--r-- | demo/platformer.scm | 2 | ||||
| -rw-r--r-- | demo/sandbox.scm | 159 | ||||
| -rw-r--r-- | demo/tweens.scm | 98 |
3 files changed, 199 insertions, 60 deletions
diff --git a/demo/platformer.scm b/demo/platformer.scm index 77fef72..7d289f6 100644 --- a/demo/platformer.scm +++ b/demo/platformer.scm @@ -59,7 +59,7 @@ (player (resolve-tile-collisions-x player tm)) (player (apply-velocity-y player)) (player (resolve-tile-collisions-y player tm)) - (player (detect-ground player tm))) + (player (detect-on-solid player tm))) (scene-entities-set! scene (list player)))))) (game-run! *game*) diff --git a/demo/sandbox.scm b/demo/sandbox.scm index f585a6a..2feb69e 100644 --- a/demo/sandbox.scm +++ b/demo/sandbox.scm @@ -1,60 +1,153 @@ (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-renderer - downstroke-input downstroke-physics downstroke-assets downstroke-entity downstroke-scene-loader) -(define *elapsed* 0) -(define *respawn-interval* 10000) - -(define (spawn-entities) - (let loop ((i 0) (acc '())) - (if (= i 10) - acc - (loop (+ i 1) - (cons (list #:type 'box - #:x (+ 30 (* i 55)) - #:y (+ 10 (* (pseudo-random-integer 4) 20)) - #:width 16 #:height 16 - #:vx 0 #:vy 0 - #:gravity? #t - #:on-ground? #f - #:solid? #t - #:tile-id 1) - acc))))) +(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 ((scene (game-load-scene! game "demo/assets/level-0.tmx"))) - (scene-entities-set! scene (spawn-entities)))) + (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))) - (set! *elapsed* (+ *elapsed* dt)) - (when (>= *elapsed* *respawn-interval*) - (set! *elapsed* 0) - (scene-entities-set! scene (spawn-entities))) (scene-update-entities scene - apply-gravity - apply-velocity-x - (lambda (e) (resolve-tile-collisions-x e tm)) - apply-velocity-y - (lambda (e) (resolve-tile-collisions-y e tm)) - (lambda (e) (detect-ground e tm))) - (scene-resolve-collisions 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*) diff --git a/demo/tweens.scm b/demo/tweens.scm index e9e40f3..ad9c80b 100644 --- a/demo/tweens.scm +++ b/demo/tweens.scm @@ -3,15 +3,12 @@ (only srfi-1 iota map) (prefix sdl2 "sdl2:") (prefix sdl2-ttf "ttf:") - (prefix sdl2-image "img:") downstroke-engine downstroke-world - downstroke-tilemap downstroke-renderer downstroke-physics downstroke-entity - downstroke-tween - downstroke-scene-loader) + downstroke-tween) ;; One row per easing symbol: #(entity tween left-x right-x ease-sym to-right?) (define *ease-cells* #f) @@ -27,16 +24,47 @@ '(linear quad-in quad-out quad-in-out cubic-in cubic-out cubic-in-out sine-in-out expo-in expo-out expo-in-out back-out)) +;; Distinct RGB triples for each easing row (no tileset). +(define *ease-colors* + '((220 90 90) + (240 140 60) + (240 200 60) + (180 220 70) + (80 200 120) + (70 180 200) + (100 140 240) + (160 100 220) + (220 80 180) + (100 100 110) + (140 180 200) + (200 120 80))) + (define *label-font* #f) (define *title-font* #f) -(define +tile-ids+ '#(24 73 122 171 220)) +(define (clamp-entity-to-screen e gw gh) + "Clamp position and zero velocity on edges; set #:on-ground? on bottom when using gravity." + (let* ((w (entity-ref e #:width 0)) + (h (entity-ref e #:height 0)) + (x (entity-ref e #:x 0)) + (y (entity-ref e #:y 0)) + (vx (entity-ref e #:vx 0)) + (vy (entity-ref e #:vy 0)) + (nx (max 0 (min (- gw w) x))) + (ny (max 0 (min (- gh h) y))) + (ground? (and (entity-ref e #:gravity? #f) (= ny (- gh h)))) + (e (entity-set e #:x nx)) + (e (entity-set e #:y ny)) + (e (entity-set e #:vx (if (= nx x) vx 0))) + (e (entity-set e #:vy (if (= ny y) vy 0))) + (e (entity-set e #:on-ground? ground?))) + e)) -(define (make-ease-cell ease-sym y tile-id) +(define (make-ease-cell ease-sym y rgb) (let* ((left 20) (right (+ left 120)) (ent (list #:type 'tween-demo #:x left #:y y #:width 14 #:height 14 - #:vx 0 #:vy 0 #:gravity? #f #:solid? #f #:tile-id tile-id)) + #:vx 0 #:vy 0 #:gravity? #f #:solid? #f #:color rgb)) (tw (make-tween ent props: `((#:x . ,right)) duration: 2600 ease: ease-sym))) (vector ent tw left right ease-sym #t))) @@ -58,7 +86,7 @@ (vector-set! cell 5 next-to-right?))) (else (vector-set! cell 1 tw2)))))) -(define (update-knockback! dt tm) +(define (update-knockback! dt tm gw gh) (set! *knock-cd* (+ *knock-cd* dt)) (when (and *knock-ent* (not *knock-tw*) (>= *knock-cd* 3200)) (set! *knock-cd* 0) @@ -76,23 +104,31 @@ (set! *knock-ent* e2))) (when *knock-ent* (set! *knock-ent* - (let* ((e *knock-ent*) - (e (apply-jump e #f)) - (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 (detect-ground e tm))) - e)))) + (if tm + (let* ((e *knock-ent*) + (e (apply-jump e #f)) + (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 (detect-on-solid e tm))) + e) + (let* ((e *knock-ent*) + (e (apply-jump e #f)) + (e (apply-acceleration e)) + (e (apply-gravity e)) + (e (apply-velocity-x e)) + (e (apply-velocity-y e))) + (clamp-entity-to-screen e gw gh)))))) (define (tweens-demo-render-labels! renderer) (let ((white (sdl2:make-color 255 255 255 255))) (draw-ui-text renderer *title-font* - "Tween demo — easing rows + knockback / skip-pipelines" white 12 6) + "Tween demo - easing rows + knockback / skip-pipelines" white 12 6) (draw-ui-text renderer *label-font* - "Each box loops on X; bottom crate tweens right with physics integration skipped, tiles still collide." + "Each box loops on X; bottom crate tweens right with physics skipped, screen bounds only." white 12 32) (do ((i 0 (+ i 1))) ((>= i (vector-length *ease-cells*))) (let* ((cell (vector-ref *ease-cells* i)) @@ -107,28 +143,38 @@ (set! *title-font* (ttf:open-font "demo/assets/DejaVuSans.ttf" 22)) (set! *label-font* (ttf:open-font "demo/assets/DejaVuSans.ttf" 13))) create: (lambda (game) - (let ((scene (game-load-scene! game "demo/assets/level-0.tmx"))) + (let ((scene (make-scene entities: '() + tilemap: #f + camera: (make-camera x: 0 y: 0) + tileset-texture: #f + camera-target: #f + background: '(26 28 34)))) (set! *ease-cells* (list->vector (map (lambda (ease i) (make-ease-cell ease (+ 52 (* i 20)) - (vector-ref +tile-ids+ (modulo i (vector-length +tile-ids+))))) + (list-ref *ease-colors* i))) *ease-syms* (iota (length *ease-syms*))))) (set! *knock-ent* (list #:type 'knock-crate #:x 200 #:y 80 #:width 18 #:height 18 - #:vx 0 #:vy 0 #:gravity? #t #:on-ground? #f #:solid? #f #:tile-id 220)) + #:vx 0 #:vy 0 #:gravity? #t #:on-ground? #f #:solid? #f + #:color '(140 110 70))) (set! *knock-tw* #f) (set! *knock-cd* 2500) (scene-entities-set! scene (append (map (lambda (i) (vector-ref (vector-ref *ease-cells* i) 0)) (iota (vector-length *ease-cells*))) - (list *knock-ent*))))) + (list *knock-ent*))) + (game-scene-set! game scene))) update: (lambda (game dt) - (let* ((scene (game-scene game)) (tm (scene-tilemap scene))) + (let* ((scene (game-scene game)) + (tm (scene-tilemap scene)) + (gw (game-width game)) + (gh (game-height game))) (do ((i 0 (+ i 1))) ((>= i (vector-length *ease-cells*))) (advance-ease-cell! (vector-ref *ease-cells* i) dt)) - (update-knockback! dt tm) + (update-knockback! dt tm gw gh) (scene-entities-set! scene (append (map (lambda (i) (vector-ref (vector-ref *ease-cells* i) 0)) (iota (vector-length *ease-cells*))) |