Progress

1 files changed, 70 insertions, 0 deletions

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*)