Support entity groups

1 files changed, 33 insertions, 29 deletions

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