Reduce size of exported maps.

This commit is contained in:
David Thompson 2024-05-22 14:22:27 -04:00
parent f1afd9e177
commit 793a9ef027
4 changed files with 62 additions and 33 deletions

View file

@ -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)

View file

@ -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)

View file

@ -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)))))

View file

@ -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)