Reduce size of exported maps.

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)))
@@ -55,7 +85,7 @@
                             (_ 3)))))
             (when obj
               ($ level* 'add-object obj))
-            (if (= id 3)               ; player-spawn
+            (if (= id 3)                ; player-spawn
                 (lp i* obj)
                 (lp i* player)))
-          (%make-level background level* player)))))
+          (%make-level background* level* player)))))