Add exit actor that doesn't really work yet.
This commit is contained in:
parent
a01fdd8983
commit
e7e5413460
2 changed files with 34 additions and 10 deletions
|
@ -1,5 +1,4 @@
|
|||
(define-module (game actors)
|
||||
#:use-module (dom canvas)
|
||||
#:use-module (goblins core)
|
||||
#:use-module (ice-9 match)
|
||||
#:export (^cell
|
||||
|
@ -11,6 +10,14 @@
|
|||
((new-val)
|
||||
(bcom (^cell bcom new-val)))))
|
||||
|
||||
(define (^exit bcom)
|
||||
(match-lambda*
|
||||
(('tick) #f)
|
||||
(('wire-state) #f)
|
||||
(('set-wire-state) #f)
|
||||
(('describe) '(exit))
|
||||
(('collide) 'goal)))
|
||||
|
||||
(define (^wall bcom type)
|
||||
(match-lambda*
|
||||
(('tick) #f)
|
||||
|
@ -100,6 +107,7 @@
|
|||
(occupant
|
||||
(match ($ occupant 'collide)
|
||||
('stop #f)
|
||||
('goal (pk 'GOAL))
|
||||
('displace
|
||||
(let ((next-cell (grid-ref grid (wrap-x (+ x dx)) (wrap-y (+ y dy)))))
|
||||
(match ($ next-cell)
|
||||
|
@ -107,7 +115,8 @@
|
|||
($ next-cell ($ cell))
|
||||
($ cell player)
|
||||
($ old-cell #f)
|
||||
($ player-coords (vector x y)))
|
||||
($ player-coords (vector x y))
|
||||
'displace)
|
||||
(_ #f)))))))))))
|
||||
(define (warp-player x y)
|
||||
($ (grid-ref grid x y) player)
|
||||
|
@ -166,6 +175,9 @@
|
|||
|
||||
;; TODO: actually write levels
|
||||
(warp-player 10 8)
|
||||
|
||||
($ (grid-ref grid 3 7) (spawn ^exit))
|
||||
|
||||
($ (grid-ref grid 4 4) (spawn ^wall 'brick))
|
||||
|
||||
($ (grid-ref grid 4 3) (spawn ^clock-emitter 3))
|
||||
|
@ -198,9 +210,11 @@
|
|||
(refr ($ refr 'describe))))))
|
||||
grid*))
|
||||
(('move-player dir)
|
||||
(match dir
|
||||
('up (move-player 0 -1))
|
||||
('down (move-player 0 1))
|
||||
('left (move-player -1 0))
|
||||
('right (move-player 1 0)))
|
||||
(tick))))
|
||||
(define result
|
||||
(match dir
|
||||
('up (move-player 0 -1))
|
||||
('down (move-player 0 1))
|
||||
('left (move-player -1 0))
|
||||
('right (move-player 1 0))))
|
||||
(tick)
|
||||
result)))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue