Pack and parse wall data from map files.
This commit is contained in:
David Thompson
parent
3a3f4e31a1
commit
f3ad31d244
5 changed files with 61 additions and 30 deletions
2
game.scm
2
game.scm
|
|
@ -177,7 +177,7 @@
|
|||
(when (< i len)
|
||||
(let ((x (bytevector-ieee-single-native-ref bv i))
|
||||
(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)
|
||||
(lp (+ i 10)))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
(define-module (game actors)
|
||||
#:use-module (goblins core)
|
||||
#:use-module (hoot bytevectors)
|
||||
#:use-module (ice-9 match)
|
||||
#:export (^cell
|
||||
^level))
|
||||
|
|
@ -67,7 +68,7 @@
|
|||
(('wire-state) #f)
|
||||
(('describe) '(player))))
|
||||
|
||||
(define (^level bcom width height)
|
||||
(define (^level bcom width height objects)
|
||||
(define player (spawn ^player))
|
||||
(define player-coords (spawn ^cell))
|
||||
(define (make-grid)
|
||||
|
|
@ -176,9 +177,19 @@
|
|||
;; TODO: actually write levels
|
||||
(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 5 3) (spawn ^wall 'copper))
|
||||
|
|
|
|||
|
|
@ -3,21 +3,21 @@
|
|||
<tileset firstgid="1" source="tiles.tsx"/>
|
||||
<layer id="1" name="background" width="20" height="15">
|
||||
<data encoding="csv">
|
||||
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,
|
||||
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,
|
||||
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,
|
||||
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,
|
||||
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,
|
||||
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,
|
||||
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,
|
||||
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,
|
||||
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,
|
||||
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,
|
||||
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,
|
||||
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,
|
||||
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,
|
||||
24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,
|
||||
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,
|
||||
23,23,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,23,23,23,
|
||||
23,23,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,24,24,24,24,23,
|
||||
23,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,24,24,23,
|
||||
23,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,24,24,23,
|
||||
23,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,24,24,23,
|
||||
23,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,24,24,23,
|
||||
23,23,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,23,23,
|
||||
23,23,23,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,23,23,23
|
||||
</data>
|
||||
</layer>
|
||||
</map>
|
||||
|
|
|
|||
|
|
@ -1,4 +1,9 @@
|
|||
<?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">
|
||||
<image source="../../../assets/images/cirkoban.png" width="320" height="240"/>
|
||||
<tile id="22">
|
||||
<properties>
|
||||
<property name="wall" type="bool" value="true"/>
|
||||
</properties>
|
||||
</tile>
|
||||
</tileset>
|
||||
|
|
|
|||
|
|
@ -349,6 +349,11 @@ the default ORIENTATION value of 'orthogonal' is supported."
|
|||
(define (first-gid node)
|
||||
(attr node 'firstgid string->number))
|
||||
(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))
|
||||
(tile-width (attr node 'tilewidth 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))
|
||||
(image (parse-image ((sxpath '(image)) node)))
|
||||
(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
|
||||
#:margin margin
|
||||
#:spacing spacing
|
||||
#:name name
|
||||
#:first-gid first-gid
|
||||
#:properties properties
|
||||
#:custom-tiles '())))
|
||||
#:custom-tiles custom-tiles)))
|
||||
(define (parse-external-tileset node)
|
||||
(let* ((first-gid (attr node 'firstgid string->number))
|
||||
(source (scope (attr node 'source)))
|
||||
|
|
@ -530,18 +536,26 @@ the default ORIENTATION value of 'orthogonal' is supported."
|
|||
(let ((bv (make-bytevector 10)))
|
||||
(bytevector-ieee-single-native-set! bv 0 (* x tw))
|
||||
(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))))
|
||||
(iota (tile-layer-width 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
|
||||
(append-map (lambda (y)
|
||||
(map (lambda (x)
|
||||
(if (tile-layer-ref layer x y) 1 0))
|
||||
(iota (tile-layer-width layer))))
|
||||
(iota (tile-layer-height layer)))))
|
||||
(concatenate
|
||||
(filter-map (lambda (x)
|
||||
(match (tile-layer-ref layer x y)
|
||||
(#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)
|
||||
(let ((table (make-hash-table))
|
||||
|
|
@ -584,5 +598,6 @@ the default ORIENTATION value of 'orthogonal' is supported."
|
|||
(values ,(compile-tile-layer tile-map "background")
|
||||
(spawn ^level
|
||||
,(tile-map-width tile-map)
|
||||
,(tile-map-height tile-map))))))))
|
||||
,(tile-map-height tile-map)
|
||||
,(compile-walls tile-map "background"))))))))
|
||||
(_ (error "file name expected")))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue