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?))) (('describe) `(gate ,position ,($ open?)))
(('collide other offset grid-info) #f))) (('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 position (vector x y 0))
(define state (spawn ^cell 'copper)) (define state (spawn ^cell 'copper))
(match-lambda* (match-lambda*
@ -365,105 +365,86 @@
(('exit obj grid-info) #f) (('exit obj grid-info) #f)
(('wire-state grid-info) ($ state)) (('wire-state grid-info) ($ state))
(('update-wire-state grid-info) (('update-wire-state grid-info)
(match ($ state) (update-wire-state state grid-info))
('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))))))
(('alive?) #t) (('alive?) #t)
(('describe) `(and-gate ,position ,($ state))) (('describe) `(,name ,position ,($ state)))
(('collide other offset grid-info) #f))) (('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 (^xor-gate bcom x y)
(define position (vector x y 0)) (define (update-wire-state state grid-info)
(define state (spawn ^cell 'copper)) (match ($ state)
(match-lambda* ('electron-head ($ state 'electron-tail))
(('type) 'emitter) ('electron-tail ($ state 'copper))
(('position) position) ('copper
(('tick grid-info) #f) ;; TODO: Match other shapes? This only allows left-to-right
(('post-tick grid-info) #f) ;; circuit flow.
(('enter obj grid-info) #f) (match ($ grid-info 'wireworld-neighbor-grid x y)
(('exit obj grid-info) #f) (#('electron-head #f #f
(('wire-state grid-info) ($ state)) #f _ 'copper
(('update-wire-state grid-info) #f #f #f)
(match ($ state) ($ state 'electron-head))
('electron-head ($ state 'electron-tail)) (#('electron-head #f #f
('electron-tail ($ state 'copper)) #f _ 'copper
('copper 'copper #f #f)
;; TODO: Match other shapes? This only allows left-to-right ($ state 'electron-head))
;; circuit flow. (#(#f #f #f
(match ($ grid-info 'wireworld-neighbor-grid x y) #f _ 'copper
(#('electron-head #f #f 'electron-head #f #f)
#f _ 'copper ($ state 'electron-head))
#f #f #f) (#('copper #f #f
($ state 'electron-head)) #f _ 'copper
(#('electron-head #f #f 'electron-head #f #f)
#f _ 'copper ($ state 'electron-head))
'copper #f #f) (_ ($ state 'copper))))))
($ state 'electron-head)) (^logic-gate bcom x y 'xor-gate update-wire-state))
(#(#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 (^or-gate bcom x y) (define (^or-gate bcom x y)
(define position (vector x y 0)) (define (update-wire-state state grid-info)
(define state (spawn ^cell 'copper)) (match ($ state)
(match-lambda* ('electron-head ($ state 'electron-tail))
(('type) 'emitter) ('electron-tail ($ state 'copper))
(('position) position) ('copper
(('tick grid-info) #f) ;; TODO: Match other shapes? This only allows left-to-right
(('post-tick grid-info) #f) ;; circuit flow.
(('enter obj grid-info) #f) (match ($ grid-info 'wireworld-neighbor-grid x y)
(('exit obj grid-info) #f) (#('electron-head #f #f
(('wire-state grid-info) ($ state)) #f _ 'copper
(('update-wire-state grid-info) #f #f #f)
(match ($ state) ($ state 'electron-head))
('electron-head ($ state 'electron-tail)) (#('electron-head #f #f
('electron-tail ($ state 'copper)) #f _ 'copper
('copper 'copper #f #f)
;; TODO: Match other shapes? This only allows left-to-right ($ state 'electron-head))
;; circuit flow. (#(#f #f #f
(match ($ grid-info 'wireworld-neighbor-grid x y) #f _ 'copper
(#('electron-head #f #f 'electron-head #f #f)
#f _ 'copper ($ state 'electron-head))
#f #f #f) (#('copper #f #f
($ state 'electron-head)) #f _ 'copper
(#('electron-head #f #f 'electron-head #f #f)
#f _ 'copper ($ state 'electron-head))
'copper #f #f) (#('electron-head #f #f
($ state 'electron-head)) #f _ 'copper
(#(#f #f #f 'electron-head #f #f)
#f _ 'copper ($ state 'electron-head))
'electron-head #f #f) (_ ($ state 'copper))))))
($ state 'electron-head)) (^logic-gate bcom x y 'or-gate update-wire-state))
(#('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 (^player bcom x y) (define (^player bcom x y)
(define position (spawn ^cell (vector x y 2))) (define position (spawn ^cell (vector x y 2)))