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
Download patch file Download diff file Expand all files Collapse all files

93
modules/game/actors.scm
View file

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