diff --git a/modules/game/actors.scm b/modules/game/actors.scm
index 8bd0ca5..b65b653 100644
--- a/modules/game/actors.scm
+++ b/modules/game/actors.scm
@@ -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))
diff --git a/modules/game/level.scm b/modules/game/level.scm
index 75f93b3..5990a0d 100644
--- a/modules/game/level.scm
+++ b/modules/game/level.scm
@@ -74,15 +74,18 @@
(spawn ^ghost-gem x y)
(spawn ^gem x y)))
(10 (spawn ^gate x y))
- (11 (spawn ^and-gate x y))
+ (11 (spawn ^and-gate x y
+ (bytevector-u8-ref objects (+ i 3))))
(12 (let ((target-x (bytevector-u8-ref objects (+ i 3)))
(target-y (bytevector-u8-ref objects (+ i 4))))
(spawn ^electric-switch x y target-x target-y)))
- (13 (spawn ^xor-gate x y))
+ (13 (spawn ^xor-gate x y
+ (bytevector-u8-ref objects (+ i 3))))
(14 (let ((target-x (bytevector-u8-ref objects (+ i 3)))
(target-y (bytevector-u8-ref objects (+ i 4))))
(spawn ^electron-warp x y target-x target-y)))
- (15 (spawn ^or-gate x y))
+ (15 (spawn ^or-gate x y
+ (bytevector-u8-ref objects (+ i 3))))
(16 (spawn ^switched-emitter x y 4))
(id (error "invalid level object" id))))
(i* (+ i (match id
@@ -90,6 +93,7 @@
;; electric-switch
;; electron-warp
((or 8 12 14) 5)
+ ((or 11 13 15) 4)
(_ 3)))))
(when obj
($ level* 'add-object obj))
diff --git a/modules/game/levels/level-3.tmx b/modules/game/levels/level-3.tmx
index f44c48b..cc1d396 100644
--- a/modules/game/levels/level-3.tmx
+++ b/modules/game/levels/level-3.tmx
@@ -34,7 +34,11 @@
-
+
-
-
-
+
+
+