Kill player when gate closes on them.
This commit is contained in:
parent
68b427e387
commit
71d62e596e
3 changed files with 88 additions and 38 deletions
BIN
assets/sounds/die.wav
Normal file
BIN
assets/sounds/die.wav
Normal file
Binary file not shown.
59
game.scm
59
game.scm
|
@ -68,6 +68,7 @@
|
|||
(define audio:no (load-sound-effect "no"))
|
||||
(define audio:exit (load-sound-effect "exit"))
|
||||
(define audio:pickup (load-sound-effect "pickup"))
|
||||
(define audio:die (load-sound-effect "die"))
|
||||
|
||||
;; Game state
|
||||
(define *state* #f)
|
||||
|
@ -198,29 +199,41 @@
|
|||
(define (move-player dir)
|
||||
(define (do-move)
|
||||
(with-goblins
|
||||
($ (level-player *level*) 'move dir)
|
||||
($ (level-actor *level*) 'tick)
|
||||
(define result
|
||||
(match ($ (level-player *level*) 'event)
|
||||
(('bump)
|
||||
(media-play audio:bump)
|
||||
#f)
|
||||
(('push)
|
||||
(media-play audio:push)
|
||||
#f)
|
||||
(('exit)
|
||||
(media-play audio:exit)
|
||||
'next-level)
|
||||
(('gem)
|
||||
(media-play audio:pickup)
|
||||
;; TODO: Maybe show a little achievement popup when all gems
|
||||
;; are collected?
|
||||
(set! *gems* (cons *level-idx* *gems*))
|
||||
#f)
|
||||
(_ #f)))
|
||||
(update-objects!)
|
||||
result))
|
||||
(save-snapshot!)
|
||||
(let ((player (level-player *level*)))
|
||||
(if ($ player 'alive?)
|
||||
(begin
|
||||
($ player 'move dir)
|
||||
($ (level-actor *level*) 'tick)
|
||||
;; TODO: Need a better way to receive events to play sounds
|
||||
;; and emit particles and stuff so any actor can trigger
|
||||
;; events.
|
||||
(let ((result
|
||||
(match ($ player 'event)
|
||||
(('bump)
|
||||
(media-play audio:bump)
|
||||
#f)
|
||||
(('push)
|
||||
(media-play audio:push)
|
||||
#f)
|
||||
(('exit)
|
||||
(media-play audio:exit)
|
||||
'next-level)
|
||||
(('die)
|
||||
(media-play audio:die)
|
||||
#f)
|
||||
(('gem)
|
||||
(media-play audio:pickup)
|
||||
;; TODO: Maybe show a little achievement popup when all gems
|
||||
;; are collected?
|
||||
(set! *gems* (cons *level-idx* *gems*))
|
||||
#f)
|
||||
(_ #f))))
|
||||
(update-objects!)
|
||||
(save-snapshot!)
|
||||
result))
|
||||
(begin
|
||||
(media-play audio:no)
|
||||
#f)))))
|
||||
(when (eq? (do-move) 'next-level)
|
||||
(next-level!)))
|
||||
|
||||
|
|
|
@ -39,6 +39,7 @@
|
|||
(('type) 'exit)
|
||||
(('position) position)
|
||||
(('tick grid-info) #f)
|
||||
(('post-tick grid-info) #f)
|
||||
(('enter obj grid-info) #f)
|
||||
(('exit obj grid-info) #f)
|
||||
(('wire-state) #f)
|
||||
|
@ -54,6 +55,7 @@
|
|||
(('type) 'wall)
|
||||
(('position) position)
|
||||
(('tick grid-info) #f)
|
||||
(('post-tick grid-info) #f)
|
||||
(('enter obj grid-info) #f)
|
||||
(('exit obj grid-info) #f)
|
||||
(('wire-state)
|
||||
|
@ -80,6 +82,7 @@
|
|||
(('type) 'block)
|
||||
(('position) ($ position))
|
||||
(('tick grid-info) ($ pushed? #f))
|
||||
(('post-tick grid-info) #f)
|
||||
(('enter obj grid-info) #f)
|
||||
(('exit obj grid-info) #f)
|
||||
(('wire-state)
|
||||
|
@ -123,6 +126,7 @@
|
|||
(('type) 'emitter)
|
||||
(('position) position)
|
||||
(('tick grid-info) ($ timer (+ ($ timer) 1)))
|
||||
(('post-tick grid-info) #f)
|
||||
(('enter obj grid-info) #f)
|
||||
(('exit obj grid-info) #f)
|
||||
(('wire-state)
|
||||
|
@ -155,6 +159,7 @@
|
|||
(('type) 'switch)
|
||||
(('position) position)
|
||||
(('tick grid-info) #f)
|
||||
(('post-tick grid-info) #f)
|
||||
(('enter obj grid-info)
|
||||
($ on? #t))
|
||||
(('exit obj grid-info)
|
||||
|
@ -181,6 +186,7 @@
|
|||
(('type) 'switch)
|
||||
(('position) position)
|
||||
(('tick grid-info) #f)
|
||||
(('post-tick grid-info) #f)
|
||||
(('enter obj grid-info) #f)
|
||||
(('exit obj grid-info) #f)
|
||||
(('wire-state) #f)
|
||||
|
@ -210,6 +216,7 @@
|
|||
(('type) 'gem)
|
||||
(('position) position)
|
||||
(('tick grid-info) #f)
|
||||
(('post-tick grid-info) #f)
|
||||
(('enter obj grid-info) #f)
|
||||
(('exit obj grid-info) #f)
|
||||
(('wire-state) #f)
|
||||
|
@ -227,6 +234,7 @@
|
|||
(('type) 'gate)
|
||||
(('position) position)
|
||||
(('tick grid-info) #f)
|
||||
(('post-tick grid-info) #f)
|
||||
(('enter obj grid-info) #f)
|
||||
(('exit obj grid-info) #f)
|
||||
(('activate) ($ open? #t))
|
||||
|
@ -245,6 +253,7 @@
|
|||
(('type) 'emitter)
|
||||
(('position) position)
|
||||
(('tick grid-info) #f)
|
||||
(('post-tick grid-info) #f)
|
||||
(('enter obj grid-info) #f)
|
||||
(('exit obj grid-info) #f)
|
||||
(('wire-state) ($ state))
|
||||
|
@ -268,6 +277,7 @@
|
|||
(define (^player bcom x y)
|
||||
(define position (spawn ^cell (vector x y 2)))
|
||||
(define velocity (spawn ^cell #(0 0)))
|
||||
(define alive? (spawn ^cell #t))
|
||||
(define event (spawn ^cell))
|
||||
(match-lambda*
|
||||
(('type) 'player)
|
||||
|
@ -281,18 +291,39 @@
|
|||
('down #(0 1))
|
||||
(_ (error "invalid direction" dir)))))
|
||||
(('tick grid-info)
|
||||
($ event #f)
|
||||
;; Search for objects that were fine to step onto last turn, but
|
||||
;; have become deadly this turn. If
|
||||
(match ($ position)
|
||||
(#(x y z)
|
||||
($ event #f)
|
||||
(match ($ velocity)
|
||||
(#(dx dy)
|
||||
($ position (vector (+ x dx) (+ y dy) z))
|
||||
($ velocity #(0 0)))))))
|
||||
(('post-tick grid-info)
|
||||
(match ($ position)
|
||||
(#(x y z)
|
||||
(let lp ((objs ($ grid-info 'occupants x y)))
|
||||
(match objs
|
||||
;; All is well. Move by current velocity.
|
||||
(()
|
||||
(match ($ velocity)
|
||||
(#(dx dy)
|
||||
($ position (vector (+ x dx) (+ y dy) z))
|
||||
($ velocity #(0 0)))))
|
||||
((obj . rest)
|
||||
(match ($ obj 'type)
|
||||
('gate
|
||||
;; Ouch, a gate closed on the player!
|
||||
(unless ($ obj 'open?)
|
||||
($ alive? #f)
|
||||
($ event '(die))))
|
||||
(_ (lp rest)))))))))
|
||||
(('enter obj grid-info) #f)
|
||||
(('exit obj grid-info) #f)
|
||||
(('wire-state) #f)
|
||||
(('update-wire-state grid-info) #f)
|
||||
(('alive?) #t)
|
||||
(('alive?) ($ alive?))
|
||||
(('describe) `(player ,($ position)))
|
||||
(('collide other offset grid-info)
|
||||
(define (reverse-move)
|
||||
|
@ -451,28 +482,34 @@
|
|||
(unless (equal? other-pos other-prev-pos)
|
||||
(collide other other-pos other-prev-pos)))
|
||||
(lp rest))))))))))))
|
||||
(define (tick)
|
||||
;; Tick each object and check for collisions.
|
||||
(define (iter-objects proc)
|
||||
($ objects
|
||||
(let lp ((objs ($ objects)))
|
||||
(match objs
|
||||
(() '())
|
||||
((obj . rest)
|
||||
(let ((prev-pos ($ obj 'position)))
|
||||
($ obj 'tick grid-info)
|
||||
;; Only check collisions for movable objects.
|
||||
(let ((desired-pos ($ obj 'position)))
|
||||
(unless (equal? prev-pos desired-pos)
|
||||
(collide obj desired-pos prev-pos)))
|
||||
;; Cull dead objects.
|
||||
(if ($ obj 'alive?)
|
||||
(cons obj (lp rest))
|
||||
(lp rest)))))))
|
||||
(proc obj)
|
||||
;; Cull dead objects.
|
||||
(if ($ obj 'alive?)
|
||||
(cons obj (lp rest))
|
||||
(lp rest)))))))
|
||||
(define (tick)
|
||||
;; Tick each object and check for collisions.
|
||||
(iter-objects
|
||||
(lambda (obj)
|
||||
(let ((prev-pos ($ obj 'position)))
|
||||
($ obj 'tick grid-info)
|
||||
;; Only check collisions for movable objects.
|
||||
(let ((desired-pos ($ obj 'position)))
|
||||
(unless (equal? prev-pos desired-pos)
|
||||
(collide obj desired-pos prev-pos))))))
|
||||
;; Advance Wirewold simulation.
|
||||
(refresh-wire-grid)
|
||||
(for-each (lambda (obj)
|
||||
($ obj 'update-wire-state grid-info))
|
||||
($ objects)))
|
||||
($ objects))
|
||||
;; Run post-tick hooks.
|
||||
(iter-objects (lambda (obj) ($ obj 'post-tick grid-info))))
|
||||
|
||||
(match-lambda*
|
||||
(('tick) (tick))
|
||||
|
|
Loading…
Add table
Reference in a new issue