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