Kill player when gate closes on them.

game.scm

@@ -68,6 +68,7 @@
 (define audio:no (load-sound-effect "no"))
 (define audio:exit (load-sound-effect "exit"))
 (define audio:pickup (load-sound-effect "pickup"))
+(define audio:die (load-sound-effect "die"))
 
 ;; Game state
 (define *state* #f)
@@ -198,10 +199,16 @@
 (define (move-player dir)
   (define (do-move)
     (with-goblins
-     ($ (level-player *level*) 'move dir)
+     (let ((player (level-player *level*)))
+       (if ($ player 'alive?)
+           (begin
+             ($ player 'move dir)
              ($ (level-actor *level*) 'tick)
-     (define result
+             ;; TODO: Need a better way to receive events to play sounds
-       (match ($ (level-player *level*) 'event)
+             ;; and emit particles and stuff so any actor can trigger
+             ;; events.
+             (let ((result
+                    (match ($ player 'event)
                       (('bump)
                        (media-play audio:bump)
                        #f)
@@ -211,16 +218,22 @@
                       (('exit)
                        (media-play audio:exit)
                        'next-level)
+                      (('die)
+                       (media-play audio:die)
+                       #f)
                       (('gem)
                        (media-play audio:pickup)
                        ;; TODO: Maybe show a little achievement popup when all gems
                        ;; are collected?
                        (set! *gems* (cons *level-idx* *gems*))
                        #f)
-         (_ #f)))
+                      (_ #f))))
                (update-objects!)
-     result))
                (save-snapshot!)
+               result))
+           (begin
+             (media-play audio:no)
+             #f)))))
   (when (eq? (do-move) 'next-level)
     (next-level!)))
 

modules/game/actors.scm

@@ -39,6 +39,7 @@
     (('type) 'exit)
     (('position) position)
     (('tick grid-info) #f)
+    (('post-tick grid-info) #f)
     (('enter obj grid-info) #f)
     (('exit obj grid-info) #f)
     (('wire-state) #f)
@@ -54,6 +55,7 @@
     (('type) 'wall)
     (('position) position)
     (('tick grid-info) #f)
+    (('post-tick grid-info) #f)
     (('enter obj grid-info) #f)
     (('exit obj grid-info) #f)
     (('wire-state)
@@ -80,6 +82,7 @@
     (('type) 'block)
     (('position) ($ position))
     (('tick grid-info) ($ pushed? #f))
+    (('post-tick grid-info) #f)
     (('enter obj grid-info) #f)
     (('exit obj grid-info) #f)
     (('wire-state)
@@ -123,6 +126,7 @@
     (('type) 'emitter)
     (('position) position)
     (('tick grid-info) ($ timer (+ ($ timer) 1)))
+    (('post-tick grid-info) #f)
     (('enter obj grid-info) #f)
     (('exit obj grid-info) #f)
     (('wire-state)
@@ -155,6 +159,7 @@
     (('type) 'switch)
     (('position) position)
     (('tick grid-info) #f)
+    (('post-tick grid-info) #f)
     (('enter obj grid-info)
      ($ on? #t))
     (('exit obj grid-info)
@@ -181,6 +186,7 @@
     (('type) 'switch)
     (('position) position)
     (('tick grid-info) #f)
+    (('post-tick grid-info) #f)
     (('enter obj grid-info) #f)
     (('exit obj grid-info) #f)
     (('wire-state) #f)
@@ -210,6 +216,7 @@
     (('type) 'gem)
     (('position) position)
     (('tick grid-info) #f)
+    (('post-tick grid-info) #f)
     (('enter obj grid-info) #f)
     (('exit obj grid-info) #f)
     (('wire-state) #f)
@@ -227,6 +234,7 @@
     (('type) 'gate)
     (('position) position)
     (('tick grid-info) #f)
+    (('post-tick grid-info) #f)
     (('enter obj grid-info) #f)
     (('exit obj grid-info) #f)
     (('activate) ($ open? #t))
@@ -245,6 +253,7 @@
     (('type) 'emitter)
     (('position) position)
     (('tick grid-info) #f)
+    (('post-tick grid-info) #f)
     (('enter obj grid-info) #f)
     (('exit obj grid-info) #f)
     (('wire-state) ($ state))
@@ -268,6 +277,7 @@
 (define (^player bcom x y)
   (define position (spawn ^cell (vector x y 2)))
   (define velocity (spawn ^cell #(0 0)))
+  (define alive? (spawn ^cell #t))
   (define event (spawn ^cell))
   (match-lambda*
     (('type) 'player)
@@ -281,18 +291,39 @@
           ('down #(0 1))
           (_ (error "invalid direction" dir)))))
     (('tick grid-info)
-     ($ event #f)
+     ;; Search for objects that were fine to step onto last turn, but
+     ;; have become deadly this turn.  If
      (match ($ position)
        (#(x y z)
+        ($ event #f)
         (match ($ velocity)
           (#(dx dy)
            ($ position (vector (+ x dx) (+ y dy) z))
            ($ velocity #(0 0)))))))
+    (('post-tick grid-info)
+     (match ($ position)
+       (#(x y z)
+        (let lp ((objs ($ grid-info 'occupants x y)))
+          (match objs
+            ;; All is well.  Move by current velocity.
+            (()
+             (match ($ velocity)
+               (#(dx dy)
+                ($ position (vector (+ x dx) (+ y dy) z))
+                ($ velocity #(0 0)))))
+            ((obj . rest)
+             (match ($ obj 'type)
+               ('gate
+                ;; Ouch, a gate closed on the player!
+                (unless ($ obj 'open?)
+                  ($ alive? #f)
+                  ($ event '(die))))
+               (_ (lp rest)))))))))
     (('enter obj grid-info) #f)
     (('exit obj grid-info) #f)
     (('wire-state) #f)
     (('update-wire-state grid-info) #f)
-    (('alive?) #t)
+    (('alive?) ($ alive?))
     (('describe) `(player ,($ position)))
     (('collide other offset grid-info)
      (define (reverse-move)
@@ -451,28 +482,34 @@
                          (unless (equal? other-pos other-prev-pos)
                            (collide other other-pos other-prev-pos)))
                        (lp rest))))))))))))
-  (define (tick)
+  (define (iter-objects proc)
-    ;; Tick each object and check for collisions.
     ($ objects
        (let lp ((objs ($ objects)))
          (match objs
            (() '())
            ((obj . rest)
+            (proc obj)
+            ;; Cull dead objects.
+            (if ($ obj 'alive?)
+                (cons obj (lp rest))
+                (lp rest)))))))
+  (define (tick)
+    ;; Tick each object and check for collisions.
+    (iter-objects
+     (lambda (obj)
        (let ((prev-pos ($ obj 'position)))
          ($ obj 'tick grid-info)
          ;; Only check collisions for movable objects.
          (let ((desired-pos ($ obj 'position)))
            (unless (equal? prev-pos desired-pos)
-                  (collide obj desired-pos prev-pos)))
+             (collide obj desired-pos prev-pos))))))
-              ;; Cull dead objects.
-              (if ($ obj 'alive?)
-                  (cons obj (lp rest))
-                  (lp rest)))))))
     ;; Advance Wirewold simulation.
     (refresh-wire-grid)
     (for-each (lambda (obj)
                 ($ obj 'update-wire-state grid-info))
-              ($ objects)))
+              ($ objects))
+    ;; Run post-tick hooks.
+    (iter-objects (lambda (obj) ($ obj 'post-tick grid-info))))
 
   (match-lambda*
     (('tick) (tick))