diff --git a/game.scm b/game.scm index 7b5672f..7710269 100644 --- a/game.scm +++ b/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))))))) diff --git a/modules/game/actors.scm b/modules/game/actors.scm index 4a7b3d9..1a9b370 100644 --- a/modules/game/actors.scm +++ b/modules/game/actors.scm @@ -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)) diff --git a/modules/game/levels/level-1.tmx b/modules/game/levels/level-1.tmx index 3564841..0022c58 100644 --- a/modules/game/levels/level-1.tmx +++ b/modules/game/levels/level-1.tmx @@ -3,21 +3,21 @@ -24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, -24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, -24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, -24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, -24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, -24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, -24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, -24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, -24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, -24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, -24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, -24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, -24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24, -24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,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 diff --git a/modules/game/levels/tiles.tsx b/modules/game/levels/tiles.tsx index c0e26a3..2e52cd6 100644 --- a/modules/game/levels/tiles.tsx +++ b/modules/game/levels/tiles.tsx @@ -1,4 +1,9 @@ + + + + + diff --git a/scripts/compile-map.scm b/scripts/compile-map.scm index 2aee8be..7c83542 100644 --- a/scripts/compile-map.scm +++ b/scripts/compile-map.scm @@ -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")))