diff --git a/assets/sounds/electric-switch-off.wav b/assets/sounds/electric-switch-off.wav new file mode 100644 index 0000000..1cedccb Binary files /dev/null and b/assets/sounds/electric-switch-off.wav differ diff --git a/assets/sounds/electric-switch-on.wav b/assets/sounds/electric-switch-on.wav new file mode 100644 index 0000000..8066cf1 Binary files /dev/null and b/assets/sounds/electric-switch-on.wav differ diff --git a/game.scm b/game.scm index 6155e35..0617be8 100644 --- a/game.scm +++ b/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) diff --git a/modules/game/actors.scm b/modules/game/actors.scm index 07d22e5..88f99d0 100644 --- a/modules/game/actors.scm +++ b/modules/game/actors.scm @@ -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))))