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

Implement orientation for logic gates

Browse source 
Note that orientation is called "direction" because it's named according to the
direction of electron flow.
This commit is contained in:
Juliana Sims 2024-05-23 14:00:55 -04:00
parent 7803eaba1c
commit 73ffad19f0
5 changed files with 219 additions and 38 deletions
Download patch file Download diff file Expand all files Collapse all files

200
modules/game/actors.scm
View file

@ -365,36 +365,58 @@
(('exit obj grid-info) #f)
(('wire-state grid-info) ($ state))
(('update-wire-state grid-info)
(update-wire-state state grid-info))
(match ($ state)
('electron-head ($ state 'electron-tail))
('electron-tail ($ state 'copper))
('copper
(update-wire-state state ($ grid-info 'wireworld-neighbor-grid x y)))))
(('alive?) #t)
(('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)
(define direction:right 1)
(define direction:left 2)
(define direction:up 3)
(define direction:down 4)
(define (^and-gate bcom x y direction)
(define (update-wire-state state neighbor-grid)
(match direction
(direction:right
(match neighbor-grid
(#('electron-head #f #f
#f _ 'copper
'electron-head #f #f)
($ state 'electron-head))
(_ ($ state 'copper))))
(direction:left
(match neighbor-grid
(#(#f #f 'electron-head
'copper _ #f
#f #f 'electron-head)
($ state 'electron-head))
(_ ($ state 'copper))))
(direction:up
(match neighbor-grid
(#(#f 'copper #f
#f _ #f
'electron-head #f 'electron-head)
($ state 'electron-head))
(_ ($ state 'copper))))
(direction:down
(match neighbor-grid
(#('electron-head #f 'electron-head
#f _ #f
#f 'copper #f)
($ state 'electron-head))
(_ ($ state 'copper))))))
(^logic-gate bcom x y 'and-gate update-wire-state))
(define (^xor-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)
(define (^xor-gate bcom x y direction)
(define (update-wire-state state neighbor-grid)
(match direction
(direction:right
(match neighbor-grid
(#('electron-head #f #f
#f _ 'copper
#f #f #f)
@ -411,18 +433,71 @@
#f _ 'copper
'electron-head #f #f)
($ state 'electron-head))
(_ ($ state 'copper))))
(direction:left
(match neighbor-grid
(#(#f #f 'electron-head
'copper _ #f
#f #f #f)
($ state 'electron-head))
(#(#f #f 'electron-head
'copper _ #f
#f #f 'copper)
($ state 'electron-head))
(#(#f #f #f
'copper _ #f
#f #f 'electron-head)
($ state 'electron-head))
(#(#f #f 'copper
'copper _ #f
#f #f 'electron-head)
($ state 'electron-head))
(_ ($ state 'copper))))
(direction:up
(match neighbor-grid
(#(#f 'copper #f
#f _ #f
'electron-head #f #f)
($ state 'electron-head))
(#(#f 'copper #f
#f _ #f
'electron-head #f 'copper)
($ state 'electron-head))
(#(#f 'copper #f
#f _ #f
#f #f 'electron-head)
($ state 'electron-head))
(#(#f 'copper #f
#f _ #f
'copper #f 'electron-head)
($ state 'electron-head))
(_ ($ state 'copper))))
(direction:down
(match neighbor-grid
(#('electron-head #f #f
#f _ #f
#f 'copper #f)
($ state 'electron-head))
(#('electron-head #f 'copper
#f _ #f
#f 'copper #f)
($ state 'electron-head))
(#(#f #f 'electron-head
#f _ #f
#f 'copper #f)
($ state 'electron-head))
(#('copper #f 'electron-head
#f _ #f
#f 'copper #f)
($ state 'electron-head))
(_ ($ state 'copper))))))
(^logic-gate bcom x y 'xor-gate update-wire-state))
(define (^or-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)
(define (^or-gate bcom x y direction)
(define (update-wire-state state neighbor-grid)
(match direction
(direction:right
(match neighbor-grid
(#('electron-head #f #f
#f _ 'copper
#f #f #f)
@ -443,6 +518,75 @@
#f _ 'copper
'electron-head #f #f)
($ state 'electron-head))
(_ ($ state 'copper))))
(direction:left
(match neighbor-grid
(#(#f #f 'electron-head
'copper _ #f
#f #f #f)
($ state 'electron-head))
(#(#f #f 'electron-head
'copper _ #f
#f #f 'copper)
($ state 'electron-head))
(#(#f #f #f
'copper _ #f
#f #f 'electron-head)
($ state 'electron-head))
(#(#f #f 'copper
'copper _ #f
#f #f 'electron-head)
($ state 'electron-head))
(#(#f #f 'electron-head
'copper _ #f
#f #f 'electron-head)
($ state 'electron-head))
(_ ($ state 'copper))))
(direction:up
(match neighbor-grid
(#(#f 'copper #f
#f _ #f
'electron-head #f #f)
($ state 'electron-head))
(#(#f 'copper #f
#f _ #f
'electron-head #f 'copper)
($ state 'electron-head))
(#(#f 'copper #f
#f _ #f
#f #f 'electron-head)
($ state 'electron-head))
(#(#f 'copper #f
#f _ #f
'copper #f 'electron-head)
($ state 'electron-head))
(#(#f 'copper #f
#f _ #f
'electron-head #f 'electron-head)
($ state 'electron-head))
(_ ($ state 'copper))))
(direction:down
(match neighbor-grid
(#('electron-head #f #f
#f _ #f
#f 'copper #f)
($ state 'electron-head))
(#('electron-head #f 'copper
#f _ #f
#f 'copper #f)
($ state 'electron-head))
(#(#f #f 'electron-head
#f _ #f
#f 'copper #f)
($ state 'electron-head))
(#('copper #f 'electron-head
#f _ #f
#f 'copper #f)
($ state 'electron-head))
(#('electron-head #f 'electron-head
#f _ #f
#f 'copper #f)
($ state 'electron-head))
(_ ($ state 'copper))))))
(^logic-gate bcom x y 'or-gate update-wire-state))