Add basic undo with Z key.

game.scm

@@ -26,6 +26,7 @@
              (dom media)
              (dom window)
              (game actors)
+             (game tileset)
              (goblins core)
              (hoot ffi)
              (hoot hashtables)
@@ -45,7 +46,11 @@
 (define *canvas-width* 0)
 (define *canvas-height* 0)
 
-(define image:tiles (make-image "assets/images/cirkoban.png"))
+(define tileset
+  (make-tileset (make-image "assets/images/cirkoban.png")
+                320 240
+                (inexact->exact tile-width)
+                (inexact->exact tile-height)))
 
 ;; Game state
 (define *actormap* (make-whactormap))
@@ -63,6 +68,12 @@
   (set! *snapshots* '()))
 (define (save-snapshot!)
   (set! *snapshots* (cons (copy-whactormap *actormap*) *snapshots*)))
+(define (rollback-snapshot!)
+  (match *snapshots*
+    (() #f)
+    ((snapshot . older-snapshots)
+     (set! *actormap* snapshot)
+     (set! *snapshots* older-snapshots))))
 
 (define (update-grid!)
   (set! *grid* ($ *level* 'describe)))
@@ -76,11 +87,10 @@
 
 ;; Update loop
 (define (move-player dir)
+  (save-snapshot!)
   (with-goblins
    ($ *level* 'move-player dir)
-   (update-grid!))
-  ;; (save-snapshot!)
-  )
+   (update-grid!)))
 
 (define dt (/ 1000.0 60.0)) ; aim for updating at 60Hz
 (define (update)
@@ -98,58 +108,43 @@
             str)))))
 
 (define (draw-player x y)
-  (draw-image context image:tiles
-              0.0 0.0 tile-width tile-height
-              (* x tile-width) (* y tile-height) tile-width tile-height))
+  (draw-tile context tileset 0 x y))
 
 (define (draw-wall type x y)
   (match type
     ('brick
-     (draw-image context image:tiles
-                 32.0 16.0 tile-width tile-height
-                 (* x tile-width) (* y tile-height) tile-width tile-height))
+     (draw-tile context tileset 22 x y))
     (_
-     (draw-image context image:tiles
-                 48.0 0.0 tile-width tile-height
-                 (* x tile-width) (* y tile-height) tile-width tile-height)))
+     (draw-tile context tileset 2 x y)))
   (match type
     ('electron-head
-     (draw-image context image:tiles
-                 64.0 0.0 tile-width tile-height
-                 (* x tile-width) (* y tile-height) tile-width tile-height))
+     (draw-tile context tileset 4 x y))
     ('electron-tail
-     (draw-image context image:tiles
-                 80.0 0.0 tile-width tile-height
-                 (* x tile-width) (* y tile-height) tile-width tile-height))
+     (draw-tile context tileset 5 x y))
     (_ #f)))
 
 (define (draw-block type x y)
-  (draw-image context image:tiles
-              32.0 0.0 tile-width tile-height
-              (* x tile-width) (* y tile-height) tile-width tile-height)
+  (draw-tile context tileset 3 x y)
   (match type
     ('electron-head
-     (draw-image context image:tiles
-                 64.0 0.0 tile-width tile-height
-                 (* x tile-width) (* y tile-height) tile-width tile-height))
+     (draw-tile context tileset 4 x y))
     ('electron-tail
-     (draw-image context image:tiles
-                 80.0 0.0 tile-width tile-height
-                 (* x tile-width) (* y tile-height) tile-width tile-height))
+     (draw-tile context tileset 5 x y))
     (_ #f)))
 
 (define (draw-clock-emitter x y)
-  (draw-image context image:tiles
-              48.0 0.0 tile-width tile-height
-              (* x tile-width) (* y tile-height) tile-width tile-height))
+  (draw-tile context tileset 2 x y))
 
-(define (draw-tile x y obj)
-  (match obj
-    (#f #f)
-    (('player) (draw-player x y))
-    (('wall type) (draw-wall type x y))
-    (('block type) (draw-block type x y))
-    (('clock-emitter) (draw-clock-emitter x y))))
+(define (draw-object x y obj)
+  (and obj
+       (let ((x (* x tile-width))
+             (y (* y tile-height)))
+         (match obj
+           (#f #f)
+           (('player) (draw-player x y))
+           (('wall type) (draw-wall type x y))
+           (('block type) (draw-block type x y))
+           (('clock-emitter) (draw-clock-emitter x y))))))
 
 (define (draw-level)
   (let ((grid *grid*))
@@ -157,7 +152,7 @@
       (when (< y level-height)
         (let x-loop ((x 0))
           (when (< x level-width)
-            (draw-tile x y (vector-ref grid (+ (* y level-width) x)))
+            (draw-object x y (vector-ref grid (+ (* y level-width) x)))
             (x-loop (1+ x))))
         (y-loop (1+ y))))))
 
@@ -177,6 +172,7 @@
 (define key:down "ArrowDown")
 (define key:up "ArrowUp")
 (define key:confirm "Enter")
+(define key:undo "KeyZ")
 
 (define (on-key-down event)
   (let ((key (keyboard-event-code event)))
@@ -188,7 +184,10 @@
      ((string=? key key:up)
       (move-player 'up))
      ((string=? key key:down)
-      (move-player 'down)))))
+      (move-player 'down))
+     ((string=? key key:undo)
+      (rollback-snapshot!)
+      (with-goblins (update-grid!))))))
 
 (define (on-key-up event)
   (let ((key (keyboard-event-code event)))