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

Add basic AND gate and electric switch.

Browse source
This commit is contained in:
David Thompson 2024-05-22 08:00:39 -04:00
parent ff242fd1a5
commit 5756844161
5 changed files with 105 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

89
modules/game/actors.scm
View file

@ -9,6 +9,8 @@
^floor-switch
^gate
^gem
^and-gate
^electric-switch
^player
^level))
@ -134,10 +136,18 @@
'copper))))
(('update-wire-state grid-info) #f)
(('alive?) #t)
(('set-wire-state type) #f)
(('describe) `(clock-emitter ,position))
(('collide other offset grid-info) #f)))
(define (first-non-player-occupant grid-info x y)
(let lp ((objs ($ grid-info 'occupants x y)))
(match objs
(() #f)
((obj . rest)
(if (eq? ($ obj 'type) 'player)
(lp rest)
obj)))))
(define (^floor-switch bcom x y target-x target-y)
(define position (vector x y 0))
(define on? (spawn ^cell))
@ -149,21 +159,49 @@
($ on? #t))
(('exit obj grid-info)
(when (= (length ($ grid-info 'occupants x y)) 1)
($ on? #f)
(match ($ grid-info 'occupants target-x target-y)
(() (pk "no switch target!"))
((target . _)
($ target 'deactivate)))))
($ on? #f)
(match (first-non-player-occupant grid-info target-x target-y)
(#f (pk "no switch target!"))
(target ($ target 'deactivate)))))
(('wire-state) #f)
(('update-wire-state grid-info) #f)
(('alive?) #t)
(('describe) `(floor-switch ,position ,($ on?)))
(('collide other offset grid-info)
($ on? #t)
(match ($ grid-info 'occupants target-x target-y)
(() (pk "no switch target!"))
((target . _)
($ target 'activate))))))
($ on? #t)
(match (first-non-player-occupant grid-info target-x target-y)
(#f (pk "no switch target!"))
(target ($ target 'activate))))))
(define (^electric-switch bcom x y target-x target-y)
(define position (vector x y 0))
(define on? (spawn ^cell))
(define timer (spawn ^cell))
(match-lambda*
(('type) 'switch)
(('position) position)
(('tick grid-info) #f)
(('enter obj grid-info) #f)
(('exit obj grid-info) #f)
(('wire-state) #f)
(('update-wire-state grid-info)
(if ($ on?)
(let ((t (1- ($ timer))))
($ timer t)
(when (= t 0)
($ on? #f)
(match (first-non-player-occupant grid-info target-x target-y)
(#f (pk "no switch target!"))
(target ($ 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))))))
(('alive?) #t)
(('describe) `(electric-switch ,position ,($ on?)))
(('collide other offset grid-info) #f)))
(define (^gem bcom x y)
(define position (vector x y 1))
@ -200,6 +238,35 @@
(('describe) `(gate ,position ,($ open?)))
(('collide other offset grid-info) #f)))
(define (^and-gate bcom x y)
(define position (vector x y 0))
(define state (spawn ^cell 'copper))
(match-lambda*
(('type) 'emitter)
(('position) position)
(('tick grid-info) #f)
(('enter obj grid-info) #f)
(('exit obj grid-info) #f)
(('wire-state) ($ state))
(('update-wire-state grid-info)
(match ($ state)
('electron-head ($ state 'electron-tail))
('electron-tail ($ state 'copper))
('copper
;; TODO: Match other shapes? This only allows left-to-right
;; circuit flow.
(match (pk 'GRID ($ grid-info 'wireworld-neighbor-grid x y))
(#('electron-head #f #f
#f _ 'copper
'electron-head #f #f)
(pk 'COOL)
($ state 'electron-head))
(_ ($ state 'copper)))))
(pk 'NEW-STATE ($ state)))
(('alive?) #t)
(('describe) `(and-gate ,position))
(('collide other offset grid-info) #f)))
(define (^player bcom x y)
(define position (spawn ^cell (vector x y 2)))
(define velocity (spawn ^cell #(0 0)))