Reduce size of exported maps.
This commit is contained in:
parent
f1afd9e177
commit
793a9ef027
4 changed files with 62 additions and 33 deletions
2
Makefile
2
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
|
zip cirkoban.zip -r assets/ reflect.js game.js game.css reflect.wasm wtf8.wasm game.wasm index.html
|
||||||
|
|
||||||
clean:
|
clean:
|
||||||
rm -f game.wasm game.zip
|
rm -f game.wasm game.zip $(levels)
|
||||||
|
|
19
game.scm
19
game.scm
|
@ -44,8 +44,6 @@
|
||||||
|
|
||||||
(define game-width 320.0)
|
(define game-width 320.0)
|
||||||
(define game-height 240.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-width (inexact->exact (floor (/ game-width tile-width))))
|
||||||
(define level-height (inexact->exact (floor (/ game-height tile-height))))
|
(define level-height (inexact->exact (floor (/ game-height tile-height))))
|
||||||
|
|
||||||
|
@ -324,15 +322,14 @@
|
||||||
(('electric-switch pos on?) (draw-electric-switch pos on?))))
|
(('electric-switch pos on?) (draw-electric-switch pos on?))))
|
||||||
|
|
||||||
(define (draw-background)
|
(define (draw-background)
|
||||||
(let* ((bv (level-background *level*))
|
(let ((bg (level-background *level*))
|
||||||
(len (bytevector-length bv)))
|
(k (* level-width level-height)))
|
||||||
(let lp ((i 0))
|
(do ((i 0 (1+ i)))
|
||||||
(when (< i len)
|
((= i k))
|
||||||
(let ((x (bytevector-ieee-single-native-ref bv i))
|
(let* ((tile (vector-ref bg i))
|
||||||
(y (bytevector-ieee-single-native-ref bv (+ i 4)))
|
(pos (level-tile-position tile))
|
||||||
(idx (bytevector-u16-native-ref bv (+ i 8))))
|
(id (level-tile-id tile)))
|
||||||
(draw-tile context tileset idx x y)
|
(draw-tile context tileset id (vec2-x pos) (vec2-y pos))))))
|
||||||
(lp (+ i 10)))))))
|
|
||||||
|
|
||||||
(define (draw-level)
|
(define (draw-level)
|
||||||
(draw-background)
|
(draw-background)
|
||||||
|
|
|
@ -3,13 +3,31 @@
|
||||||
#:use-module (goblins core)
|
#:use-module (goblins core)
|
||||||
#:use-module (hoot bytevectors)
|
#:use-module (hoot bytevectors)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
|
#:use-module (math vector)
|
||||||
#:use-module (srfi srfi-9)
|
#: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?
|
||||||
level-background
|
level-background
|
||||||
level-actor
|
level-actor
|
||||||
level-player))
|
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
|
;; Client-side rendering info coupled with level actor that contains
|
||||||
;; game state.
|
;; game state.
|
||||||
(define-record-type <level>
|
(define-record-type <level>
|
||||||
|
@ -21,11 +39,23 @@
|
||||||
|
|
||||||
(define (make-level width height background objects spawn-gem?)
|
(define (make-level width height background objects spawn-gem?)
|
||||||
(let ((level* (spawn ^level width height))
|
(let ((level* (spawn ^level width height))
|
||||||
(len (bytevector-length objects)))
|
(background* (make-vector (* width height))))
|
||||||
;; Parsed packed object data and spawn objects, making special
|
;; 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.
|
;; note of the player.
|
||||||
(let lp ((i 0) (player #f))
|
(let lp ((i 0) (player #f))
|
||||||
(if (< i len)
|
(if (< i (bytevector-length objects))
|
||||||
(let* ((x (bytevector-u8-ref objects i))
|
(let* ((x (bytevector-u8-ref objects i))
|
||||||
(y (bytevector-u8-ref objects (+ i 1)))
|
(y (bytevector-u8-ref objects (+ i 1)))
|
||||||
(id (bytevector-u8-ref objects (+ i 2)))
|
(id (bytevector-u8-ref objects (+ i 2)))
|
||||||
|
@ -55,7 +85,7 @@
|
||||||
(_ 3)))))
|
(_ 3)))))
|
||||||
(when obj
|
(when obj
|
||||||
($ level* 'add-object obj))
|
($ level* 'add-object obj))
|
||||||
(if (= id 3) ; player-spawn
|
(if (= id 3) ; player-spawn
|
||||||
(lp i* obj)
|
(lp i* obj)
|
||||||
(lp i* player)))
|
(lp i* player)))
|
||||||
(%make-level background level* player)))))
|
(%make-level background* level* player)))))
|
||||||
|
|
|
@ -528,22 +528,24 @@ the default ORIENTATION value of 'orthogonal' is supported."
|
||||||
(bytevector-copy! bv 0 new-bv offset len)
|
(bytevector-copy! bv 0 new-bv offset len)
|
||||||
(loop rest (+ 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)
|
(define (compile-tile-layer tile-map layer-name)
|
||||||
(let ((tw (tile-map-tile-width tile-map))
|
(let* ((layer (tile-map-layer-ref tile-map layer-name))
|
||||||
(th (tile-map-tile-height tile-map))
|
(w (tile-layer-width layer))
|
||||||
(layer (tile-map-layer-ref tile-map layer-name)))
|
(h (tile-layer-height layer))
|
||||||
(bytevector-concat
|
(bv (make-u16vector (* w h))))
|
||||||
(append-map (lambda (y)
|
(let y-loop ((y 0))
|
||||||
(filter-map (lambda (x)
|
(when (< y h)
|
||||||
(let ((tile (tile-layer-ref layer x y)))
|
(let x-loop ((x 0))
|
||||||
(and tile
|
(when (< x w)
|
||||||
(let ((bv (make-bytevector 10)))
|
(let ((tile (tile-layer-ref layer x y)))
|
||||||
(bytevector-ieee-single-native-set! bv 0 (* x tw))
|
(bytevector-u16-set! bv (* (+ (* y w) x) 2)
|
||||||
(bytevector-ieee-single-native-set! bv 4 (* y th))
|
(tile-id (map-tile-ref tile))
|
||||||
(bytevector-u16-native-set! bv 8 (tile-id (map-tile-ref tile)))
|
(endianness little)))
|
||||||
bv))))
|
(x-loop (1+ x))))
|
||||||
(iota (tile-layer-width layer))))
|
(y-loop (1+ y))))
|
||||||
(iota (tile-layer-height layer))))))
|
bv))
|
||||||
|
|
||||||
(define obj:wall:brick 1)
|
(define obj:wall:brick 1)
|
||||||
(define obj:wall:copper 2)
|
(define obj:wall:copper 2)
|
||||||
|
|
Loading…
Add table
Reference in a new issue