Allow any actor to push an event to the UI.
This commit is contained in:
David Thompson
parent
bcb235bd82
commit
a24d737bc7
4 changed files with 99 additions and 74 deletions
BIN
assets/sounds/electric-switch-off.wav
Normal file
BIN
assets/sounds/electric-switch-off.wav
Normal file
Binary file not shown.
BIN
assets/sounds/electric-switch-on.wav
Normal file
BIN
assets/sounds/electric-switch-on.wav
Normal file
Binary file not shown.
80
game.scm
80
game.scm
|
|
@ -67,6 +67,8 @@
|
|||
(define audio:exit (load-sound-effect "exit"))
|
||||
(define audio:pickup (load-sound-effect "pickup"))
|
||||
(define audio:die (load-sound-effect "die"))
|
||||
(define audio:electric-switch-on (load-sound-effect "electric-switch-on"))
|
||||
(define audio:electric-switch-off (load-sound-effect "electric-switch-off"))
|
||||
|
||||
;; Game state
|
||||
(define *state* #f)
|
||||
|
|
@ -196,45 +198,45 @@
|
|||
|
||||
;; Update loop
|
||||
(define (move-player dir)
|
||||
(define (do-move)
|
||||
(with-goblins
|
||||
(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)
|
||||
(play-sound-effect audio:bump)
|
||||
#f)
|
||||
(('push)
|
||||
(play-sound-effect audio:push)
|
||||
#f)
|
||||
(('exit)
|
||||
(play-sound-effect audio:exit)
|
||||
'next-level)
|
||||
(('die)
|
||||
(play-sound-effect audio:die)
|
||||
#f)
|
||||
(('gem)
|
||||
(play-sound-effect 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
|
||||
(play-sound-effect audio:no)
|
||||
#f)))))
|
||||
(when (eq? (do-move) 'next-level)
|
||||
(next-level!)))
|
||||
(define level-complete? #f)
|
||||
(with-goblins
|
||||
(let ((player (level-player *level*))
|
||||
(level (level-actor *level*)))
|
||||
(cond
|
||||
(($ player 'alive?)
|
||||
(begin
|
||||
($ player 'move dir)
|
||||
($ level 'tick)
|
||||
(let lp ((events ($ level 'flush-events)))
|
||||
(match events
|
||||
(() (values))
|
||||
((event . rest)
|
||||
(match (pk 'event event)
|
||||
(('bump x y)
|
||||
(play-sound-effect audio:bump))
|
||||
(('push x y)
|
||||
(play-sound-effect audio:push))
|
||||
(('exit x y)
|
||||
(play-sound-effect audio:exit)
|
||||
(set! level-complete? #t))
|
||||
(('player-death x y)
|
||||
(play-sound-effect audio:die))
|
||||
(('pickup x y)
|
||||
(play-sound-effect audio:pickup)
|
||||
;; TODO: Maybe show a little achievement popup when all gems
|
||||
;; are collected?
|
||||
(set! *gems* (cons *level-idx* *gems*)))
|
||||
(('electric-switch-on x y)
|
||||
(play-sound-effect audio:electric-switch-on))
|
||||
(('electric-switch-off x y)
|
||||
(play-sound-effect audio:electric-switch-off))
|
||||
(_ (values)))
|
||||
(lp rest))))
|
||||
(update-objects!)
|
||||
(save-snapshot!)))
|
||||
(else
|
||||
(play-sound-effect audio:no)))))
|
||||
(when level-complete? (next-level!)))
|
||||
|
||||
(define dt (/ 1000.0 60.0)) ; aim for updating at 60Hz
|
||||
(define (update)
|
||||
|
|
|
|||
|
|
@ -168,7 +168,9 @@
|
|||
($ on? #f)
|
||||
(match (first-non-player-occupant grid-info target-x target-y)
|
||||
(#f (pk "no switch target!"))
|
||||
(target ($ target 'deactivate)))))
|
||||
(target
|
||||
($ grid-info 'append-event `(floor-switch-off ,x ,y))
|
||||
($ target 'deactivate)))))
|
||||
(('wire-state grid-info) #f)
|
||||
(('update-wire-state grid-info) #f)
|
||||
(('alive?) #t)
|
||||
|
|
@ -177,7 +179,9 @@
|
|||
($ on? #t)
|
||||
(match (first-non-player-occupant grid-info target-x target-y)
|
||||
(#f (pk "no switch target!"))
|
||||
(target ($ target 'activate))))))
|
||||
(target
|
||||
($ grid-info 'append-event `(floor-switch-on ,x ,y))
|
||||
($ target 'activate))))))
|
||||
|
||||
(define (^electric-switch bcom x y target-x target-y)
|
||||
(define position (vector x y 0))
|
||||
|
|
@ -199,13 +203,17 @@
|
|||
($ on? #f)
|
||||
(match (first-non-player-occupant grid-info target-x target-y)
|
||||
(#f (pk "no switch target!"))
|
||||
(target ($ target 'deactivate)))))
|
||||
(target
|
||||
($ grid-info 'append-event `(electric-switch-off ,x ,y))
|
||||
($ target 'deactivate)))))
|
||||
(when (>= ($ grid-info 'wireworld-neighbor-count x y) 1)
|
||||
($ on? #t)
|
||||
($ timer 2)
|
||||
(match (first-non-player-occupant grid-info target-x target-y)
|
||||
(#f (pk "no switch target!"))
|
||||
(target ($ target 'activate))))))
|
||||
(target
|
||||
($ grid-info 'append-event `(electric-switch-on ,x ,y))
|
||||
($ target 'activate))))))
|
||||
(('alive?) #t)
|
||||
(('describe) `(electric-switch ,position ,($ on?)))
|
||||
(('collide other offset grid-info) #f)))
|
||||
|
|
@ -238,13 +246,15 @@
|
|||
(if ($ electron?)
|
||||
(begin
|
||||
($ state 'electron-head)
|
||||
($ electron? #f))
|
||||
($ electron? #f)
|
||||
($ grid-info 'append-event `(receive-electron ,x ,y)))
|
||||
(let ((neighbors ($ grid-info 'wireworld-neighbor-count x y)))
|
||||
(if (<= 1 neighbors 2)
|
||||
(begin
|
||||
($ state 'electron-head)
|
||||
;; Forward an electron head to the receiver.
|
||||
($ (find-receiver grid-info) 'give-electron))
|
||||
($ (find-receiver grid-info) 'give-electron)
|
||||
($ grid-info 'append-event `(send-electron ,x ,y)))
|
||||
($ state 'copper)))))))
|
||||
(('give-electron) ($ electron? #t))
|
||||
(('alive?) #t)
|
||||
|
|
@ -267,7 +277,8 @@
|
|||
(('describe) `(gem ,position))
|
||||
(('collide other offset grid-info)
|
||||
(when (eq? ($ other 'type) 'player)
|
||||
($ picked-up? #t)))))
|
||||
($ picked-up? #t)
|
||||
($ grid-info 'append-event `(pickup ,x ,y))))))
|
||||
|
||||
(define (^ghost-gem bcom x y)
|
||||
(define position (vector x y 1))
|
||||
|
|
@ -294,6 +305,7 @@
|
|||
(('post-tick grid-info) #f)
|
||||
(('enter obj grid-info) #f)
|
||||
(('exit obj grid-info) #f)
|
||||
;; TODO: Send grid-info
|
||||
(('activate) ($ open? #t))
|
||||
(('deactivate) ($ open? #f))
|
||||
(('wire-state grid-info) #f)
|
||||
|
|
@ -419,7 +431,6 @@
|
|||
(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)
|
||||
(('position) ($ position))
|
||||
|
|
@ -434,7 +445,6 @@
|
|||
(('tick grid-info)
|
||||
(match ($ position)
|
||||
(#(x y z)
|
||||
($ event #f)
|
||||
(match ($ velocity)
|
||||
(#(dx dy)
|
||||
($ position (vector (+ x dx) (+ y dy) z))
|
||||
|
|
@ -453,7 +463,7 @@
|
|||
;; Ouch, a gate closed on the player!
|
||||
(unless ($ obj 'open?)
|
||||
($ alive? #f)
|
||||
($ event '(die))))
|
||||
($ grid-info 'append-event `(player-death ,x ,y))))
|
||||
(_ (lp rest)))))))))
|
||||
(('enter obj grid-info) #f)
|
||||
(('exit obj grid-info) #f)
|
||||
|
|
@ -461,35 +471,44 @@
|
|||
(('alive?) ($ alive?))
|
||||
(('describe) `(player ,($ position), ($ alive?)))
|
||||
(('collide other offset grid-info)
|
||||
(define (reverse-move)
|
||||
(match ($ position)
|
||||
(#(x y z)
|
||||
(match ($ position)
|
||||
(#(x y z)
|
||||
(define (reverse-move)
|
||||
(match offset
|
||||
(#(dx dy)
|
||||
($ position (vector (- x dx) (- y dy) z)))))))
|
||||
(match ($ other 'type)
|
||||
('exit ($ event '(exit)))
|
||||
('block
|
||||
(if ($ other 'pushed?)
|
||||
($ event '(push))
|
||||
(begin
|
||||
(reverse-move)
|
||||
($ event '(bump)))))
|
||||
('switch ($ event '(switch)))
|
||||
('gem ($ event '(gem)))
|
||||
('ghost-gem #t)
|
||||
('gate
|
||||
(unless ($ other 'open?)
|
||||
(reverse-move)
|
||||
($ event '(bump))))
|
||||
(_
|
||||
(reverse-move)
|
||||
($ event '(bump)))))
|
||||
(('event) ($ event))))
|
||||
($ position (vector (- x dx) (- y dy) z)))))
|
||||
(match ($ other 'type)
|
||||
('exit
|
||||
($ grid-info 'append-event `(exit ,x ,y)))
|
||||
('block
|
||||
(if ($ other 'pushed?)
|
||||
($ grid-info 'append-event `(push ,x ,y))
|
||||
(begin
|
||||
(reverse-move)
|
||||
($ grid-info 'append-event `(bump ,x ,y)))))
|
||||
((or 'gem 'switch 'ghost-gem) #t)
|
||||
('gate
|
||||
(unless ($ other 'open?)
|
||||
(reverse-move)
|
||||
($ grid-info 'append-event `(bump ,x ,y))))
|
||||
(_
|
||||
(reverse-move)
|
||||
($ grid-info 'append-event `(bump ,x ,y)))))))))
|
||||
|
||||
(define (^event-log bcom)
|
||||
(define events (spawn ^cell '()))
|
||||
(match-lambda*
|
||||
(('append event)
|
||||
($ events (cons event ($ events))))
|
||||
(('flush)
|
||||
(let ((result (reverse ($ events))))
|
||||
($ events '())
|
||||
result))))
|
||||
|
||||
(define (^level bcom width height)
|
||||
(define player (spawn ^cell))
|
||||
(define objects (spawn ^cell '()))
|
||||
(define event-log (spawn ^event-log))
|
||||
|
||||
;; Spatial partition
|
||||
(define (for-each-coord proc)
|
||||
|
|
@ -569,7 +588,9 @@
|
|||
(('wireworld-neighbor-count x y)
|
||||
(neighbor-count x y))
|
||||
(('wireworld-neighbor-grid x y)
|
||||
(neighbor-grid x y))))
|
||||
(neighbor-grid x y))
|
||||
(('append-event event)
|
||||
($ event-log 'append event))))
|
||||
(define grid-info (spawn ^grid-info))
|
||||
|
||||
(define (delq item lst)
|
||||
|
|
@ -667,4 +688,6 @@
|
|||
(match ($ obj 'position)
|
||||
(#(x y _)
|
||||
(let ((cell (grid-ref grid x y)))
|
||||
($ cell (cons obj ($ cell)))))))))
|
||||
($ cell (cons obj ($ cell)))))))
|
||||
(('flush-events)
|
||||
($ event-log 'flush))))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue