Add support for more objects to map editor.
This commit is contained in:
David Thompson
parent
3f24b3bd89
commit
111f4d37f1
9 changed files with 151 additions and 107 deletions
|
|
@ -1,8 +1,12 @@
|
|||
(define-module (game actors)
|
||||
#:use-module (goblins core)
|
||||
#:use-module (hoot bytevectors)
|
||||
#:use-module (ice-9 match)
|
||||
#:export (^cell
|
||||
^exit
|
||||
^wall
|
||||
^block
|
||||
^clock-emitter
|
||||
^player
|
||||
^level))
|
||||
|
||||
(define* (^cell bcom #:optional val)
|
||||
|
|
@ -17,7 +21,7 @@
|
|||
(('wire-state) #f)
|
||||
(('set-wire-state) #f)
|
||||
(('describe) '(exit))
|
||||
(('collide) 'goal)))
|
||||
(('collide) 'exit)))
|
||||
|
||||
(define (^wall bcom type)
|
||||
(match-lambda*
|
||||
|
|
@ -68,8 +72,9 @@
|
|||
(('wire-state) #f)
|
||||
(('describe) '(player))))
|
||||
|
||||
(define (^level bcom width height objects)
|
||||
(define (^level bcom width height)
|
||||
(define player (spawn ^player))
|
||||
;; TODO: Move this into the player actor.
|
||||
(define player-coords (spawn ^cell))
|
||||
(define (make-grid)
|
||||
(make-vector (* width height)))
|
||||
|
|
@ -108,7 +113,11 @@
|
|||
(occupant
|
||||
(match ($ occupant 'collide)
|
||||
('bump 'bump)
|
||||
('goal (pk 'GOAL))
|
||||
('exit
|
||||
($ old-cell #f)
|
||||
($ cell player)
|
||||
($ player-coords (vector x y))
|
||||
'exit)
|
||||
('push
|
||||
(let ((next-cell (grid-ref grid (wrap-x (+ x dx)) (wrap-y (+ y dy)))))
|
||||
(match ($ next-cell)
|
||||
|
|
@ -174,42 +183,6 @@
|
|||
(lambda (x y)
|
||||
(grid-set! grid x y (spawn ^cell))))
|
||||
|
||||
;; TODO: actually write levels
|
||||
(warp-player 10 8)
|
||||
|
||||
;; 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 3 7) (spawn ^exit))
|
||||
|
||||
($ (grid-ref grid 4 3) (spawn ^clock-emitter 3))
|
||||
($ (grid-ref grid 5 3) (spawn ^wall 'copper))
|
||||
($ (grid-ref grid 6 5) (spawn ^block 'copper))
|
||||
($ (grid-ref grid 7 3) (spawn ^wall 'copper))
|
||||
($ (grid-ref grid 8 3) (spawn ^wall 'copper))
|
||||
($ (grid-ref grid 9 3) (spawn ^wall 'copper))
|
||||
($ (grid-ref grid 10 3) (spawn ^wall 'copper))
|
||||
($ (grid-ref grid 11 3) (spawn ^wall 'copper))
|
||||
($ (grid-ref grid 12 3) (spawn ^wall 'copper))
|
||||
($ (grid-ref grid 13 2) (spawn ^wall 'copper))
|
||||
($ (grid-ref grid 13 3) (spawn ^wall 'copper))
|
||||
($ (grid-ref grid 13 4) (spawn ^wall 'copper))
|
||||
($ (grid-ref grid 14 2) (spawn ^wall 'copper))
|
||||
($ (grid-ref grid 14 4) (spawn ^wall 'copper))
|
||||
($ (grid-ref grid 15 3) (spawn ^wall 'copper))
|
||||
($ (grid-ref grid 16 3) (spawn ^wall 'copper))
|
||||
($ (grid-ref grid 17 3) (spawn ^wall 'copper))
|
||||
($ (grid-ref grid 18 3) (spawn ^wall 'copper))
|
||||
|
||||
(match-lambda*
|
||||
(('describe)
|
||||
(let ((grid* (make-grid)))
|
||||
|
|
@ -220,6 +193,11 @@
|
|||
(#f #f)
|
||||
(refr ($ refr 'describe))))))
|
||||
grid*))
|
||||
(('set-object x y obj)
|
||||
($ (grid-ref grid x y) obj))
|
||||
;; TODO: Move to player actor
|
||||
(('warp-player x y)
|
||||
(warp-player x y))
|
||||
(('move-player dir)
|
||||
(define result
|
||||
(match dir
|
||||
|
|
|
|||
40
modules/game/level.scm
Normal file
40
modules/game/level.scm
Normal file
|
|
@ -0,0 +1,40 @@
|
|||
(define-module (game level)
|
||||
#:use-module (game actors)
|
||||
#:use-module (goblins core)
|
||||
#:use-module (hoot bytevectors)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (srfi srfi-9)
|
||||
#:export (make-level
|
||||
level?
|
||||
level-background
|
||||
level-actor))
|
||||
|
||||
;; Client-side rendering info coupled with level actor that contains
|
||||
;; game state.
|
||||
(define-record-type <level>
|
||||
(%make-level background actor)
|
||||
level?
|
||||
(background level-background)
|
||||
(actor level-actor))
|
||||
|
||||
(define (make-level width height background objects)
|
||||
(let ((level* (spawn ^level width height)))
|
||||
;; 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)))
|
||||
(id (bytevector-u8-ref objects (+ i 2))))
|
||||
(if (= id 3) ; player-spawn
|
||||
($ 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))
|
||||
(id (error "invalid level object" id)))))
|
||||
($ level* 'set-object x y obj))))
|
||||
(lp (+ i 3)))))
|
||||
(%make-level background level*)))
|
||||
|
|
@ -1,14 +1,14 @@
|
|||
<?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="2" nextobjectid="1">
|
||||
<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,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,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,
|
||||
|
|
@ -20,4 +20,12 @@
|
|||
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,9 +1,16 @@
|
|||
<?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">
|
||||
<image source="../../../assets/images/cirkoban.png" width="320" height="240"/>
|
||||
<tile id="22">
|
||||
<tile id="2" type="wall">
|
||||
<properties>
|
||||
<property name="wall" type="bool" value="true"/>
|
||||
<property name="kind" value="copper"/>
|
||||
</properties>
|
||||
</tile>
|
||||
<tile id="22" type="wall">
|
||||
<properties>
|
||||
<property name="kind" value="brick"/>
|
||||
</properties>
|
||||
</tile>
|
||||
<tile id="27" type="exit"/>
|
||||
<tile id="48" type="clock-emitter"/>
|
||||
</tileset>
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue