Progress

11 files changed, 436 insertions, 0 deletions

diff --git a/demo/assets/DejaVuSans.ttf b/demo/assets/DejaVuSans.ttf
new file mode 100644
index 0000000..9d40c32
--- /dev/null
+++ b/demo/assets/DejaVuSans.ttf
diff --git a/demo/assets/jump.wav b/demo/assets/jump.wav
new file mode 100644
index 0000000..89eb587
--- /dev/null
+++ b/demo/assets/jump.wav
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 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<map version="1.10" tiledversion="1.12.0" orientation="orthogonal" renderorder="right-down" width="40" height="30" tilewidth="16" tileheight="16" infinite="0" nextlayerid="8" nextobjectid="5">
+ <tileset firstgid="1" source="monochrome_transparent.tsx"/>
+ <layer id="3" name="ground" width="40" height="30">
+  <data encoding="csv">
+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
+</data>
+ </layer>
+ <objectgroup id="7" name="entities">
+  <object id="2" name="player" type="Player" gid="29" x="182" y="350.5" width="16" height="16"/>
+  <object id="3" name="hint" type="Text" x="98.5" y="432.5" width="197" height="78">
+   <properties>
+    <property name="text" value="hit enter to start a macro"/>
+   </properties>
+  </object>
+  <object id="4" name="goal" type="Goal" x="565.694" y="287.776" width="16" height="16"/>
+ </objectgroup>
+</map>
diff --git a/demo/assets/monochrome-transparent.png b/demo/assets/monochrome-transparent.png
new file mode 100644
index 0000000..b95bef5
--- /dev/null
+++ b/demo/assets/monochrome-transparent.png
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 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<tileset version="1.10" tiledversion="1.11.2" name="monochrome_transparent" tilewidth="16" tileheight="16" spacing="1" tilecount="1078" columns="49">
+ <image source="monochrome-transparent.png" width="832" height="373"/>
+</tileset>
diff --git a/demo/assets/theme.ogg b/demo/assets/theme.ogg
new file mode 100644
index 0000000..8325258
--- /dev/null
+++ b/demo/assets/theme.ogg
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*)