diff --git a/Makefile b/Makefile index 99f8388..5e8daf1 100644 --- a/Makefile +++ b/Makefile @@ -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 clean: - rm -f game.wasm game.zip + rm -f game.wasm game.zip $(levels) diff --git a/game.scm b/game.scm index d72b5ce..a150978 100644 --- a/game.scm +++ b/game.scm @@ -44,8 +44,6 @@ (define game-width 320.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-height (inexact->exact (floor (/ game-height tile-height)))) @@ -324,15 +322,14 @@ (('electric-switch pos on?) (draw-electric-switch pos on?)))) (define (draw-background) - (let* ((bv (level-background *level*)) - (len (bytevector-length bv))) - (let lp ((i 0)) - (when (< i len) - (let ((x (bytevector-ieee-single-native-ref bv i)) - (y (bytevector-ieee-single-native-ref bv (+ i 4))) - (idx (bytevector-u16-native-ref bv (+ i 8)))) - (draw-tile context tileset idx x y) - (lp (+ i 10))))))) + (let ((bg (level-background *level*)) + (k (* level-width level-height))) + (do ((i 0 (1+ i))) + ((= i k)) + (let* ((tile (vector-ref bg i)) + (pos (level-tile-position tile)) + (id (level-tile-id tile))) + (draw-tile context tileset id (vec2-x pos) (vec2-y pos)))))) (define (draw-level) (draw-background) diff --git a/modules/game/level.scm b/modules/game/level.scm index c165567..46b4114 100644 --- a/modules/game/level.scm +++ b/modules/game/level.scm @@ -3,13 +3,31 @@ #:use-module (goblins core) #:use-module (hoot bytevectors) #:use-module (ice-9 match) + #:use-module (math vector) #:use-module (srfi srfi-9) - #:export (make-level + #:export (tile-width + tile-height + + + level-tile? + level-tile-position + level-tile-id + + make-level level? level-background level-actor level-player)) +(define tile-width 16.0) +(define tile-height 16.0) + +(define-record-type + (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 ;; game state. (define-record-type @@ -21,11 +39,23 @@ (define (make-level width height background objects spawn-gem?) (let ((level* (spawn ^level width height)) - (len (bytevector-length objects))) - ;; Parsed packed object data and spawn objects, making special + (background* (make-vector (* width height)))) + ;; 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. (let lp ((i 0) (player #f)) - (if (< i len) + (if (< i (bytevector-length objects)) (let* ((x (bytevector-u8-ref objects i)) (y (bytevector-u8-ref objects (+ i 1))) (id (bytevector-u8-ref objects (+ i 2))) @@ -55,7 +85,7 @@ (_ 3))))) (when obj ($ level* 'add-object obj)) - (if (= id 3) ; player-spawn + (if (= id 3) ; player-spawn (lp i* obj) (lp i* player))) - (%make-level background level* player))))) + (%make-level background* level* player))))) diff --git a/scripts/compile-map.scm b/scripts/compile-map.scm index 786fb67..982f222 100644 --- a/scripts/compile-map.scm +++ b/scripts/compile-map.scm @@ -528,22 +528,24 @@ the default ORIENTATION value of 'orthogonal' is supported." (bytevector-copy! bv 0 new-bv 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) - (let ((tw (tile-map-tile-width tile-map)) - (th (tile-map-tile-height tile-map)) - (layer (tile-map-layer-ref tile-map layer-name))) - (bytevector-concat - (append-map (lambda (y) - (filter-map (lambda (x) - (let ((tile (tile-layer-ref layer x y))) - (and tile - (let ((bv (make-bytevector 10))) - (bytevector-ieee-single-native-set! bv 0 (* x tw)) - (bytevector-ieee-single-native-set! bv 4 (* y th)) - (bytevector-u16-native-set! bv 8 (tile-id (map-tile-ref tile))) - bv)))) - (iota (tile-layer-width layer)))) - (iota (tile-layer-height layer)))))) + (let* ((layer (tile-map-layer-ref tile-map layer-name)) + (w (tile-layer-width layer)) + (h (tile-layer-height layer)) + (bv (make-u16vector (* w h)))) + (let y-loop ((y 0)) + (when (< y h) + (let x-loop ((x 0)) + (when (< x w) + (let ((tile (tile-layer-ref layer x y))) + (bytevector-u16-set! bv (* (+ (* y w) x) 2) + (tile-id (map-tile-ref tile)) + (endianness little))) + (x-loop (1+ x)))) + (y-loop (1+ y)))) + bv)) (define obj:wall:brick 1) (define obj:wall:copper 2)