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

Allow block to be pushed onto tile with gate that is being switched on/off.

Browse source
This commit is contained in:
David Thompson 2024-05-25 13:51:23 -04:00
parent 3e79c279a8
commit 049e859dac
1 changed files with 21 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

40
modules/game/actors.scm
View file

@ -128,6 +128,8 @@
(('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)
(('activate grid-info) #f)
(('deactivate grid-info) #f)
(('wire-state grid-info from from-x from-y) (('wire-state grid-info from from-x from-y)
(match type (match type
((or 'copper 'electron-head 'electron-tail) ((or 'copper 'electron-head 'electron-tail)
@ -228,14 +230,14 @@
(('describe) `(switched-emitter ,position ,(wire-state))) (('describe) `(switched-emitter ,position ,(wire-state)))
(('collide other offset grid-info) #f))) (('collide other offset grid-info) #f)))
(define (first-non-player-occupant grid-info x y) (define (non-player-occupants grid-info x y)
(let lp ((objs ($ grid-info 'occupants x y))) (let lp ((objs ($ grid-info 'occupants x y)))
(match objs (match objs
(() #f) (() '())
((obj . rest) ((obj . rest)
(if (eq? ($ obj 'type) 'player) (if (eq? ($ obj 'type) 'player)
(lp rest) (lp rest)
obj))))) (cons obj (lp rest)))))))
(define (^floor-switch bcom x y target-x target-y) (define (^floor-switch bcom x y target-x target-y)
(define position (vector x y 0)) (define position (vector x y 0))
@ -250,22 +252,20 @@
(('exit obj grid-info) (('exit obj grid-info)
(when (= (length ($ grid-info 'occupants x y)) 1) (when (= (length ($ grid-info 'occupants x y)) 1)
($ on? #f) ($ on? #f)
(match (first-non-player-occupant grid-info target-x target-y) (for-each (lambda (obj)
(#f (pk "no switch target!"))
(target
($ grid-info 'append-event `(floor-switch-off ,x ,y)) ($ grid-info 'append-event `(floor-switch-off ,x ,y))
($ target 'deactivate grid-info))))) ($ obj 'deactivate grid-info))
(non-player-occupants grid-info target-x target-y))))
(('wire-state grid-info from from-x from-y) #f) (('wire-state grid-info from from-x from-y) #f)
(('update-wire-state grid-info neighbor-grid) #f) (('update-wire-state grid-info neighbor-grid) #f)
(('alive?) #t) (('alive?) #t)
(('describe) `(floor-switch ,position ,($ on?))) (('describe) `(floor-switch ,position ,($ on?)))
(('collide other offset grid-info) (('collide other offset grid-info)
($ on? #t) ($ on? #t)
(match (first-non-player-occupant grid-info target-x target-y) (for-each (lambda (obj)
(#f (pk "no switch target!"))
(target
($ grid-info 'append-event `(floor-switch-on ,x ,y)) ($ grid-info 'append-event `(floor-switch-on ,x ,y))
($ target 'activate grid-info)))))) ($ obj 'activate grid-info))
(non-player-occupants grid-info target-x target-y)))))
(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))
@ -285,19 +285,17 @@
($ timer t) ($ timer t)
(when (= t 0) (when (= t 0)
($ on? #f) ($ on? #f)
(match (first-non-player-occupant grid-info target-x target-y) (for-each (lambda (obj)
(#f (pk "no switch target!")) ($ grid-info 'append-event `(electic-switch-off ,x ,y))
(target ($ obj 'deactivate grid-info))
($ grid-info 'append-event `(electric-switch-off ,x ,y)) (non-player-occupants grid-info target-x target-y))))
($ target 'deactivate grid-info)))))
(when (>= (electron-head-count neighbor-grid) 1) (when (>= (electron-head-count neighbor-grid) 1)
($ on? #t) ($ on? #t)
($ timer 2) ($ timer 2)
(match (first-non-player-occupant grid-info target-x target-y) (for-each (lambda (obj)
(#f (pk "no switch target!")) ($ grid-info 'append-event `(electic-switch-on ,x ,y))
(target ($ obj 'activate grid-info))
($ grid-info 'append-event `(electric-switch-on ,x ,y)) (non-player-occupants grid-info target-x target-y)))))
($ target 'activate grid-info))))))
(('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)))