Add level progression.
This commit is contained in:
David Thompson
parent
99d7643c47
commit
ce0c002e8b
8 changed files with 211 additions and 41 deletions
4
Makefile
4
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 $@ $<
|
||||
|
|
|
|||
46
game.scm
46
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,6 +239,8 @@
|
|||
(define (on-key-down event)
|
||||
(let ((key (keyboard-event-code event)))
|
||||
(pk 'key-down key)
|
||||
(match *state*
|
||||
('play
|
||||
(cond
|
||||
((string=? key key:left)
|
||||
(move-player 'left))
|
||||
|
|
@ -222,7 +254,11 @@
|
|||
(rollback-snapshot!)
|
||||
(with-goblins (update-grid!)))
|
||||
((string=? key key:confirm)
|
||||
(reset-game!)))))
|
||||
(reset-game!))))
|
||||
('win
|
||||
(cond
|
||||
((string=? key key:confirm)
|
||||
(reset-game!)))))))
|
||||
|
||||
;; Canvas and event loop setup
|
||||
(define canvas (get-element-by-id "canvas"))
|
||||
|
|
|
|||
|
|
@ -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)))))
|
||||
|
|
|
|||
|
|
@ -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>
|
||||
|
|
|
|||
101
modules/game/levels/level-2.tmx
Normal file
101
modules/game/levels/level-2.tmx
Normal 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>
|
||||
31
modules/game/levels/level-3.tmx
Normal file
31
modules/game/levels/level-3.tmx
Normal 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>
|
||||
|
|
@ -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>
|
||||
|
|
|
|||
|
|
@ -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)))))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue