Pack and parse wall data from map files.

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

View file

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