SuperKamiGuru/foss-mmo
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Allow any actor to push an event to the UI.

Browse source
This commit is contained in:
David Thompson 2024-05-22 21:53:17 -04:00
parent bcb235bd82
commit a24d737bc7
4 changed files with 99 additions and 74 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

BIN
assets/sounds/electric-switch-off.wav Normal file
View file

Binary file not shown.

BIN
assets/sounds/electric-switch-on.wav Normal file
View file

Binary file not shown.

80
game.scm
View file

@ -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)

93
modules/game/actors.scm
View file

@ -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))))