Add level progression.

game.scm

@@ -28,6 +28,8 @@
              (game actors)
              (game level)
              (game levels level-1)
+             (game levels level-2)
+             (game levels level-3)
              (game tileset)
              (goblins core)
              (hoot bytevectors)
@@ -66,12 +68,20 @@
 (define audio:exit (load-sound-effect "exit"))
 
 ;; Game state
+(define *state* #f)
+
 (define *actormap* (make-whactormap))
 (define (call-with-goblins thunk)
   (actormap-churn-run! *actormap* thunk))
 (define-syntax-rule (with-goblins body ...)
   (call-with-goblins (lambda () body ...)))
 
+(define levels
+  (vector
+   load-level-1
+   load-level-2
+   load-level-3))
+(define *level-idx* #f)
 (define *level* #f)
 ;; Latest representation of all actors in level
 (define *grid* #f)
@@ -92,11 +102,21 @@
 (define (update-grid!)
   (set! *grid* ($ (level-actor *level*) 'describe)))
 
+(define (next-level!)
+  (clear-snapshots!)
+  (let ((idx (+ *level-idx* 1)))
+    (set! *level-idx* idx)
+    (if (< idx (vector-length levels))
+        (set! *level* ((vector-ref levels idx)))
+        (set! *state* 'win))))
+
 (define (reset-game!)
+  (set! *state* 'play)
   (set! *actormap* (make-whactormap))
   (clear-snapshots!)
+  (set! *level-idx* -1)
   (with-goblins
-   (set! *level* (load-level-1))
+   (next-level!)
    (update-grid!)))
 
 ;; Update loop
@@ -106,7 +126,9 @@
    (match ($ (level-actor *level*) 'move-player dir)
      ('bump (media-play audio:bump))
      ('push (media-play audio:push))
-     ('exit (media-play audio:exit))
+     ('exit
+      (media-play audio:exit)
+      (next-level!))
      (_ #f))
    (update-grid!)))
 
@@ -145,7 +167,9 @@
     (_ #f)))
 
 (define (draw-block type x y)
-  (draw-tile context tileset 3 x y)
+  (match type
+    ('crate (draw-tile context tileset 29 x y))
+    ('copper (draw-tile context tileset 3 x y)))
   (match type
     ('electron-head
      (draw-tile context tileset 4 x y))
@@ -190,11 +214,17 @@
             (x-loop (1+ x))))
         (y-loop (1+ y))))))
 
+(define (draw-win)
+  (set-fill-color! context "#x000000")
+  (fill-text context "OMG YOU DID IT WOW CONGRATS" 32.0 120.0))
+
 (define (draw prev-time)
   (clear-rect context 0.0 0.0 *canvas-width* *canvas-height*)
   (set-transform! context 1.0 0.0 0.0 1.0 0.0 0.0)
   (set-scale! context *canvas-scale* *canvas-scale*)
-  (draw-level)
+  (match *state*
+    ('play (draw-level))
+    ('win (draw-win)))
   (request-animation-frame draw-callback))
 (define draw-callback (procedure->external draw))
 
@@ -209,20 +239,26 @@
 (define (on-key-down event)
   (let ((key (keyboard-event-code event)))
     (pk 'key-down key)
-    (cond
-     ((string=? key key:left)
-      (move-player 'left))
-     ((string=? key key:right)
-      (move-player 'right))
-     ((string=? key key:up)
-      (move-player 'up))
-     ((string=? key key:down)
-      (move-player 'down))
-     ((string=? key key:undo)
-      (rollback-snapshot!)
-      (with-goblins (update-grid!)))
-     ((string=? key key:confirm)
-      (reset-game!)))))
+    (match *state*
+      ('play
+       (cond
+        ((string=? key key:left)
+         (move-player 'left))
+        ((string=? key key:right)
+         (move-player 'right))
+        ((string=? key key:up)
+         (move-player 'up))
+        ((string=? key key:down)
+         (move-player 'down))
+        ((string=? key key:undo)
+         (rollback-snapshot!)
+         (with-goblins (update-grid!)))
+        ((string=? key key:confirm)
+         (reset-game!))))
+      ('win
+       (cond
+        ((string=? key key:confirm)
+         (reset-game!)))))))
 
 ;; Canvas and event loop setup
 (define canvas (get-element-by-id "canvas"))