Add level progression.

This commit is contained in:
David Thompson 2024-05-20 13:34:59 -04:00
parent 99d7643c47
commit ce0c002e8b
8 changed files with 211 additions and 41 deletions

View file

@ -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 $@ $<

View file

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

View file

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

View file

@ -1,31 +1,26 @@
<?xml version="1.0" encoding="UTF-8"?>
<map version="1.8" tiledversion="1.8.6" orientation="orthogonal" renderorder="right-down" width="20" height="15" tilewidth="16" tileheight="16" infinite="0" nextlayerid="3" nextobjectid="5">
<map version="1.8" tiledversion="1.8.6" orientation="orthogonal" renderorder="right-down" width="20" height="15" tilewidth="16" tileheight="16" infinite="0" nextlayerid="3" nextobjectid="6">
<tileset firstgid="1" source="tiles.tsx"/>
<layer id="1" name="background" width="20" height="15">
<data encoding="csv">
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
</data>
</layer>
<objectgroup id="2" name="objects">
<object id="1" type="player-spawn" gid="1" x="128" y="144" width="16" height="16"/>
<object id="4" type="block" gid="4" x="96" y="80" width="16" height="16">
<properties>
<property name="kind" value="copper"/>
</properties>
</object>
<object id="1" type="player-spawn" gid="1" x="96" y="112" width="16" height="16"/>
</objectgroup>
</map>

View file

@ -0,0 +1,101 @@
<?xml version="1.0" encoding="UTF-8"?>
<map version="1.8" tiledversion="1.8.6" orientation="orthogonal" renderorder="right-down" width="20" height="15" tilewidth="16" tileheight="16" infinite="0" nextlayerid="3" nextobjectid="21">
<tileset firstgid="1" source="tiles.tsx"/>
<layer id="1" name="background" width="20" height="15">
<data encoding="csv">
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
</data>
</layer>
<objectgroup id="2" name="objects">
<object id="1" type="player-spawn" gid="1" x="160" y="176" width="16" height="16"/>
<object id="6" type="block" gid="30" x="160" y="112" width="16" height="16">
<properties>
<property name="kind" value="crate"/>
</properties>
</object>
<object id="7" type="block" gid="30" x="208" y="32" width="16" height="16">
<properties>
<property name="kind" value="crate"/>
</properties>
</object>
<object id="8" type="block" gid="30" x="208" y="48" width="16" height="16">
<properties>
<property name="kind" value="crate"/>
</properties>
</object>
<object id="9" type="block" gid="30" x="192" y="32" width="16" height="16">
<properties>
<property name="kind" value="crate"/>
</properties>
</object>
<object id="10" type="block" gid="30" x="96" y="32" width="16" height="16">
<properties>
<property name="kind" value="crate"/>
</properties>
</object>
<object id="11" type="block" gid="30" x="112" y="32" width="16" height="16">
<properties>
<property name="kind" value="crate"/>
</properties>
</object>
<object id="12" type="block" gid="30" x="96" y="48" width="16" height="16">
<properties>
<property name="kind" value="crate"/>
</properties>
</object>
<object id="13" type="block" gid="30" x="208" y="96" width="16" height="16">
<properties>
<property name="kind" value="crate"/>
</properties>
</object>
<object id="14" type="block" gid="30" x="208" y="80" width="16" height="16">
<properties>
<property name="kind" value="crate"/>
</properties>
</object>
<object id="15" type="block" gid="30" x="192" y="96" width="16" height="16">
<properties>
<property name="kind" value="crate"/>
</properties>
</object>
<object id="16" type="block" gid="30" x="96" y="96" width="16" height="16">
<properties>
<property name="kind" value="crate"/>
</properties>
</object>
<object id="17" type="block" gid="30" x="96" y="80" width="16" height="16">
<properties>
<property name="kind" value="crate"/>
</properties>
</object>
<object id="18" type="block" gid="30" x="112" y="96" width="16" height="16">
<properties>
<property name="kind" value="crate"/>
</properties>
</object>
<object id="19" type="block" gid="30" x="128" y="160" width="16" height="16">
<properties>
<property name="kind" value="crate"/>
</properties>
</object>
<object id="20" type="block" gid="30" x="192" y="160" width="16" height="16">
<properties>
<property name="kind" value="crate"/>
</properties>
</object>
</objectgroup>
</map>

View file

@ -0,0 +1,31 @@
<?xml version="1.0" encoding="UTF-8"?>
<map version="1.8" tiledversion="1.8.6" orientation="orthogonal" renderorder="right-down" width="20" height="15" tilewidth="16" tileheight="16" infinite="0" nextlayerid="3" nextobjectid="5">
<tileset firstgid="1" source="tiles.tsx"/>
<layer id="1" name="background" width="20" height="15">
<data encoding="csv">
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
</data>
</layer>
<objectgroup id="2" name="objects">
<object id="1" type="player-spawn" gid="1" x="128" y="144" width="16" height="16"/>
<object id="4" type="block" gid="4" x="96" y="80" width="16" height="16">
<properties>
<property name="kind" value="copper"/>
</properties>
</object>
</objectgroup>
</map>

View file

@ -1,5 +1,5 @@
<?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">
<tileset version="1.8" tiledversion="1.8.6" name="tiles" tilewidth="16" tileheight="16" tilecount="300" columns="20" objectalignment="topleft">
<image source="../../../assets/images/cirkoban.png" width="320" height="240"/>
<tile id="2" type="wall">
<properties>

View file

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