SuperKamiGuru/foss-mmo
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Reduce size of exported maps.

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Makefile
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 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
View file

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

42
modules/game/level.scm
View file

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

32
scripts/compile-map.scm
View file

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