SuperKamiGuru/foss-mmo
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add support for more objects to map editor.

Browse source
This commit is contained in:
David Thompson 2024-05-20 12:15:39 -04:00
parent 3f24b3bd89
commit 111f4d37f1
9 changed files with 151 additions and 107 deletions
modules/game
actors.scm

58
modules/game/actors.scm
View file

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