From 027053b11a3a5d861ed2fa2db245388bd95ac246 Mon Sep 17 00:00:00 2001 From: Gene Pasquet Date: Sun, 5 Apr 2026 19:47:05 +0100 Subject: Progress --- demo/assets/DejaVuSans.ttf | Bin 0 -> 741536 bytes demo/assets/jump.wav | Bin 0 -> 35960 bytes demo/assets/level-0.tmx | 47 ++++++++++++ demo/assets/monochrome-transparent.png | Bin 0 -> 26834 bytes demo/assets/monochrome_transparent.tsx | 4 + demo/assets/theme.ogg | Bin 0 -> 1740215 bytes demo/audio.scm | 52 +++++++++++++ demo/platformer.scm | 70 +++++++++++++++++ demo/sandbox.scm | 71 ++++++++++++++++++ demo/shmup.scm | 133 +++++++++++++++++++++++++++++++++ demo/topdown.scm | 59 +++++++++++++++ 11 files changed, 436 insertions(+) create mode 100644 demo/assets/DejaVuSans.ttf create mode 100644 demo/assets/jump.wav create mode 100644 demo/assets/level-0.tmx create mode 100644 demo/assets/monochrome-transparent.png create mode 100644 demo/assets/monochrome_transparent.tsx create mode 100644 demo/assets/theme.ogg create mode 100644 demo/audio.scm create mode 100644 demo/platformer.scm create mode 100644 demo/sandbox.scm create mode 100644 demo/shmup.scm create mode 100644 demo/topdown.scm (limited to 'demo') diff --git a/demo/assets/DejaVuSans.ttf b/demo/assets/DejaVuSans.ttf new file mode 100644 index 0000000..9d40c32 Binary files /dev/null and b/demo/assets/DejaVuSans.ttf differ diff --git a/demo/assets/jump.wav b/demo/assets/jump.wav new file mode 100644 index 0000000..89eb587 Binary files /dev/null and b/demo/assets/jump.wav differ diff --git a/demo/assets/level-0.tmx b/demo/assets/level-0.tmx new file mode 100644 index 0000000..300e1a2 --- /dev/null +++ b/demo/assets/level-0.tmx @@ -0,0 +1,47 @@ + + + + + +0,0,0,0,168,216,0,0,0,0,215,169,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,168,216,0,0,215,169,0,0,0,0, +0,0,0,168,216,0,0,0,0,0,0,215,169,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,168,216,0,0,0,0,215,169,0,0,168, +0,0,168,216,0,0,0,0,0,0,0,0,215,169,0,0,0,0,0,0,0,0,168,169,0,0,0,0,168,216,0,0,0,0,0,0,215,169,168,216, +0,168,216,0,0,0,0,0,0,0,0,0,0,215,169,0,0,168,169,0,0,168,216,215,169,0,0,168,216,0,0,0,0,0,0,0,0,215,169,0, +168,216,0,0,0,0,0,0,0,0,0,0,0,0,215,169,168,216,215,169,168,216,0,0,215,169,168,216,0,0,0,0,0,0,0,0,0,0,215,169, +216,0,0,0,0,0,0,0,0,0,0,0,0,0,0,215,169,0,0,168,216,0,0,0,0,215,216,0,0,0,0,0,0,0,0,0,0,0,0,215, +0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,215,169,168,216,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,215,216,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +939,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +893,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,688,0,0,0, +846,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,844,0,0,0, +844,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,845,546,546,546, +846,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,844,844,844,844, +844,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,444,844,844,844, +548,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,215,20,20,19,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20, +20,20,20,20,21,0,0,0,0,0,0,0,0,0,0,0,0,0,0,742,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1058,0,0,0, +0,0,0,0,215,21,0,0,0,0,0,0,0,0,0,0,0,0,0,644,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +0,0,0,69,0,215,21,0,0,0,0,0,0,0,0,0,0,0,0,638,0,0,0,0,0,0,0,0,0,0,0,69,0,0,0,0,0,0,69,0, +0,0,0,0,0,0,215,21,0,0,0,0,0,0,0,0,19,20,20,216,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,215,21,0,0,0,0,0,0,0,68,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,215,20,20,20,20,20,20,20,216,0,0,0,0,0,0,69,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +69,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +0,0,0,0,69,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 + + + + + + + + + + + + diff --git a/demo/assets/monochrome-transparent.png b/demo/assets/monochrome-transparent.png new file mode 100644 index 0000000..b95bef5 Binary files /dev/null and b/demo/assets/monochrome-transparent.png differ diff --git a/demo/assets/monochrome_transparent.tsx b/demo/assets/monochrome_transparent.tsx new file mode 100644 index 0000000..279c64d --- /dev/null +++ b/demo/assets/monochrome_transparent.tsx @@ -0,0 +1,4 @@ + + + + diff --git a/demo/assets/theme.ogg b/demo/assets/theme.ogg new file mode 100644 index 0000000..8325258 Binary files /dev/null and b/demo/assets/theme.ogg differ diff --git a/demo/audio.scm b/demo/audio.scm new file mode 100644 index 0000000..8ae4d62 --- /dev/null +++ b/demo/audio.scm @@ -0,0 +1,52 @@ +(import scheme + (chicken base) + (prefix sdl2 "sdl2:") + (prefix sdl2-ttf "ttf:") + (prefix sdl2-image "img:") + downstroke/engine + downstroke/renderer + downstroke/input + downstroke/assets + downstroke/sound) + +(define *music-on?* #f) + +(define *game* + (make-game + title: "Demo: Audio" width: 600 height: 400 + + preload: (lambda (game) + (init-audio!) + (load-sounds! '((jump . "demo/assets/jump.wav"))) + (load-music! "demo/assets/theme.ogg") + (game-asset-set! game 'font + (ttf:open-font "demo/assets/DejaVuSans.ttf" 20))) + + update: (lambda (game dt) + (let ((input (game-input game))) + (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)) + (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) + (draw-ui-text renderer font + (if *music-on?* "Music: ON" "Music: OFF") + (if *music-on?* + (sdl2:make-color 100 255 100 255) + (sdl2:make-color 255 100 100 255)) + 240 310))))) + +(game-run! *game*) diff --git a/demo/platformer.scm b/demo/platformer.scm new file mode 100644 index 0000000..d9276b8 --- /dev/null +++ b/demo/platformer.scm @@ -0,0 +1,70 @@ +(import scheme + (chicken base) + (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/sound) + +(define *game* + (make-game + title: "Demo: Platformer" width: 600 height: 400 + + preload: (lambda (game) + (init-audio!) + (load-sounds! '((jump . "demo/assets/jump.wav"))) + (game-asset-set! game 'tilemap + (load-tilemap "demo/assets/level-0.tmx"))) + + create: (lambda (game) + (let* ((tm (game-asset game 'tilemap)) + (tex (sdl2:create-texture-from-surface + (game-renderer game) + (tileset-image (tilemap-tileset tm)))) + (player (list #:type 'player + #:x 100 #:y 50 + #:width 16 #:height 16 + #:vx 0 #:vy 0 + #:gravity? #t + #:on-ground? #f + #:tile-id 1))) + (game-scene-set! game + (make-scene + entities: (list player) + tilemap: tm + camera: (make-camera x: 0 y: 0) + tileset-texture: tex)))) + + 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-ground player tm))) + (let ((cam-x (max 0 (- (entity-ref player #:x 0) 300)))) + (camera-x-set! (scene-camera scene) cam-x)) + (scene-entities-set! scene (list player)))))) + +(game-run! *game*) diff --git a/demo/sandbox.scm b/demo/sandbox.scm new file mode 100644 index 0000000..1be3968 --- /dev/null +++ b/demo/sandbox.scm @@ -0,0 +1,71 @@ +(import scheme + (chicken base) + (chicken random) + (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) + +(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 *game* + (make-game + title: "Demo: Physics Sandbox" width: 600 height: 400 + + preload: (lambda (game) + (game-asset-set! game 'tilemap + (load-tilemap "demo/assets/level-0.tmx"))) + + create: (lambda (game) + (let* ((tm (game-asset game 'tilemap)) + (tex (sdl2:create-texture-from-surface + (game-renderer game) + (tileset-image (tilemap-tileset tm))))) + (game-scene-set! game + (make-scene + entities: (spawn-entities) + tilemap: tm + camera: (make-camera x: 0 y: 0) + tileset-texture: tex)))) + + update: (lambda (game 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))))) + +(game-run! *game*) diff --git a/demo/shmup.scm b/demo/shmup.scm new file mode 100644 index 0000000..ae7748d --- /dev/null +++ b/demo/shmup.scm @@ -0,0 +1,133 @@ +(import scheme + (chicken base) + (chicken random) + (only srfi-1 filter) + (prefix sdl2 "sdl2:") + (prefix sdl2-ttf "ttf:") + (prefix sdl2-image "img:") + downstroke/engine + downstroke/world + downstroke/physics + downstroke/input + downstroke/entity + downstroke/assets + downstroke/sound) + +(define *frame-count* 0) + +(define (make-bullet px py) + (list #:type 'bullet #:x px #:y py #:width 4 #:height 8 #:vx 0 #:vy -6)) + +(define (make-enemy rx) + (list #:type 'enemy #:x rx #:y 0 #:width 16 #:height 16 #:vx 0 #:vy 2)) + +(define (make-player) + (list #:type 'player #:x 280 #:y 360 #:width 16 #:height 16 #:vx 0 #:vy 0)) + +(define (entities-overlap? a b) + (aabb-overlap? + (entity-ref a #:x 0) (entity-ref a #:y 0) + (entity-ref a #:width 0) (entity-ref a #:height 0) + (entity-ref b #:x 0) (entity-ref b #:y 0) + (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)) + +(define *game* + (make-game + title: "Demo: Shoot-em-up" width: 600 height: 400 + + preload: (lambda (game) + (init-audio!) + (load-sounds! '((shoot . "demo/assets/jump.wav")))) + + create: (lambda (game) + (game-scene-set! game + (make-scene + entities: (list (make-player)) + tilemap: #f + camera: (make-camera x: 0 y: 0) + tileset-texture: #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 + (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 + (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) + (let ((y (entity-ref e #:y 0))) + (or (eq? (entity-ref e #:type) 'player) + (and (> y -20) (< y 420)))))))) + + 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))))) + +(game-run! *game*) diff --git a/demo/topdown.scm b/demo/topdown.scm new file mode 100644 index 0000000..9bbaf08 --- /dev/null +++ b/demo/topdown.scm @@ -0,0 +1,59 @@ +(import scheme + (chicken base) + (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) + +(define *game* + (make-game + title: "Demo: Top-down Explorer" width: 600 height: 400 + + preload: (lambda (game) + (game-asset-set! game 'tilemap + (load-tilemap "demo/assets/level-0.tmx"))) + + create: (lambda (game) + (let* ((tm (game-asset game 'tilemap)) + (tex (sdl2:create-texture-from-surface + (game-renderer game) + (tileset-image (tilemap-tileset tm)))) + (player (list #:type 'player + #:x 100 #:y 100 + #:width 16 #:height 16 + #:vx 0 #:vy 0 + #:gravity? #f + #:tile-id 1))) + (game-scene-set! game + (make-scene + entities: (list player) + tilemap: tm + camera: (make-camera x: 0 y: 0) + tileset-texture: tex)))) + + 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))) + (camera-x-set! (scene-camera scene) (max 0 (- (entity-ref player #:x 0) 300))) + (camera-y-set! (scene-camera scene) (max 0 (- (entity-ref player #:y 0) 200))) + (scene-entities-set! scene (list player)))))) + +(game-run! *game*) -- cgit v1.2.3