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

Refactor logic gates to reduce code duplication

Browse source
This commit is contained in:
Juliana Sims 2024-05-23 13:19:20 -04:00
parent 50b6c67db8
commit 91ba2fab66
1 changed files with 75 additions and 94 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

169
modules/game/actors.scm
View file

@ -353,7 +353,7 @@
(('describe) `(gate ,position ,($ open?)))
(('collide other offset grid-info) #f)))
(define (^and-gate bcom x y)
(define (^logic-gate bcom x y name update-wire-state)
(define position (vector x y 0))
(define state (spawn ^cell 'copper))
(match-lambda*
@ -365,105 +365,86 @@
(('exit obj grid-info) #f)
(('wire-state grid-info) ($ 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 ($ grid-info 'wireworld-neighbor-grid x y)
(#('electron-head #f #f
#f _ 'copper
'electron-head #f #f)
($ state 'electron-head))
(_ ($ state 'copper))))))
(update-wire-state state grid-info))
(('alive?) #t)
(('describe) `(and-gate ,position ,($ state)))
(('describe) `(,name ,position ,($ state)))
(('collide other offset grid-info) #f)))
(define (^and-gate bcom x y)
(define (update-wire-state 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 ($ grid-info 'wireworld-neighbor-grid x y)
(#('electron-head #f #f
#f _ 'copper
'electron-head #f #f)
($ state 'electron-head))
(_ ($ state 'copper))))))
(^logic-gate bcom x y 'and-gate update-wire-state))
(define (^xor-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)
(('post-tick grid-info) #f)
(('enter obj grid-info) #f)
(('exit obj grid-info) #f)
(('wire-state grid-info) ($ 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 ($ grid-info 'wireworld-neighbor-grid x y)
(#('electron-head #f #f
#f _ 'copper
#f #f #f)
($ state 'electron-head))
(#('electron-head #f #f
#f _ 'copper
'copper #f #f)
($ state 'electron-head))
(#(#f #f #f
#f _ 'copper
'electron-head #f #f)
($ state 'electron-head))
(#('copper #f #f
#f _ 'copper
'electron-head #f #f)
($ state 'electron-head))
(_ ($ state 'copper))))))
(('alive?) #t)
(('describe) `(xor-gate ,position ,($ state)))
(('collide other offset grid-info) #f)))
(define (update-wire-state 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 ($ grid-info 'wireworld-neighbor-grid x y)
(#('electron-head #f #f
#f _ 'copper
#f #f #f)
($ state 'electron-head))
(#('electron-head #f #f
#f _ 'copper
'copper #f #f)
($ state 'electron-head))
(#(#f #f #f
#f _ 'copper
'electron-head #f #f)
($ state 'electron-head))
(#('copper #f #f
#f _ 'copper
'electron-head #f #f)
($ state 'electron-head))
(_ ($ state 'copper))))))
(^logic-gate bcom x y 'xor-gate update-wire-state))
(define (^or-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)
(('post-tick grid-info) #f)
(('enter obj grid-info) #f)
(('exit obj grid-info) #f)
(('wire-state grid-info) ($ 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 ($ grid-info 'wireworld-neighbor-grid x y)
(#('electron-head #f #f
#f _ 'copper
#f #f #f)
($ state 'electron-head))
(#('electron-head #f #f
#f _ 'copper
'copper #f #f)
($ state 'electron-head))
(#(#f #f #f
#f _ 'copper
'electron-head #f #f)
($ state 'electron-head))
(#('copper #f #f
#f _ 'copper
'electron-head #f #f)
($ state 'electron-head))
(#('electron-head #f #f
#f _ 'copper
'electron-head #f #f)
($ state 'electron-head))
(_ ($ state 'copper))))))
(('alive?) #t)
(('describe) `(or-gate ,position ,($ state)))
(('collide other offset grid-info) #f)))
(define (update-wire-state 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 ($ grid-info 'wireworld-neighbor-grid x y)
(#('electron-head #f #f
#f _ 'copper
#f #f #f)
($ state 'electron-head))
(#('electron-head #f #f
#f _ 'copper
'copper #f #f)
($ state 'electron-head))
(#(#f #f #f
#f _ 'copper
'electron-head #f #f)
($ state 'electron-head))
(#('copper #f #f
#f _ 'copper
'electron-head #f #f)
($ state 'electron-head))
(#('electron-head #f #f
#f _ 'copper
'electron-head #f #f)
($ state 'electron-head))
(_ ($ state 'copper))))))
(^logic-gate bcom x y 'or-gate update-wire-state))
(define (^player bcom x y)
(define position (spawn ^cell (vector x y 2)))