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

Prepare to support drawing rotated tiles

Browse source
This commit is contained in:
Juliana Sims 2024-05-23 16:36:05 -04:00
parent d68b5d0491
commit 1e91411687
5 changed files with 54 additions and 40 deletions
Download patch file Download diff file Expand all files Collapse all files

39
modules/game/actors.scm
View file

@ -354,7 +354,7 @@
(('describe) `(gate ,position ,($ open?)))
(('collide other offset grid-info) #f)))
(define (^logic-gate bcom x y name update-wire-state)
(define (^logic-gate bcom x y name direction update-wire-state)
(define position (vector x y 0))
(define state (spawn ^cell 'copper))
(match-lambda*
@ -372,51 +372,46 @@
('copper
(update-wire-state state ($ grid-info 'wireworld-neighbor-grid x y)))))
(('alive?) #t)
(('describe) `(,name ,position ,($ state)))
(('describe) `(,name ,position ,direction ,($ state)))
(('collide other offset grid-info) #f)))
(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
('right
(match neighbor-grid
(#('electron-head #f #f
#f _ 'copper
'electron-head #f #f)
($ state 'electron-head))
(_ ($ state 'copper))))
(direction:left
('left
(match neighbor-grid
(#(#f #f 'electron-head
'copper _ #f
#f #f 'electron-head)
($ state 'electron-head))
(_ ($ state 'copper))))
(direction:up
('up
(match neighbor-grid
(#(#f 'copper #f
#f _ #f
'electron-head #f 'electron-head)
($ state 'electron-head))
(_ ($ state 'copper))))
(direction:down
('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))
(^logic-gate bcom x y 'and-gate direction update-wire-state))
(define (^xor-gate bcom x y direction)
(define (update-wire-state state neighbor-grid)
(match direction
(direction:right
('right
(match neighbor-grid
(#('electron-head #f #f
#f _ 'copper
@ -435,7 +430,7 @@
'electron-head #f #f)
($ state 'electron-head))
(_ ($ state 'copper))))
(direction:left
('left
(match neighbor-grid
(#(#f #f 'electron-head
'copper _ #f
@ -454,7 +449,7 @@
#f #f 'electron-head)
($ state 'electron-head))
(_ ($ state 'copper))))
(direction:up
('up
(match neighbor-grid
(#(#f 'copper #f
#f _ #f
@ -473,7 +468,7 @@
'copper #f 'electron-head)
($ state 'electron-head))
(_ ($ state 'copper))))
(direction:down
('down
(match neighbor-grid
(#('electron-head #f #f
#f _ #f
@ -492,12 +487,12 @@
#f 'copper #f)
($ state 'electron-head))
(_ ($ state 'copper))))))
(^logic-gate bcom x y 'xor-gate update-wire-state))
(^logic-gate bcom x y 'xor-gate direction update-wire-state))
(define (^or-gate bcom x y direction)
(define (update-wire-state state neighbor-grid)
(match direction
(direction:right
('right
(match neighbor-grid
(#('electron-head #f #f
#f _ 'copper
@ -520,7 +515,7 @@
'electron-head #f #f)
($ state 'electron-head))
(_ ($ state 'copper))))
(direction:left
('left
(match neighbor-grid
(#(#f #f 'electron-head
'copper _ #f
@ -543,7 +538,7 @@
#f #f 'electron-head)
($ state 'electron-head))
(_ ($ state 'copper))))
(direction:up
('up
(match neighbor-grid
(#(#f 'copper #f
#f _ #f
@ -566,7 +561,7 @@
'electron-head #f 'electron-head)
($ state 'electron-head))
(_ ($ state 'copper))))
(direction:down
('down
(match neighbor-grid
(#('electron-head #f #f
#f _ #f
@ -589,7 +584,7 @@
#f 'copper #f)
($ state 'electron-head))
(_ ($ state 'copper))))))
(^logic-gate bcom x y 'or-gate update-wire-state))
(^logic-gate bcom x y 'or-gate direction update-wire-state))
(define (^player bcom x y)
(define position (spawn ^cell (vector x y 2)))