diff options
Diffstat (limited to 'demo')
| -rw-r--r-- | demo/assets/sandbox-groups.scm | 30 | ||||
| -rw-r--r-- | demo/audio.scm | 24 | ||||
| -rw-r--r-- | demo/menu.scm | 92 | ||||
| -rw-r--r-- | demo/platformer.scm | 62 | ||||
| -rw-r--r-- | demo/sandbox.scm | 281 | ||||
| -rw-r--r-- | demo/shmup.scm | 186 | ||||
| -rw-r--r-- | demo/spritefont.scm | 43 | ||||
| -rw-r--r-- | demo/topdown.scm | 49 | ||||
| -rw-r--r-- | demo/tweens.scm | 268 |
9 files changed, 577 insertions, 458 deletions
diff --git a/demo/assets/sandbox-groups.scm b/demo/assets/sandbox-groups.scm new file mode 100644 index 0000000..1e9aca9 --- /dev/null +++ b/demo/assets/sandbox-groups.scm @@ -0,0 +1,30 @@ +((mixins) + (prefabs) + (group-prefabs + (shelf-platform + #:pose-only-origin? #t + #:static-parts? #t + #:type-members shelf-segment + #:parts + ((#:local-x 0 #:local-y 0 #:width 16 #:height 16 #:tile-id 20) + (#:local-x 16 #:local-y 0 #:width 16 #:height 16 #:tile-id 20) + (#:local-x 32 #:local-y 0 #:width 16 #:height 16 #:tile-id 20) + (#:local-x 48 #:local-y 0 #:width 16 #:height 16 #:tile-id 20) + (#:local-x 64 #:local-y 0 #:width 16 #:height 16 #:tile-id 20) + (#:local-x 80 #:local-y 0 #:width 16 #:height 16 #:tile-id 20) + (#:local-x 96 #:local-y 0 #:width 16 #:height 16 #:tile-id 20) + (#:local-x 112 #:local-y 0 #:width 16 #:height 16 #:tile-id 20) + (#:local-x 128 #:local-y 0 #:width 16 #:height 16 #:tile-id 20) + (#:local-x 144 #:local-y 0 #:width 16 #:height 16 #:tile-id 20))) + (collision-raft + ;; Match full AABB so tile physics (runs on the origin) lands the raft on the floor, + ;; not a 0×0 point at the top-left (which overlaps the floor row). + #:origin-width 48 + #:origin-height 16 + #:pose-only-origin? #f + #:static-parts? #t + #:type-members raft-segment + #:parts + ((#:local-x 0 #:local-y 0 #:width 16 #:height 16 #:tile-id 21) + (#:local-x 16 #:local-y 0 #:width 16 #:height 16 #:tile-id 21) + (#:local-x 32 #:local-y 0 #:width 16 #:height 16 #:tile-id 21))))) diff --git a/demo/audio.scm b/demo/audio.scm index 2cf5665..62bebf4 100644 --- a/demo/audio.scm +++ b/demo/audio.scm @@ -11,6 +11,8 @@ (define *music-on?* #f) +(define +bg-color+ (sdl2:make-color 30 30 60 255)) + (define *game* (make-game title: "Demo: Audio" width: 600 height: 400 @@ -24,24 +26,26 @@ update: (lambda (game dt) (let ((input (game-input game))) - (when (input-pressed? input 'a) - (play-sound 'jump)) + (when (input-pressed? input 'a) (play-sound 'jump)) (when (input-pressed? input 'b) (if *music-on?* (begin (stop-music!) (set! *music-on?* #f)) (begin (play-music! 0.5) (set! *music-on?* #t)))))) render: (lambda (game) - (let* ((renderer (game-renderer game)) - (font (game-asset game 'font)) - (white (sdl2:make-color 255 255 255 255)) - (gray (sdl2:make-color 180 180 180 255))) - (set! (sdl2:render-draw-color renderer) (sdl2:make-color 30 30 60 255)) + (let ((renderer (game-renderer game)) + (font (game-asset game 'font)) + (white (sdl2:make-color 255 255 255 255)) + (gray (sdl2:make-color 180 180 180 255))) + (set! (sdl2:render-draw-color renderer) +bg-color+) (sdl2:render-fill-rect! renderer (sdl2:make-rect 0 0 600 400)) (draw-ui-text renderer font "Audio Demo" white 220 80) - (draw-ui-text renderer font "J / Z -- play sound effect" gray 160 160) - (draw-ui-text renderer font "K / X -- toggle music on/off" gray 160 200) - (draw-ui-text renderer font "Escape -- quit" gray 160 240) + (for-each + (lambda (entry) + (draw-ui-text renderer font (car entry) gray (cadr entry) (caddr entry))) + '(("J / Z -- play sound effect" 160 160) + ("K / X -- toggle music on/off" 160 200) + ("Escape -- quit" 160 240))) (draw-ui-text renderer font (if *music-on?* "Music: ON" "Music: OFF") (if *music-on?* diff --git a/demo/menu.scm b/demo/menu.scm index 2564bd0..322e046 100644 --- a/demo/menu.scm +++ b/demo/menu.scm @@ -6,11 +6,49 @@ downstroke-renderer downstroke-input) -;; Global state for menu cursor (define *menu-cursor* 0) -(define *menu-items* '("Play" "Quit")) -(define *title-font* #f) -(define *menu-font* #f) +(define *menu-items* '("Play" "Quit")) +(define *title-font* #f) +(define *menu-font* #f) + +(define +bg-color+ (sdl2:make-color 0 0 0 255)) +(define +text-color+ (sdl2:make-color 255 255 255 255)) + +(define (clear-screen! renderer) + (set! (sdl2:render-draw-color renderer) +bg-color+) + (sdl2:render-fill-rect! renderer (sdl2:make-rect 0 0 600 400))) + +;; ── States ─────────────────────────────────────────────────────────────────── + +(define (main-menu-update game _dt) + (let ((input (game-input game))) + (when (input-pressed? input 'up) + (set! *menu-cursor* (max 0 (- *menu-cursor* 1)))) + (when (input-pressed? input 'down) + (set! *menu-cursor* (min (- (length *menu-items*) 1) (+ *menu-cursor* 1)))) + (when (input-pressed? input 'a) + (case *menu-cursor* + ((0) (game-start-state! game 'playing)) + ((1) (sdl2:quit!) (exit)))))) + +(define (main-menu-render game) + (let ((renderer (game-renderer game))) + (clear-screen! renderer) + (draw-ui-text renderer *title-font* "MENU DEMO" +text-color+ 200 80) + (draw-menu-items renderer *menu-font* *menu-items* *menu-cursor* 150 150 50))) + +(define (playing-update game _dt) + (when (input-pressed? (game-input game) 'quit) + (set! *menu-cursor* 0) + (game-start-state! game 'main-menu))) + +(define (playing-render game) + (let ((renderer (game-renderer game))) + (clear-screen! renderer) + (draw-ui-text renderer *menu-font* + "PLAYING! PRESS ESC TO RETURN" +text-color+ 120 150))) + +;; ── Game ───────────────────────────────────────────────────────────────────── (define *game* (make-game @@ -18,53 +56,13 @@ preload: (lambda (game) (set! *title-font* (ttf:open-font "demo/assets/DejaVuSans.ttf" 24)) - (set! *menu-font* (ttf:open-font "demo/assets/DejaVuSans.ttf" 16))) + (set! *menu-font* (ttf:open-font "demo/assets/DejaVuSans.ttf" 16))) create: (lambda (game) - ;; Register the main-menu state (game-add-state! game 'main-menu - (make-game-state - #:update (lambda (game dt) - (let ((input (game-input game))) - ;; Navigate menu with up/down - (when (input-pressed? input 'up) - (set! *menu-cursor* (max 0 (- *menu-cursor* 1)))) - (when (input-pressed? input 'down) - (set! *menu-cursor* (min (- (length *menu-items*) 1) (+ *menu-cursor* 1)))) - ;; Confirm selection - (when (input-pressed? input 'a) - (case *menu-cursor* - ((0) ; Play - (game-start-state! game 'playing)) - ((1) ; Quit - (sdl2:quit!) - (exit)))))) - #:render (lambda (game) - (let ((renderer (game-renderer game))) - (set! (sdl2:render-draw-color renderer) (sdl2:make-color 0 0 0 255)) - (sdl2:render-fill-rect! renderer (sdl2:make-rect 0 0 600 400)) - (let ((white (sdl2:make-color 255 255 255 255))) - (draw-ui-text renderer *title-font* "MENU DEMO" white 200 80) - (draw-menu-items renderer *menu-font* *menu-items* *menu-cursor* - 150 150 50)))))) - - ;; Register the playing state + (make-game-state #:update main-menu-update #:render main-menu-render)) (game-add-state! game 'playing - (make-game-state - #:update (lambda (game dt) - (let ((input (game-input game))) - ;; Return to menu on quit (Escape) - (when (input-pressed? input 'quit) - (set! *menu-cursor* 0) - (game-start-state! game 'main-menu)))) - #:render (lambda (game) - (let ((renderer (game-renderer game))) - (set! (sdl2:render-draw-color renderer) (sdl2:make-color 0 0 0 255)) - (sdl2:render-fill-rect! renderer (sdl2:make-rect 0 0 600 400)) - (let ((white (sdl2:make-color 255 255 255 255))) - (draw-ui-text renderer *menu-font* "PLAYING! PRESS ESC TO RETURN" white 120 150)))))) - - ;; Start with the main menu + (make-game-state #:update playing-update #:render playing-render)) (game-start-state! game 'main-menu)))) (game-run! *game*) diff --git a/demo/platformer.scm b/demo/platformer.scm index 7d289f6..ff5caf7 100644 --- a/demo/platformer.scm +++ b/demo/platformer.scm @@ -1,6 +1,7 @@ (import scheme (chicken base) (chicken process-context) + (only srfi-197 chain) (prefix sdl2 "sdl2:") (prefix sdl2-ttf "ttf:") (prefix sdl2-image "img:") @@ -15,51 +16,54 @@ downstroke-sound downstroke-scene-loader) -(define +debug?+ (member "--debug" (command-line-arguments))) +(define +debug?+ (and (member "--debug" (command-line-arguments)) #t)) + +(define (make-player) + (list #:type 'player + #:x 100 #:y 50 + #:width 16 #:height 16 + #:vx 0 #:vy 0 + #:gravity? #t #:on-ground? #f + #:tile-id 1 #:tags '(player))) + +(define (player-vx input) + (cond ((input-held? input 'left) -3) + ((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 *game* (make-game title: "Demo: Platformer" width: 600 height: 400 - debug?: (and +debug?+ #t) + debug?: +debug?+ preload: (lambda (game) (init-audio!) (load-sounds! '((jump . "demo/assets/jump.wav")))) create: (lambda (game) - (let* ((scene (game-load-scene! game "demo/assets/level-0.tmx")) - (player (list #:type 'player - #:x 100 #:y 50 - #:width 16 #:height 16 - #:vx 0 #:vy 0 - #:gravity? #t - #:on-ground? #f - #:tile-id 1 - #:tags '(player))) - (_ (scene-add-entity scene player))) + (let ((scene (game-load-scene! game "demo/assets/level-0.tmx"))) + (scene-add-entity scene (make-player)) (scene-camera-target-set! scene 'player))) update: (lambda (game dt) (let* ((input (game-input game)) (scene (game-scene game)) (tm (scene-tilemap scene)) - (player (car (scene-entities scene))) - (player (entity-set player #:vx - (cond - ((input-held? input 'left) -3) - ((input-held? input 'right) 3) - (else 0)))) - (_ (when (and (input-pressed? input 'a) - (entity-ref player #:on-ground? #f)) - (play-sound 'jump))) - (player (apply-jump player (input-pressed? input 'a))) - (player (apply-acceleration player)) - (player (apply-gravity player)) - (player (apply-velocity-x player)) - (player (resolve-tile-collisions-x player tm)) - (player (apply-velocity-y player)) - (player (resolve-tile-collisions-y player tm)) - (player (detect-on-solid player tm))) + (player (update-player (car (scene-entities scene)) input tm))) (scene-entities-set! scene (list player)))))) (game-run! *game*) diff --git a/demo/sandbox.scm b/demo/sandbox.scm index ad2e056..d7bd53f 100644 --- a/demo/sandbox.scm +++ b/demo/sandbox.scm @@ -1,7 +1,8 @@ (import scheme (chicken base) (chicken random) - (only srfi-1 drop iota take) + (only srfi-1 iota take) + (only srfi-197 chain) (prefix sdl2 "sdl2:") (prefix sdl2-ttf "ttf:") (prefix sdl2-image "img:") @@ -11,147 +12,193 @@ downstroke-physics downstroke-assets downstroke-entity - downstroke-scene-loader) - -(define *demo-t* 0.0) - -(define +static-skip+ - '(jump acceleration gravity velocity-x velocity-y - tile-collisions-x tile-collisions-y on-solid)) - -;; Mid-level shelf only: immovable solid AABBs (same layout as the old tilemap shelf). -(define (make-shelf-platform gw gh tw th) - (let* ((shelf-tile-id 20) - (shelf-c0 10) - (shelf-n 10) - (x0 (* shelf-c0 tw)) - (y (- gh (* 6 th)))) - (map (lambda (i) - (list #:type 'static-tile - #:x (+ x0 (* i tw)) #:y y #:width tw #:height th - #:tile-id shelf-tile-id #:solid? #t #:immovable? #t - #:gravity? #f #:vx 0 #:vy 0 #:on-ground? #f - #:skip-pipelines +static-skip+)) - (iota shelf-n)))) - -;; Floor only on the tilemap; shelf is entities (see make-shelf-platform). + downstroke-scene-loader + downstroke-tween + downstroke-prefabs) + +;; ── Constants ──────────────────────────────────────────────────────────────── + +(define +game-width+ 600) +(define +game-height+ 400) + +(define +demo-bot-cycle-ms+ 2600.0) +(define +demo-bot-half-cycle-ms+ (/ +demo-bot-cycle-ms+ 2.0)) +(define +demo-bot-jump-interval-ms+ 720.0) + +;; ── Mutable demo state ────────────────────────────────────────────────────── + +(define *demo-t* 0.0) +(define *shelf-endpoints* #f) +(define *shelf-tween* #f) +(define *shelf-origin* #f) + +;; ── Tween helpers ──────────────────────────────────────────────────────────── + +(define (other-endpoint x endpoints) + (let ((lo (car endpoints)) + (hi (cdr endpoints))) + (if (< (abs (- x lo)) (abs (- x hi))) hi lo))) + +(define (make-ping-pong-tween leader endpoints) + (make-tween leader + props: `((#:x . ,(other-endpoint (entity-ref leader #:x 0) endpoints))) + duration: 3500 ease: 'sine-in-out)) + +(define (scene-replace-group-origin! scene gid new-origin) + (scene-entities-set! scene + (map (lambda (e) + (if (and (entity-ref e #:group-origin? #f) + (eq? (entity-ref e #:group-id) gid)) + new-origin + e)) + (scene-entities scene)))) + +(define (advance-shelf-tween! scene dt) + (when (and *shelf-tween* *shelf-origin*) + (let ((gid (entity-ref *shelf-origin* #:group-id))) + (receive (tw2 e0) (tween-step *shelf-tween* *shelf-origin* dt) + (set! *shelf-tween* (if (tween-finished? tw2) + (make-ping-pong-tween e0 *shelf-endpoints*) + tw2)) + (set! *shelf-origin* e0) + (scene-replace-group-origin! scene gid e0))))) + +;; ── Tilemap builder ────────────────────────────────────────────────────────── + (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) - (air (map (lambda (_) (map (lambda (_) 0) (iota ncols))) (iota nrows))) - (floor-row (map (lambda (_) floor-tile) (iota ncols))) - (map-data (append (take air (- nrows 1)) (list floor-row))) - (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: '()))) + (let* ((ncols (inexact->exact (ceiling (/ gw tw)))) + (nrows (inexact->exact (ceiling (/ gh th)))) + (empty-row (map (lambda (_) 0) (iota ncols))) + (floor-row (map (lambda (_) 20) (iota ncols))) + (map-data (append (map (lambda (_) empty-row) (iota (- nrows 1))) + (list floor-row)))) + (make-tilemap + width: ncols height: nrows + tilewidth: tw tileheight: th + tileset-source: "" tileset: ts + layers: (list (make-layer name: "ground" + width: ncols height: nrows + map: map-data)) + objects: '()))) + +;; ── Entity factories ───────────────────────────────────────────────────────── + +(define (make-box x y tw th) + (list #:type 'box + #:x x #:y y #:width tw #:height th + #:vx 0 #:vy 0 + #:gravity? #t #:on-ground? #f + #:solid? #t #:immovable? #f + #:tile-id 29)) (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)) + (make-box (+ 30 (* i 55)) + (+ 10 (* (pseudo-random-integer 4) 20)) + tw th)) (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 + #: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)) + #:demo-id id #:demo-since-jump 0)) + +;; ── Per-entity physics ────────────────────────────────────────────────────── + +(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) - (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)) + (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)))) + +;; ── Scene builder ─────────────────────────────────────────────────────────── + +(define (init-shelf-tween! shelf-list tw) + (let* ((origin (car shelf-list)) + (x-left (entity-ref origin #:x 0)) + (x-right (+ x-left (* 6 tw)))) + (set! *shelf-origin* origin) + (set! *shelf-endpoints* (cons x-left x-right)) + (set! *shelf-tween* (make-ping-pong-tween origin *shelf-endpoints*)))) + +(define (make-sandbox-scene game) + (let* ((reg (load-prefabs "demo/assets/sandbox-groups.scm" (engine-mixins) '())) + (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)) + (shelf-list (instantiate-group-prefab reg 'shelf-platform + (* 10 tw) (- gh (* 6 th)))) + (raft-list (instantiate-group-prefab reg 'collision-raft + 120 (- gh (* 14 th)))) + (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)))) + (init-shelf-tween! shelf-list tw) + (make-scene + entities: (append shelf-list raft-list (spawn-boxes tw th) bots) + tilemap: tm + tileset: #f + camera: (make-camera x: 0 y: 0) + tileset-texture: tex + camera-target: #f + background: '(32 34 40)))) + +;; ── Game ───────────────────────────────────────────────────────────────────── (define *game* (make-game - title: "Demo: Physics Sandbox" width: 600 height: 400 + title: "Demo: Physics Sandbox" + width: +game-width+ height: +game-height+ create: (lambda (game) - (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)) - (shelf (make-shelf-platform gw gh tw th)) - (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 shelf (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))) + (game-scene-set! game (make-sandbox-scene game))) update: (lambda (game dt) (set! *demo-t* (+ *demo-t* dt)) (let* ((scene (game-scene game)) (tm (scene-tilemap scene))) + (advance-shelf-tween! scene dt) + (scene-update-entities scene (lambda (e) (integrate-entity e dt tm))) + (scene-sync-groups! scene) + (scene-resolve-collisions scene) (scene-update-entities 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)))))))) + (if (entity-ref e #:gravity? #f) + (detect-on-solid e tm (scene-entities scene)) + e))))))) (game-run! *game*) diff --git a/demo/shmup.scm b/demo/shmup.scm index 8610d4d..e9fec5e 100644 --- a/demo/shmup.scm +++ b/demo/shmup.scm @@ -1,7 +1,8 @@ (import scheme (chicken base) (chicken random) - (only srfi-1 filter) + (only srfi-1 filter any) + (only srfi-197 chain) (prefix sdl2 "sdl2:") (prefix sdl2-ttf "ttf:") (prefix sdl2-image "img:") @@ -13,16 +14,31 @@ downstroke-assets downstroke-sound) -(define *frame-count* 0) +;; ── Constants ──────────────────────────────────────────────────────────────── + +(define +screen-width+ 600) +(define +screen-height+ 400) +(define +spawn-interval+ 60) -(define (make-bullet px py) - (list #:type 'bullet #:x px #:y py #:width 4 #:height 8 #:vx 0 #:vy -6)) +;; ── State ──────────────────────────────────────────────────────────────────── -(define (make-enemy rx) - (list #:type 'enemy #:x rx #:y 0 #:width 16 #:height 16 #:vx 0 #:vy 2)) +(define *frame-count* 0) + +;; ── Entity factories ───────────────────────────────────────────────────────── (define (make-player) - (list #:type 'player #:x 280 #:y 360 #:width 16 #:height 16 #:vx 0 #:vy 0)) + (list #:type 'player #:x 280 #:y 360 + #:width 16 #:height 16 #:vx 0 #:vy 0)) + +(define (make-bullet x y) + (list #:type 'bullet #:x x #:y y + #:width 4 #:height 8 #:vx 0 #:vy -6)) + +(define (make-enemy x) + (list #:type 'enemy #:x x #:y 0 + #:width 16 #:height 16 #:vx 0 #:vy 2)) + +;; ── Collision ──────────────────────────────────────────────────────────────── (define (entities-overlap? a b) (aabb-overlap? @@ -32,22 +48,74 @@ (entity-ref b #:width 0) (entity-ref b #:height 0))) (define (find-dead entities) - (let ((bullets (filter (lambda (e) (eq? (entity-ref e #:type) 'bullet)) entities)) - (enemies (filter (lambda (e) (eq? (entity-ref e #:type) 'enemy)) entities)) - (dead '())) - (for-each - (lambda (b) - (for-each - (lambda (en) - (when (entities-overlap? b en) - (set! dead (cons b (cons en dead))))) - enemies)) - bullets) - dead)) + (let ((bullets (filter (lambda (e) (eq? (entity-type e) 'bullet)) entities)) + (enemies (filter (lambda (e) (eq? (entity-type e) 'enemy)) entities))) + (filter (lambda (e) + (case (entity-type e) + ((bullet) (any (lambda (en) (entities-overlap? e en)) enemies)) + ((enemy) (any (lambda (b) (entities-overlap? e b)) bullets)) + (else #f))) + entities))) + +(define (in-bounds? e) + (let ((y (entity-ref e #:y 0))) + (and (> y -20) (< y (+ +screen-height+ 20))))) + +;; ── Update helpers ─────────────────────────────────────────────────────────── + +(define (player-vx input) + (cond ((input-held? input 'left) -4) + ((input-held? input 'right) 4) + (else 0))) + +(define (clamp-player-x player) + (entity-set player #:x + (max 0 (min (- +screen-width+ 16) (entity-ref player #:x 0))))) + +(define (update-player player input scene) + (let ((updated (chain player + (entity-set _ #:vx (player-vx input)) + (apply-velocity-x _) + (clamp-player-x _)))) + (when (input-pressed? input 'a) + (play-sound 'shoot) + (scene-add-entity scene + (make-bullet (+ (entity-ref updated #:x 0) 6) 340))) + updated)) + +(define (move-projectile e) + (chain e + (entity-set _ #:x (+ (entity-ref e #:x 0) (entity-ref e #:vx 0))) + (entity-set _ #:y (+ (entity-ref e #:y 0) (entity-ref e #:vy 0))))) + +(define (maybe-spawn-enemy! scene) + (when (zero? (modulo *frame-count* +spawn-interval+)) + (scene-add-entity scene + (make-enemy (+ 20 (* (pseudo-random-integer 28) 20)))))) + +;; ── Render ─────────────────────────────────────────────────────────────────── + +(define (entity-color type) + (case type + ((player) (sdl2:make-color 255 255 255 255)) + ((bullet) (sdl2:make-color 255 255 0 255)) + ((enemy) (sdl2:make-color 255 50 50 255)) + (else (sdl2:make-color 100 100 100 255)))) + +(define (draw-shmup-entity renderer e) + (let ((x (inexact->exact (floor (entity-ref e #:x 0)))) + (y (inexact->exact (floor (entity-ref e #:y 0)))) + (w (entity-ref e #:width 16)) + (h (entity-ref e #:height 16))) + (set! (sdl2:render-draw-color renderer) (entity-color (entity-type e))) + (sdl2:render-fill-rect! renderer (sdl2:make-rect x y w h)))) + +;; ── Game ───────────────────────────────────────────────────────────────────── (define *game* (make-game - title: "Demo: Shoot-em-up" width: 600 height: 400 + title: "Demo: Shoot-em-up" + width: +screen-width+ height: +screen-height+ preload: (lambda (game) (init-audio!) @@ -63,72 +131,26 @@ camera-target: #f))) update: (lambda (game dt) - (let* ((input (game-input game)) - (scene (game-scene game)) - (entities (scene-entities scene)) - (player (car (filter (lambda (e) (eq? (entity-ref e #:type) 'player)) - entities)))) - (set! *frame-count* (+ *frame-count* 1)) - ;; Move player - (let* ((player (entity-set player #:vx - (cond ((input-held? input 'left) -4) - ((input-held? input 'right) 4) - (else 0)))) - (player (apply-velocity-x player)) - (player (entity-set player #:x - (max 0 (min 584 (entity-ref player #:x 0)))))) - ;; Fire bullet - (when (input-pressed? input 'a) - (play-sound 'shoot) - (scene-add-entity scene - (make-bullet (+ (entity-ref player #:x 0) 6) 340))) - ;; Spawn enemy every 60 frames - (when (zero? (modulo *frame-count* 60)) - (scene-add-entity scene - (make-enemy (+ 20 (* (pseudo-random-integer 28) 20))))) - ;; Update player in scene - (scene-entities-set! scene - (cons player - (filter (lambda (e) (not (eq? (entity-ref e #:type) 'player))) - (scene-entities scene))))) - ;; Move non-player entities + (set! *frame-count* (+ *frame-count* 1)) + (let* ((input (game-input game)) + (scene (game-scene game)) + (player (car (scene-entities scene))) + (player (update-player player input scene))) + (maybe-spawn-enemy! scene) + ;; Replace player, then move all projectiles + (scene-entities-set! scene + (cons player (filter (lambda (e) (not (eq? (entity-type e) 'player))) + (scene-entities scene)))) (scene-update-entities scene - (lambda (e) - (if (eq? (entity-ref e #:type) 'player) - e - (entity-set - (entity-set e #:x (+ (entity-ref e #:x 0) (entity-ref e #:vx 0))) - #:y (+ (entity-ref e #:y 0) (entity-ref e #:vy 0)))))) - ;; Remove collisions + (lambda (e) (if (eq? (entity-type e) 'player) e (move-projectile e)))) + ;; Remove bullet/enemy collisions, then out-of-bounds (let ((dead (find-dead (scene-entities scene)))) - (scene-filter-entities scene - (lambda (e) (not (memq e dead))))) - ;; Remove out-of-bounds + (scene-filter-entities scene (lambda (e) (not (memq e dead))))) (scene-filter-entities scene - (lambda (e) - (let ((y (entity-ref e #:y 0))) - (or (eq? (entity-ref e #:type) 'player) - (and (> y -20) (< y 420)))))))) + (lambda (e) (or (eq? (entity-type e) 'player) (in-bounds? e)))))) render: (lambda (game) - (let* ((renderer (game-renderer game)) - (scene (game-scene game)) - (entities (scene-entities scene))) - (for-each - (lambda (e) - (let ((type (entity-ref e #:type 'unknown)) - (x (inexact->exact (floor (entity-ref e #:x 0)))) - (y (inexact->exact (floor (entity-ref e #:y 0)))) - (w (entity-ref e #:width 16)) - (h (entity-ref e #:height 16))) - (set! (sdl2:render-draw-color renderer) - (case type - ((player) (sdl2:make-color 255 255 255 255)) - ((bullet) (sdl2:make-color 255 255 0 255)) - ((enemy) (sdl2:make-color 255 50 50 255)) - (else (sdl2:make-color 100 100 100 255)))) - (sdl2:render-fill-rect! renderer - (sdl2:make-rect x y w h)))) - entities))))) + (for-each (lambda (e) (draw-shmup-entity (game-renderer game) e)) + (scene-entities (game-scene game)))))) (game-run! *game*) diff --git a/demo/spritefont.scm b/demo/spritefont.scm index 8895d3c..2abc07a 100644 --- a/demo/spritefont.scm +++ b/demo/spritefont.scm @@ -17,35 +17,26 @@ title: "Demo: Sprite Font" width: 600 height: 400 create: (lambda (game) - (let* ((scene (game-load-scene! game "demo/assets/level-0.tmx")) - (tileset (tilemap-tileset (scene-tilemap scene)))) - ;; Create sprite font with character ranges - ;; A-M: tiles 917-929, N-Z: tiles 966-978, 0-9: tiles 868-877 - (set! *sprite-font* - (make-sprite-font* - #:tile-size 16 - #:spacing 1 - #:ranges '((#\A #\M 918) - (#\N #\Z 967) - (#\0 #\9 869)))))) + (game-load-scene! game "demo/assets/level-0.tmx") + (set! *sprite-font* + (make-sprite-font* + #:tile-size 16 #:spacing 1 + #:ranges '((#\A #\M 918) (#\N #\Z 967) (#\0 #\9 869))))) render: (lambda (game) - (let* ((renderer (game-renderer game)) - (scene (game-scene game)) - (tileset (tilemap-tileset (scene-tilemap scene))) - (tileset-texture (scene-tileset-texture scene))) - ;; Clear background + (let* ((scene (game-scene game)) + (renderer (game-renderer game)) + (tileset (tilemap-tileset (scene-tilemap scene))) + (texture (scene-tileset-texture scene))) (set! (sdl2:render-draw-color renderer) (sdl2:make-color 30 30 60 255)) (sdl2:render-fill-rect! renderer (sdl2:make-rect 0 0 600 400)) - - ;; Draw sprite text at various positions - (draw-sprite-text renderer tileset-texture tileset *sprite-font* - "HELLO WORLD" 50 50) - (draw-sprite-text renderer tileset-texture tileset *sprite-font* - "DOWNSTROKE" 100 120) - (draw-sprite-text renderer tileset-texture tileset *sprite-font* - "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 20 200) - (draw-sprite-text renderer tileset-texture tileset *sprite-font* - "0123456789" 150 280))))) + (for-each + (lambda (entry) + (draw-sprite-text renderer texture tileset *sprite-font* + (car entry) (cadr entry) (caddr entry))) + '(("HELLO WORLD" 50 50) + ("DOWNSTROKE" 100 120) + ("ABCDEFGHIJKLMNOPQRSTUVWXYZ" 20 200) + ("0123456789" 150 280))))))) (game-run! *game*) diff --git a/demo/topdown.scm b/demo/topdown.scm index 2b3c208..7e5bd62 100644 --- a/demo/topdown.scm +++ b/demo/topdown.scm @@ -1,5 +1,6 @@ (import scheme (chicken base) + (only srfi-197 chain) (prefix sdl2 "sdl2:") (prefix sdl2-ttf "ttf:") (prefix sdl2-image "img:") @@ -13,36 +14,44 @@ downstroke-entity downstroke-scene-loader) +(define (make-player) + (list #:type 'player + #:x 100 #:y 100 + #:width 16 #:height 16 + #:vx 0 #:vy 0 + #:gravity? #f + #:tile-id 1 #:tags '(player))) + +(define (input->velocity input) + (values (+ (if (input-held? input 'left) -3 0) + (if (input-held? input 'right) 3 0)) + (+ (if (input-held? input 'up) -3 0) + (if (input-held? input 'down) 3 0)))) + +(define (update-player player input tm) + (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)))) + (define *game* (make-game title: "Demo: Top-down Explorer" width: 600 height: 400 create: (lambda (game) - (let* ((scene (game-load-scene! game "demo/assets/level-0.tmx")) - (player (list #:type 'player - #:x 100 #:y 100 - #:width 16 #:height 16 - #:vx 0 #:vy 0 - #:gravity? #f - #:tile-id 1 - #:tags '(player))) - (_ (scene-add-entity scene player))) + (let ((scene (game-load-scene! game "demo/assets/level-0.tmx"))) + (scene-add-entity scene (make-player)) (scene-camera-target-set! scene 'player))) update: (lambda (game dt) (let* ((input (game-input game)) (scene (game-scene game)) - (tm (scene-tilemap scene)) - (player (car (scene-entities scene))) - (dx (+ (if (input-held? input 'left) -3 0) - (if (input-held? input 'right) 3 0))) - (dy (+ (if (input-held? input 'up) -3 0) - (if (input-held? input 'down) 3 0))) - (player (entity-set (entity-set player #:vx dx) #:vy dy)) - (player (apply-velocity-x player)) - (player (resolve-tile-collisions-x player tm)) - (player (apply-velocity-y player)) - (player (resolve-tile-collisions-y player tm))) + (player (update-player (car (scene-entities scene)) + input (scene-tilemap scene)))) (scene-entities-set! scene (list player)))))) (game-run! *game*) diff --git a/demo/tweens.scm b/demo/tweens.scm index ad9c80b..34c7759 100644 --- a/demo/tweens.scm +++ b/demo/tweens.scm @@ -1,6 +1,7 @@ (import scheme (chicken base) - (only srfi-1 iota map) + (only srfi-1 iota) + (only srfi-197 chain) (prefix sdl2 "sdl2:") (prefix sdl2-ttf "ttf:") downstroke-engine @@ -10,120 +11,130 @@ downstroke-entity downstroke-tween) -;; One row per easing symbol: #(entity tween left-x right-x ease-sym to-right?) -(define *ease-cells* #f) +;; ── Constants ──────────────────────────────────────────────────────────────── -(define *knock-ent* #f) -(define *knock-tw* #f) -(define *knock-cd* 0) +(define +ease-duration+ 2600) +(define +knock-cooldown-ms+ 3200) +(define +knock-distance+ 88) +(define +knock-duration+ 650) +(define +knock-skip+ '(jump acceleration gravity velocity-x velocity-y)) -(define +knock-skip+ - '(jump acceleration gravity velocity-x velocity-y)) - -(define *ease-syms* +(define +ease-syms+ '(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 +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 (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)) +;; ── State ──────────────────────────────────────────────────────────────────── + +(define *ease-cells* #f) ; vector of #(ent tw left right ease-sym to-right?) +(define *knock-ent* #f) +(define *knock-tw* #f) +(define *knock-cd* 0) +(define *label-font* #f) +(define *title-font* #f) + +;; ── Ease grid ──────────────────────────────────────────────────────────────── (define (make-ease-cell ease-sym y rgb) - (let* ((left 20) + (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 #:color rgb)) - (tw (make-tween ent props: `((#:x . ,right)) duration: 2600 ease: ease-sym))) + (ent (list #:type 'tween-demo #:x left #:y y + #:width 14 #:height 14 + #:vx 0 #:vy 0 #:gravity? #f #:solid? #f #:color rgb)) + (tw (make-tween ent props: `((#:x . ,right)) + duration: +ease-duration+ ease: ease-sym))) (vector ent tw left right ease-sym #t))) (define (advance-ease-cell! cell dt) - (let ((ent (vector-ref cell 0)) - (tw (vector-ref cell 1)) - (left (vector-ref cell 2)) - (right (vector-ref cell 3)) - (ease (vector-ref cell 4)) + (let ((ent (vector-ref cell 0)) + (tw (vector-ref cell 1)) + (left (vector-ref cell 2)) + (right (vector-ref cell 3)) + (ease (vector-ref cell 4)) (to-right? (vector-ref cell 5))) (receive (tw2 ent2) (tween-step tw ent dt) (vector-set! cell 0 ent2) - (cond ((tween-finished? tw2) - (let* ((next-to-right? (not to-right?)) - (target-x (if next-to-right? right left)) - (tw3 (make-tween ent2 props: `((#:x . ,target-x)) - duration: 2600 ease: ease))) - (vector-set! cell 1 tw3) - (vector-set! cell 5 next-to-right?))) - (else (vector-set! cell 1 tw2)))))) + (if (tween-finished? tw2) + (let* ((next-dir (not to-right?)) + (target (if next-dir right left))) + (vector-set! cell 1 (make-tween ent2 props: `((#:x . ,target)) + duration: +ease-duration+ ease: ease)) + (vector-set! cell 5 next-dir)) + (vector-set! cell 1 tw2))))) -(define (update-knockback! dt tm gw gh) - (set! *knock-cd* (+ *knock-cd* dt)) - (when (and *knock-ent* (not *knock-tw*) (>= *knock-cd* 3200)) +;; ── Knockback crate ────────────────────────────────────────────────────────── + +(define (run-physics e tm) + (chain e + (apply-jump _ #f) + (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 (clamp-entity-to-screen e gw gh) + (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)) + (nx (max 0 (min (- gw w) x))) + (ny (max 0 (min (- gh h) y))) + (on-floor? (and (entity-ref e #:gravity? #f) (= ny (- gh h))))) + (chain e + (entity-set _ #:x nx) + (entity-set _ #:y ny) + (entity-set _ #:vx (if (= nx x) (entity-ref e #:vx 0) 0)) + (entity-set _ #:vy (if (= ny y) (entity-ref e #:vy 0) 0)) + (entity-set _ #:on-ground? on-floor?)))) + +(define (run-physics-no-tilemap e gw gh) + (chain e + (apply-jump _ #f) + (apply-acceleration _) + (apply-gravity _) + (apply-velocity-x _) + (apply-velocity-y _) + (clamp-entity-to-screen _ gw gh))) + +(define (maybe-start-knockback!) + (when (and *knock-ent* (not *knock-tw*) (>= *knock-cd* +knock-cooldown-ms+)) (set! *knock-cd* 0) (let ((x (entity-ref *knock-ent* #:x 0))) (set! *knock-ent* (entity-set *knock-ent* #:skip-pipelines +knock-skip+)) - (set! *knock-tw* (make-tween *knock-ent* - props: `((#:x . ,(+ x 88))) - duration: 650 - ease: 'back-out - on-complete: (lambda (e) - (set! *knock-ent* (entity-set e #:skip-pipelines '()))))))) + (set! *knock-tw* + (make-tween *knock-ent* + props: `((#:x . ,(+ x +knock-distance+))) + duration: +knock-duration+ + ease: 'back-out + on-complete: (lambda (e) + (set! *knock-ent* (entity-set e #:skip-pipelines '())))))))) + +(define (advance-knockback-tween! dt) (when *knock-tw* (receive (t2 e2) (tween-step *knock-tw* *knock-ent* dt) - (set! *knock-tw* (if (tween-finished? t2) #f t2)) - (set! *knock-ent* e2))) + (set! *knock-tw* (if (tween-finished? t2) #f t2)) + (set! *knock-ent* e2)))) + +(define (update-knockback! dt tm gw gh) + (set! *knock-cd* (+ *knock-cd* dt)) + (maybe-start-knockback!) + (advance-knockback-tween! dt) (when *knock-ent* (set! *knock-ent* (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) + (run-physics *knock-ent* tm) + (run-physics-no-tilemap *knock-ent* gw gh))))) + +;; ── Rendering ──────────────────────────────────────────────────────────────── + +(define (draw-ease-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) @@ -132,54 +143,57 @@ white 12 32) (do ((i 0 (+ i 1))) ((>= i (vector-length *ease-cells*))) (let* ((cell (vector-ref *ease-cells* i)) - (ent (vector-ref cell 0)) - (lab (symbol->string (vector-ref cell 4)))) - (draw-ui-text renderer *label-font* lab white 158 (- (entity-ref ent #:y 0) 2)))))) + (ent (vector-ref cell 0)) + (lab (symbol->string (vector-ref cell 4)))) + (draw-ui-text renderer *label-font* lab white + 158 (- (entity-ref ent #:y 0) 2)))))) + +(define (ease-cell-entities) + (map (lambda (i) (vector-ref (vector-ref *ease-cells* i) 0)) + (iota (vector-length *ease-cells*)))) + +;; ── Game ───────────────────────────────────────────────────────────────────── (define *game* (make-game title: "Demo: Tweens" width: 640 height: 480 + preload: (lambda (_game) (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 (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)) - (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 - #: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*))) - (game-scene-set! game scene))) + (set! *ease-cells* + (list->vector + (map (lambda (ease i) + (make-ease-cell ease (+ 52 (* i 20)) (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 + #:color '(140 110 70))) + (set! *knock-tw* #f) + (set! *knock-cd* 2500) + (game-scene-set! game + (make-scene entities: (append (ease-cell-entities) (list *knock-ent*)) + tilemap: #f + camera: (make-camera x: 0 y: 0) + tileset-texture: #f + camera-target: #f + background: '(26 28 34)))) + update: (lambda (game dt) - (let* ((scene (game-scene game)) - (tm (scene-tilemap scene)) - (gw (game-width game)) - (gh (game-height game))) + (let ((tm (scene-tilemap (game-scene game))) + (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 gw gh) - (scene-entities-set! scene - (append (map (lambda (i) (vector-ref (vector-ref *ease-cells* i) 0)) - (iota (vector-length *ease-cells*))) - (list *knock-ent*))))) + (scene-entities-set! (game-scene game) + (append (ease-cell-entities) (list *knock-ent*))))) + render: (lambda (game) - (tweens-demo-render-labels! (game-renderer game))))) + (draw-ease-labels! (game-renderer game))))) (game-run! *game*) |