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

Pack and parse wall data from map files.

Browse source
This commit is contained in:
David Thompson 2024-05-19 18:12:30 -04:00
parent 3a3f4e31a1
commit f3ad31d244
5 changed files with 61 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
game.scm
View file

@ -177,7 +177,7 @@
(when (< i len) (when (< i len)
(let ((x (bytevector-ieee-single-native-ref bv i)) (let ((x (bytevector-ieee-single-native-ref bv i))
(y (bytevector-ieee-single-native-ref bv (+ i 4))) (y (bytevector-ieee-single-native-ref bv (+ i 4)))
(idx (bytevector-s16-native-ref bv (+ i 8)))) (idx (bytevector-u16-native-ref bv (+ i 8))))
(draw-tile context tileset idx x y) (draw-tile context tileset idx x y)
(lp (+ i 10))))))) (lp (+ i 10)))))))

17
modules/game/actors.scm
View file

@ -1,5 +1,6 @@
(define-module (game actors) (define-module (game actors)
#:use-module (goblins core) #:use-module (goblins core)
#:use-module (hoot bytevectors)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (^cell #:export (^cell
^level)) ^level))
@ -67,7 +68,7 @@
(('wire-state) #f) (('wire-state) #f)
(('describe) '(player)))) (('describe) '(player))))
(define (^level bcom width height) (define (^level bcom width height objects)
(define player (spawn ^player)) (define player (spawn ^player))
(define player-coords (spawn ^cell)) (define player-coords (spawn ^cell))
(define (make-grid) (define (make-grid)
@ -176,9 +177,19 @@
;; TODO: actually write levels ;; TODO: actually write levels
(warp-player 10 8) (warp-player 10 8)
($ (grid-ref grid 3 7) (spawn ^exit)) ;; Parsed packed object data and spawn objects.
(let ((len (bytevector-length objects)))
(let lp ((i 0))
(when (< i len)
(let ((x (bytevector-u8-ref objects i))
(y (bytevector-u8-ref objects (+ i 1)))
(obj (match (bytevector-u8-ref objects (+ i 2))
(1 (spawn ^wall 'brick))
(id (error "invalid level object" id)))))
($ (grid-ref grid x y) obj))
(lp (+ i 3)))))
($ (grid-ref grid 4 4) (spawn ^wall 'brick)) ($ (grid-ref grid 3 7) (spawn ^exit))
($ (grid-ref grid 4 3) (spawn ^clock-emitter 3)) ($ (grid-ref grid 4 3) (spawn ^clock-emitter 3))
($ (grid-ref grid 5 3) (spawn ^wall 'copper)) ($ (grid-ref grid 5 3) (spawn ^wall 'copper))

30
modules/game/levels/level-1.tmx
View file

@ -3,21 +3,21 @@
<tileset firstgid="1" source="tiles.tsx"/> <tileset firstgid="1" source="tiles.tsx"/>
<layer id="1" name="background" width="20" height="15"> <layer id="1" name="background" width="20" height="15">
<data encoding="csv"> <data encoding="csv">
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, 23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, 23,23,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,23,23,23,
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, 23,23,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,23,23,
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, 23,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,23,
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, 23,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,23,
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, 23,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,23,
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, 23,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,23,
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, 23,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,23,
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, 23,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,23,
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, 23,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,23,
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, 23,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,23,
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, 23,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,23,
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, 23,23,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,23,23,
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, 23,23,23,24,24,24,24,24,24,24,24,24,24,24,24,24,24,23,23,23,
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24 23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23
</data> </data>
</layer> </layer>
</map> </map>

5
modules/game/levels/tiles.tsx
View file

@ -1,4 +1,9 @@
<?xml version="1.0" encoding="UTF-8"?> <?xml version="1.0" encoding="UTF-8"?>
<tileset version="1.8" tiledversion="1.8.6" name="tiles" tilewidth="16" tileheight="16" tilecount="300" columns="20"> <tileset version="1.8" tiledversion="1.8.6" name="tiles" tilewidth="16" tileheight="16" tilecount="300" columns="20">
<image source="../../../assets/images/cirkoban.png" width="320" height="240"/> <image source="../../../assets/images/cirkoban.png" width="320" height="240"/>
<tile id="22">
<properties>
<property name="wall" type="bool" value="true"/>
</properties>
</tile>
</tileset> </tileset>

33
scripts/compile-map.scm
View file

@ -349,6 +349,11 @@ the default ORIENTATION value of 'orthogonal' is supported."
(define (first-gid node) (define (first-gid node)
(attr node 'firstgid string->number)) (attr node 'firstgid string->number))
(define (parse-tileset node first-gid) (define (parse-tileset node first-gid)
(define (parse-custom-tile node)
(let ((id (attr node 'id string->number))
(properties (map parse-property
((sxpath '(properties property)) node))))
`(,id . ((properties . ,properties)))))
(let* ((name (attr node 'name)) (let* ((name (attr node 'name))
(tile-width (attr node 'tilewidth string->number)) (tile-width (attr node 'tilewidth string->number))
(tile-height (attr node 'tileheight string->number)) (tile-height (attr node 'tileheight string->number))
@ -356,14 +361,15 @@ the default ORIENTATION value of 'orthogonal' is supported."
(spacing (or (attr node 'spacing string->number) 0)) (spacing (or (attr node 'spacing string->number) 0))
(image (parse-image ((sxpath '(image)) node))) (image (parse-image ((sxpath '(image)) node)))
(properties (map parse-property (properties (map parse-property
((sxpath '(properties property)) node)))) ((sxpath '(properties property)) node)))
(custom-tiles (map parse-custom-tile ((sxpath '(tile)) node))))
(make-tileset image tile-width tile-height (make-tileset image tile-width tile-height
#:margin margin #:margin margin
#:spacing spacing #:spacing spacing
#:name name #:name name
#:first-gid first-gid #:first-gid first-gid
#:properties properties #:properties properties
#:custom-tiles '()))) #:custom-tiles custom-tiles)))
(define (parse-external-tileset node) (define (parse-external-tileset node)
(let* ((first-gid (attr node 'firstgid string->number)) (let* ((first-gid (attr node 'firstgid string->number))
(source (scope (attr node 'source))) (source (scope (attr node 'source)))
@ -530,18 +536,26 @@ the default ORIENTATION value of 'orthogonal' is supported."
(let ((bv (make-bytevector 10))) (let ((bv (make-bytevector 10)))
(bytevector-ieee-single-native-set! bv 0 (* x tw)) (bytevector-ieee-single-native-set! bv 0 (* x tw))
(bytevector-ieee-single-native-set! bv 4 (* y th)) (bytevector-ieee-single-native-set! bv 4 (* y th))
(bytevector-s16-native-set! bv 8 (tile-id (map-tile-ref tile))) (bytevector-u16-native-set! bv 8 (tile-id (map-tile-ref tile)))
bv)))) bv))))
(iota (tile-layer-width layer)))) (iota (tile-layer-width layer))))
(iota (tile-layer-height layer)))))) (iota (tile-layer-height layer))))))
(define (compile-collision-layer layer) (define (compile-walls 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)))
(u8-list->bytevector (u8-list->bytevector
(append-map (lambda (y) (append-map (lambda (y)
(map (lambda (x) (concatenate
(if (tile-layer-ref layer x y) 1 0)) (filter-map (lambda (x)
(iota (tile-layer-width layer)))) (match (tile-layer-ref layer x y)
(iota (tile-layer-height layer))))) (#f #f)
(tile
(and (assq-ref (tile-properties (map-tile-ref tile)) 'wall)
(list x y 1)))))
(iota (tile-layer-width layer)))))
(iota (tile-layer-height layer))))))
(define (compile-object-layer tile-map layer) (define (compile-object-layer tile-map layer)
(let ((table (make-hash-table)) (let ((table (make-hash-table))
@ -584,5 +598,6 @@ the default ORIENTATION value of 'orthogonal' is supported."
(values ,(compile-tile-layer tile-map "background") (values ,(compile-tile-layer tile-map "background")
(spawn ^level (spawn ^level
,(tile-map-width tile-map) ,(tile-map-width tile-map)
,(tile-map-height tile-map)))))))) ,(tile-map-height tile-map)
,(compile-walls tile-map "background"))))))))
(_ (error "file name expected"))) (_ (error "file name expected")))