Reduce size of exported maps.

Makefile

@@ -45,4 +45,4 @@ bundle: game.wasm
 	zip cirkoban.zip -r assets/ reflect.js game.js game.css reflect.wasm wtf8.wasm game.wasm index.html
 
 clean:
-	rm -f game.wasm game.zip
+	rm -f game.wasm game.zip $(levels)

game.scm

@@ -44,8 +44,6 @@
 
 (define game-width 320.0)
 (define game-height 240.0)
-(define tile-width 16.0)
-(define tile-height 16.0)
 (define level-width (inexact->exact (floor (/ game-width tile-width))))
 (define level-height (inexact->exact (floor (/ game-height tile-height))))
 
@@ -324,15 +322,14 @@
     (('electric-switch pos on?) (draw-electric-switch pos on?))))
 
 (define (draw-background)
-  (let* ((bv (level-background *level*))
-         (len (bytevector-length bv)))
-    (let lp ((i 0))
-      (when (< i len)
-        (let ((x (bytevector-ieee-single-native-ref bv i))
-              (y (bytevector-ieee-single-native-ref bv (+ i 4)))
-              (idx (bytevector-u16-native-ref bv (+ i 8))))
-          (draw-tile context tileset idx x y)
-          (lp (+ i 10)))))))
+  (let ((bg (level-background *level*))
+        (k (* level-width level-height)))
+    (do ((i 0 (1+ i)))
+        ((= i k))
+      (let* ((tile (vector-ref bg i))
+             (pos (level-tile-position tile))
+             (id (level-tile-id tile)))
+        (draw-tile context tileset id (vec2-x pos) (vec2-y pos))))))
 
 (define (draw-level)
   (draw-background)

modules/game/level.scm

@@ -3,13 +3,31 @@
   #:use-module (goblins core)
   #:use-module (hoot bytevectors)
   #:use-module (ice-9 match)
+  #:use-module (math vector)
   #:use-module (srfi srfi-9)
-  #:export (make-level
+  #:export (tile-width
+            tile-height
+
+            <level-tile>
+            level-tile?
+            level-tile-position
+            level-tile-id
+
+            make-level
             level?
             level-background
             level-actor
             level-player))
 
+(define tile-width 16.0)
+(define tile-height 16.0)
+
+(define-record-type <level-tile>
+  (make-level-tile position id)
+  level-tile?
+  (position level-tile-position)
+  (id level-tile-id))
+
 ;; Client-side rendering info coupled with level actor that contains
 ;; game state.
 (define-record-type <level>
@@ -21,11 +39,23 @@
 
 (define (make-level width height background objects spawn-gem?)
   (let ((level* (spawn ^level width height))
-        (len (bytevector-length objects)))
-    ;; Parsed packed object data and spawn objects, making special
+        (background* (make-vector (* width height))))
+    ;; Unpack background tile data.
+    (let y-loop ((y 0))
+      (when (< y height)
+        (let x-loop ((x 0))
+          (when (< x width)
+            (let* ((i (+ (* y width) x))
+                   (pos (vec2 (* x tile-width) (* y tile-height)))
+                   (id (bytevector-u16-native-ref background (* i 2)))
+                   (tile (make-level-tile pos id)))
+              (vector-set! background* i tile))
+            (x-loop (1+ x))))
+        (y-loop (1+ y))))
+    ;; Unpack object data and spawn objects, making special
     ;; note of the player.
     (let lp ((i 0) (player #f))
-      (if (< i len)
+      (if (< i (bytevector-length objects))
           (let* ((x (bytevector-u8-ref objects i))
                  (y (bytevector-u8-ref objects (+ i 1)))
                  (id (bytevector-u8-ref objects (+ i 2)))
@@ -58,4 +88,4 @@
             (if (= id 3)                ; player-spawn
                 (lp i* obj)
                 (lp i* player)))
-          (%make-level background level* player)))))
+          (%make-level background* level* player)))))

scripts/compile-map.scm

@@ -528,22 +528,24 @@ the default ORIENTATION value of 'orthogonal' is supported."
            (bytevector-copy! bv 0 new-bv offset len)
            (loop rest (+ offset len))))))))
 
+;; Not a sparse layer packing.  Assumes all tiles have something in
+;; them.
 (define (compile-tile-layer tile-map layer-name)
-  (let ((tw (tile-map-tile-width tile-map))
-        (th (tile-map-tile-height tile-map))
-        (layer (tile-map-layer-ref tile-map layer-name)))
-    (bytevector-concat
-     (append-map (lambda (y)
-                   (filter-map (lambda (x)
+  (let* ((layer (tile-map-layer-ref tile-map layer-name))
+         (w (tile-layer-width layer))
+         (h (tile-layer-height layer))
+         (bv (make-u16vector (* w h))))
+    (let y-loop ((y 0))
+      (when (< y h)
+        (let x-loop ((x 0))
+          (when (< x w)
             (let ((tile (tile-layer-ref layer x y)))
-                                   (and tile
-                                        (let ((bv (make-bytevector 10)))
-                                          (bytevector-ieee-single-native-set! bv 0 (* x tw))
-                                          (bytevector-ieee-single-native-set! bv 4 (* y th))
-                                          (bytevector-u16-native-set! bv 8 (tile-id (map-tile-ref tile)))
-                                          bv))))
-                               (iota (tile-layer-width layer))))
-                 (iota (tile-layer-height layer))))))
+              (bytevector-u16-set! bv (* (+ (* y w) x) 2)
+                                   (tile-id (map-tile-ref tile))
+                                   (endianness little)))
+            (x-loop (1+ x))))
+        (y-loop (1+ y))))
+    bv))
 
 (define obj:wall:brick 1)
 (define obj:wall:copper 2)