Progress

1 files changed, 59 insertions, 0 deletions

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