Add exit actor that doesn't really work yet.

game.scm

@@ -46,11 +46,13 @@
 (define *canvas-width* 0)
 (define *canvas-height* 0)
 
+;; Assets
 (define tileset
   (make-tileset (make-image "assets/images/cirkoban.png")
                 320 240
                 (inexact->exact tile-width)
                 (inexact->exact tile-height)))
+(define audio:bump (make-audio "assets/sounds/bump.wav"))
 
 ;; Game state
 (define *actormap* (make-whactormap))
@@ -89,7 +91,9 @@
 (define (move-player dir)
   (save-snapshot!)
   (with-goblins
-   ($ *level* 'move-player dir)
+   (match ($ *level* 'move-player dir)
+     (#f (media-play audio:bump))
+     (_ #f))
    (update-grid!)))
 
 (define dt (/ 1000.0 60.0)) ; aim for updating at 60Hz
@@ -110,6 +114,9 @@
 (define (draw-player x y)
   (draw-tile context tileset 0 x y))
 
+(define (draw-exit x y)
+  (draw-tile context tileset 27 x y))
+
 (define (draw-wall type x y)
   (match type
     ('brick
@@ -142,6 +149,7 @@
          (match obj
            (#f #f)
            (('player) (draw-player x y))
+           (('exit) (draw-exit x y))
            (('wall type) (draw-wall type x y))
            (('block type) (draw-block type x y))
            (('clock-emitter) (draw-clock-emitter x y))))))
@@ -187,7 +195,9 @@
       (move-player 'down))
      ((string=? key key:undo)
       (rollback-snapshot!)
-      (with-goblins (update-grid!))))))
+      (with-goblins (update-grid!)))
+     ((string=? key key:confirm)
+      (reset-game!)))))
 
 (define (on-key-up event)
   (let ((key (keyboard-event-code event)))

modules/game/actors.scm

@@ -1,5 +1,4 @@
 (define-module (game actors)
-  #:use-module (dom canvas)
   #:use-module (goblins core)
   #:use-module (ice-9 match)
   #:export (^cell
@@ -11,6 +10,14 @@
     ((new-val)
      (bcom (^cell bcom new-val)))))
 
+(define (^exit bcom)
+  (match-lambda*
+    (('tick) #f)
+    (('wire-state) #f)
+    (('set-wire-state) #f)
+    (('describe) '(exit))
+    (('collide) 'goal)))
+
 (define (^wall bcom type)
   (match-lambda*
     (('tick) #f)
@@ -100,6 +107,7 @@
            (occupant
             (match ($ occupant 'collide)
               ('stop #f)
+              ('goal (pk 'GOAL))
               ('displace
                (let ((next-cell (grid-ref grid (wrap-x (+ x dx)) (wrap-y (+ y dy)))))
                  (match ($ next-cell)
@@ -107,7 +115,8 @@
                     ($ next-cell ($ cell))
                     ($ cell player)
                     ($ old-cell #f)
-                    ($ player-coords (vector x y)))
+                    ($ player-coords (vector x y))
+                    'displace)
                    (_ #f)))))))))))
   (define (warp-player x y)
     ($ (grid-ref grid x y) player)
@@ -166,6 +175,9 @@
 
   ;; TODO: actually write levels
   (warp-player 10 8)
+
+  ($ (grid-ref grid 3 7) (spawn ^exit))
+
   ($ (grid-ref grid 4 4) (spawn ^wall 'brick))
 
   ($ (grid-ref grid 4 3) (spawn ^clock-emitter 3))
@@ -198,9 +210,11 @@
                        (refr ($ refr 'describe))))))
        grid*))
     (('move-player dir)
-     (match dir
-       ('up (move-player 0 -1))
-       ('down (move-player 0 1))
-       ('left (move-player -1 0))
-       ('right (move-player 1 0)))
-     (tick))))
+     (define result
+       (match dir
+         ('up (move-player 0 -1))
+         ('down (move-player 0 1))
+         ('left (move-player -1 0))
+         ('right (move-player 1 0))))
+     (tick)
+     result)))