diff --git a/Makefile b/Makefile index ff2f9fd..0eb626c 100644 --- a/Makefile +++ b/Makefile @@ -24,7 +24,9 @@ modules = \ modules/srfi/srfi-11.scm levels = \ - modules/game/levels/level-1.scm + modules/game/levels/level-1.scm \ + modules/game/levels/level-2.scm \ + modules/game/levels/level-3.scm game.wasm: game.scm $(modules) $(levels) guild compile-wasm -L modules -o $@ $< diff --git a/game.scm b/game.scm index 4e9b0de..440247c 100644 --- a/game.scm +++ b/game.scm @@ -28,6 +28,8 @@ (game actors) (game level) (game levels level-1) + (game levels level-2) + (game levels level-3) (game tileset) (goblins core) (hoot bytevectors) @@ -66,12 +68,20 @@ (define audio:exit (load-sound-effect "exit")) ;; Game state +(define *state* #f) + (define *actormap* (make-whactormap)) (define (call-with-goblins thunk) (actormap-churn-run! *actormap* thunk)) (define-syntax-rule (with-goblins body ...) (call-with-goblins (lambda () body ...))) +(define levels + (vector + load-level-1 + load-level-2 + load-level-3)) +(define *level-idx* #f) (define *level* #f) ;; Latest representation of all actors in level (define *grid* #f) @@ -92,11 +102,21 @@ (define (update-grid!) (set! *grid* ($ (level-actor *level*) 'describe))) +(define (next-level!) + (clear-snapshots!) + (let ((idx (+ *level-idx* 1))) + (set! *level-idx* idx) + (if (< idx (vector-length levels)) + (set! *level* ((vector-ref levels idx))) + (set! *state* 'win)))) + (define (reset-game!) + (set! *state* 'play) (set! *actormap* (make-whactormap)) (clear-snapshots!) + (set! *level-idx* -1) (with-goblins - (set! *level* (load-level-1)) + (next-level!) (update-grid!))) ;; Update loop @@ -106,7 +126,9 @@ (match ($ (level-actor *level*) 'move-player dir) ('bump (media-play audio:bump)) ('push (media-play audio:push)) - ('exit (media-play audio:exit)) + ('exit + (media-play audio:exit) + (next-level!)) (_ #f)) (update-grid!))) @@ -145,7 +167,9 @@ (_ #f))) (define (draw-block type x y) - (draw-tile context tileset 3 x y) + (match type + ('crate (draw-tile context tileset 29 x y)) + ('copper (draw-tile context tileset 3 x y))) (match type ('electron-head (draw-tile context tileset 4 x y)) @@ -190,11 +214,17 @@ (x-loop (1+ x)))) (y-loop (1+ y)))))) +(define (draw-win) + (set-fill-color! context "#x000000") + (fill-text context "OMG YOU DID IT WOW CONGRATS" 32.0 120.0)) + (define (draw prev-time) (clear-rect context 0.0 0.0 *canvas-width* *canvas-height*) (set-transform! context 1.0 0.0 0.0 1.0 0.0 0.0) (set-scale! context *canvas-scale* *canvas-scale*) - (draw-level) + (match *state* + ('play (draw-level)) + ('win (draw-win))) (request-animation-frame draw-callback)) (define draw-callback (procedure->external draw)) @@ -209,20 +239,26 @@ (define (on-key-down event) (let ((key (keyboard-event-code event))) (pk 'key-down key) - (cond - ((string=? key key:left) - (move-player 'left)) - ((string=? key key:right) - (move-player 'right)) - ((string=? key key:up) - (move-player 'up)) - ((string=? key key:down) - (move-player 'down)) - ((string=? key key:undo) - (rollback-snapshot!) - (with-goblins (update-grid!))) - ((string=? key key:confirm) - (reset-game!))))) + (match *state* + ('play + (cond + ((string=? key key:left) + (move-player 'left)) + ((string=? key key:right) + (move-player 'right)) + ((string=? key key:up) + (move-player 'up)) + ((string=? key key:down) + (move-player 'down)) + ((string=? key key:undo) + (rollback-snapshot!) + (with-goblins (update-grid!))) + ((string=? key key:confirm) + (reset-game!)))) + ('win + (cond + ((string=? key key:confirm) + (reset-game!))))))) ;; Canvas and event loop setup (define canvas (get-element-by-id "canvas")) diff --git a/modules/game/level.scm b/modules/game/level.scm index f8ef450..6d2bf20 100644 --- a/modules/game/level.scm +++ b/modules/game/level.scm @@ -27,13 +27,16 @@ (y (bytevector-u8-ref objects (+ i 1))) (id (bytevector-u8-ref objects (+ i 2)))) (if (= id 3) ; player-spawn - ($ level* 'warp-player x y) + (begin + (pk 'spawn-player x y) + ($ level* 'warp-player x y)) (let ((obj (match id (1 (spawn ^wall 'brick)) (2 (spawn ^wall 'copper)) (4 (spawn ^exit)) (5 (spawn ^block 'copper)) - (6 (spawn ^clock-emitter 4)) + (6 (spawn ^block 'crate)) + (7 (spawn ^clock-emitter 4)) (id (error "invalid level object" id))))) ($ level* 'set-object x y obj)))) (lp (+ i 3))))) diff --git a/modules/game/levels/level-1.tmx b/modules/game/levels/level-1.tmx index d3b3bc1..3aaeb6b 100644 --- a/modules/game/levels/level-1.tmx +++ b/modules/game/levels/level-1.tmx @@ -1,31 +1,26 @@ - + 23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23, +23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23, +23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23, +23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23, +23,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,23,23,23, -23,23,24,24,24,24,24,24,24,28,24,24,24,24,24,24,24,24,23,23, -23,24,24,24,24,24,24,24,24,24,24,24,3,3,24,24,24,24,24,23, -23,49,3,3,3,3,24,3,3,3,3,3,3,24,3,3,3,3,3,23, -23,24,24,24,24,24,24,24,24,24,24,24,3,3,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,24,24,24,24,24,24,24,24,24,24,28,24,24,24,24,24,23,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, +23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23, +23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23, +23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,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/level-2.tmx b/modules/game/levels/level-2.tmx new file mode 100644 index 0000000..1be8bae --- /dev/null +++ b/modules/game/levels/level-2.tmx @@ -0,0 +1,101 @@ + + + + + +23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23, +23,23,23,23,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,23,23,23,23,23,23, +23,23,23,23,23,23,24,24,24,28,24,24,24,24,23,23,23,23,23,23, +23,23,23,23,23,23,24,24,24,24,24,24,24,24,23,23,23,23,23,23, +23,23,23,23,23,23,24,24,24,24,24,24,24,24,23,23,23,23,23,23, +23,23,23,23,23,23,24,24,24,24,24,24,24,24,23,23,23,23,23,23, +23,23,23,23,23,23,23,23,23,23,24,23,23,23,23,23,23,23,23,23, +23,23,23,23,23,23,23,23,23,24,24,24,23,23,23,23,23,23,23,23, +23,23,23,23,23,23,23,24,24,24,24,24,24,23,23,23,23,23,23,23, +23,23,23,23,23,23,24,24,24,24,24,24,24,24,23,23,23,23,23,23, +23,23,23,23,23,23,24,24,24,24,24,24,24,24,23,23,23,23,23,23, +23,23,23,23,23,23,23,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,23,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/level-3.tmx b/modules/game/levels/level-3.tmx new file mode 100644 index 0000000..d3b3bc1 --- /dev/null +++ b/modules/game/levels/level-3.tmx @@ -0,0 +1,31 @@ + + + + + +23,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,23,23,23, +23,23,24,24,24,24,24,24,24,28,24,24,24,24,24,24,24,24,23,23, +23,24,24,24,24,24,24,24,24,24,24,24,3,3,24,24,24,24,24,23, +23,49,3,3,3,3,24,3,3,3,3,3,3,24,3,3,3,3,3,23, +23,24,24,24,24,24,24,24,24,24,24,24,3,3,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 75f1cf3..905737f 100644 --- a/modules/game/levels/tiles.tsx +++ b/modules/game/levels/tiles.tsx @@ -1,5 +1,5 @@ - + diff --git a/scripts/compile-map.scm b/scripts/compile-map.scm index 4468a0b..dfeb85d 100644 --- a/scripts/compile-map.scm +++ b/scripts/compile-map.scm @@ -550,7 +550,8 @@ the default ORIENTATION value of 'orthogonal' is supported." (define obj:player-spawn 3) (define obj:exit 4) (define obj:block:copper 5) -(define obj:clock-emitter 6) +(define obj:block:crate 6) +(define obj:clock-emitter 7) (define (compile-environment-layer tile-map layer-name) (let ((tw (tile-map-tile-width tile-map)) @@ -582,13 +583,14 @@ the default ORIENTATION value of 'orthogonal' is supported." (append-map (lambda (obj) (let* ((type (map-object-type obj)) (properties (map-object-properties obj)) - (r (map-object-shape obj)) + (r (pk 'obj type (map-object-shape obj))) (x (/ (rect-x r) tw)) (y (/ (rect-y r) th))) (match type ('player-spawn (list x y obj:player-spawn)) ('block (match (assq-ref properties 'kind) + ("crate" (list x y obj:block:crate)) ("copper" (list x y obj:block:copper)) (kind (error "unsupported block kind" kind)))) (_ (error "unsupported object type" type)))))