Big actor refactor; use local storage for auto-save.

game.scm

@@ -36,6 +36,7 @@
              (hoot ffi)
              (hoot hashtables)
              (ice-9 match)
+             (local-storage)
              (math)
              (math rect)
              (math vector))
@@ -84,7 +85,7 @@
 (define *level-idx* #f)
 (define *level* #f)
 ;; Latest representation of all actors in level
-(define *grid* #f)
+(define *objects* #f)
 
 (define *snapshots* '())
 (define (clear-snapshots!)
@@ -99,38 +100,73 @@
      (set! *snapshots* older-snapshots)
      (media-play audio:undo))))
 
-(define (update-grid!)
-  (set! *grid* ($ (level-actor *level*) 'describe)))
+(define (update-objects!)
+  (set! *objects*
+        ;; TODO: Receive layer for sprite sorting
+        (map (match-lambda
+               ((type #(x y) . properties)
+                `(,type ,(vec2 (* x tile-width) (* y tile-height)) ,@properties)))
+             ($ (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!)
+(define (load-level! idx)
   (set! *state* 'play)
   (set! *actormap* (make-whactormap))
   (clear-snapshots!)
-  (set! *level-idx* -1)
   (with-goblins
-   (next-level!)
-   (update-grid!)))
+   (set! *level* ((vector-ref levels idx)))
+   (update-objects!)))
+
+(define (next-level!)
+  (let ((idx (+ *level-idx* 1)))
+    (pk 'next-level idx)
+    (set! *level-idx* idx)
+    (if (< idx (vector-length levels))
+        (begin
+          (save-game!)
+          (load-level! idx))
+        (set! *state* 'win))))
+
+;; Auto-save/load to local storage.
+(define (save-game!)
+  (pk 'save)
+  (local-storage-set! "cirkoban-level" (number->string *level-idx*)))
+
+(define (load-game!)
+  (set! *level-idx*
+        (match (local-storage-ref "cirkoban-level")
+          ("" 0)
+          (str (string->number str))))
+  (pk 'load *level-idx*)
+  (load-level! *level-idx*))
+
+(define (reset-game!)
+  (set! *level-idx* 0)
+  (save-game!)
+  (load-level! 0))
 
 ;; Update loop
 (define (move-player dir)
+  (define (do-move)
+    (with-goblins
+     ($ (level-player *level*) 'move dir)
+     ($ (level-actor *level*) 'tick)
+     (define result
+       (match (pk 'event ($ (level-player *level*) 'event))
+         (('bump)
+          (media-play audio:bump)
+          #f)
+         (('push)
+          (media-play audio:push)
+          #f)
+         (('exit)
+          (media-play audio:exit)
+          'next-level)
+         (_ #f)))
+     (update-objects!)
+     result))
   (save-snapshot!)
-  (with-goblins
-   (match ($ (level-actor *level*) 'move-player dir)
-     ('bump (media-play audio:bump))
-     ('push (media-play audio:push))
-     ('exit
-      (media-play audio:exit)
-      (next-level!))
-     (_ #f))
-   (update-grid!)))
+  (when (eq? (do-move) 'next-level)
+    (next-level!)))
 
 (define dt (/ 1000.0 60.0)) ; aim for updating at 60Hz
 (define (update)
@@ -147,50 +183,51 @@
             (hashtable-set! cache x str)
             str)))))
 
-(define (draw-player x y)
-  (draw-tile context tileset 0 x y))
+(define (draw-player pos)
+  (draw-tile context tileset 0 (vec2-x pos) (vec2-y pos)))
 
-(define (draw-exit x y)
-  (draw-tile context tileset 27 x y))
+(define (draw-exit pos)
+  (draw-tile context tileset 27 (vec2-x pos) (vec2-y pos)))
 
-(define (draw-wall type x y)
-  (match type
-    ('brick
-     (draw-tile context tileset 22 x y))
-    (_
-     (draw-tile context tileset 2 x y)))
-  (match type
-    ('electron-head
-     (draw-tile context tileset 4 x y))
-    ('electron-tail
-     (draw-tile context tileset 5 x y))
-    (_ #f)))
+(define (draw-wall type pos)
+  (let ((x (vec2-x pos))
+        (y (vec2-y pos)))
+    (match type
+      ('brick
+       (draw-tile context tileset 22 x y))
+      (_
+       (draw-tile context tileset 2 x y)))
+    (match type
+      ('electron-head
+       (draw-tile context tileset 4 x y))
+      ('electron-tail
+       (draw-tile context tileset 5 x y))
+      (_ #f))))
 
-(define (draw-block type 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))
-    ('electron-tail
-     (draw-tile context tileset 5 x y))
-    (_ #f)))
+(define (draw-block type pos)
+  (let ((x (vec2-x pos))
+        (y (vec2-y pos)))
+    (match type
+      ('crate (draw-tile context tileset 29 x y))
+      (_ (draw-tile context tileset 3 x y)))
+    (match type
+      ('electron-head
+       (draw-tile context tileset 4 x y))
+      ('electron-tail
+       (draw-tile context tileset 5 x y))
+      (_ #f))))
 
-(define (draw-clock-emitter x y)
-  (draw-tile context tileset 48 x y))
+(define (draw-clock-emitter pos)
+  (draw-tile context tileset 48 (vec2-x pos) (vec2-y pos)))
 
-(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))
-           (('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))))))
+(define (draw-object obj)
+  (match obj
+    (#f #f)
+    (('player pos) (draw-player pos))
+    (('exit pos) (draw-exit pos))
+    (('wall pos type) (draw-wall type pos))
+    (('block pos type) (draw-block type pos))
+    (('clock-emitter pos) (draw-clock-emitter pos))))
 
 (define (draw-background)
   (let* ((bv (level-background *level*))
@@ -205,14 +242,7 @@
 
 (define (draw-level)
   (draw-background)
-  (let ((grid *grid*))
-    (let y-loop ((y 0))
-      (when (< y level-height)
-        (let x-loop ((x 0))
-          (when (< x level-width)
-            (draw-object x y (vector-ref grid (+ (* y level-width) x)))
-            (x-loop (1+ x))))
-        (y-loop (1+ y))))))
+  (for-each draw-object *objects*))
 
 (define (draw-win)
   (set-fill-color! context "#x000000")
@@ -252,9 +282,7 @@
          (move-player 'down))
         ((string=? key key:undo)
          (rollback-snapshot!)
-         (with-goblins (update-grid!)))
-        ((string=? key key:confirm)
-         (reset-game!))))
+         (with-goblins (update-objects!)))))
       ('win
        (cond
         ((string=? key key:confirm)
@@ -290,4 +318,4 @@
 (resize-canvas)
 (request-animation-frame draw-callback)
 (timeout update-callback dt)
-(reset-game!)
+(load-game!)