diff --git a/game.scm b/game.scm
index eb158b2..d3de151 100644
--- a/game.scm
+++ b/game.scm
@@ -280,17 +280,25 @@
(define (draw-gate pos open?)
(draw-tile context tileset (if open? 46 45) (vec2-x pos) (vec2-y pos)))
+(define (draw-and-gate pos)
+ (draw-tile context tileset 42 (vec2-x pos) (vec2-y pos)))
+
+(define (draw-electric-switch pos on?)
+ (draw-tile context tileset (if on? 7 6) (vec2-x pos) (vec2-y pos)))
+
(define (draw-object obj)
(match obj
(#f #f)
(('player pos) (draw-player pos))
- (('exit pos) #t) ; drawn via background
+ (('exit pos) #t) ; drawn via background
(('wall pos type) (draw-wall pos type))
(('block pos type) (draw-block pos type))
- (('clock-emitter pos) #t) ; drawn via background
+ (('clock-emitter pos) #t) ; drawn via background
(('floor-switch pos on?) (draw-floor-switch pos on?))
(('gem pos) (draw-gem pos))
- (('gate pos open?) (draw-gate pos open?))))
+ (('gate pos open?) (draw-gate pos open?))
+ (('and-gate pos) (draw-and-gate pos))
+ (('electric-switch pos on?) (draw-electric-switch pos on?))))
(define (draw-background)
(let* ((bv (level-background *level*))
diff --git a/modules/game/actors.scm b/modules/game/actors.scm
index e11bd60..8a8d9c1 100644
--- a/modules/game/actors.scm
+++ b/modules/game/actors.scm
@@ -9,6 +9,8 @@
^floor-switch
^gate
^gem
+ ^and-gate
+ ^electric-switch
^player
^level))
@@ -134,10 +136,18 @@
'copper))))
(('update-wire-state grid-info) #f)
(('alive?) #t)
- (('set-wire-state type) #f)
(('describe) `(clock-emitter ,position))
(('collide other offset grid-info) #f)))
+(define (first-non-player-occupant grid-info x y)
+ (let lp ((objs ($ grid-info 'occupants x y)))
+ (match objs
+ (() #f)
+ ((obj . rest)
+ (if (eq? ($ obj 'type) 'player)
+ (lp rest)
+ obj)))))
+
(define (^floor-switch bcom x y target-x target-y)
(define position (vector x y 0))
(define on? (spawn ^cell))
@@ -149,21 +159,49 @@
($ on? #t))
(('exit obj grid-info)
(when (= (length ($ grid-info 'occupants x y)) 1)
- ($ on? #f)
- (match ($ grid-info 'occupants target-x target-y)
- (() (pk "no switch target!"))
- ((target . _)
- ($ target 'deactivate)))))
+ ($ on? #f)
+ (match (first-non-player-occupant grid-info target-x target-y)
+ (#f (pk "no switch target!"))
+ (target ($ target 'deactivate)))))
(('wire-state) #f)
(('update-wire-state grid-info) #f)
(('alive?) #t)
(('describe) `(floor-switch ,position ,($ on?)))
(('collide other offset grid-info)
- ($ on? #t)
- (match ($ grid-info 'occupants target-x target-y)
- (() (pk "no switch target!"))
- ((target . _)
- ($ target 'activate))))))
+ ($ on? #t)
+ (match (first-non-player-occupant grid-info target-x target-y)
+ (#f (pk "no switch target!"))
+ (target ($ target 'activate))))))
+
+(define (^electric-switch bcom x y target-x target-y)
+ (define position (vector x y 0))
+ (define on? (spawn ^cell))
+ (define timer (spawn ^cell))
+ (match-lambda*
+ (('type) 'switch)
+ (('position) position)
+ (('tick grid-info) #f)
+ (('enter obj grid-info) #f)
+ (('exit obj grid-info) #f)
+ (('wire-state) #f)
+ (('update-wire-state grid-info)
+ (if ($ on?)
+ (let ((t (1- ($ timer))))
+ ($ timer t)
+ (when (= t 0)
+ ($ on? #f)
+ (match (first-non-player-occupant grid-info target-x target-y)
+ (#f (pk "no switch target!"))
+ (target ($ target 'deactivate)))))
+ (when (>= ($ grid-info 'wireworld-neighbor-count x y) 1)
+ ($ on? #t)
+ ($ timer 2)
+ (match (first-non-player-occupant grid-info target-x target-y)
+ (#f (pk "no switch target!"))
+ (target ($ target 'activate))))))
+ (('alive?) #t)
+ (('describe) `(electric-switch ,position ,($ on?)))
+ (('collide other offset grid-info) #f)))
(define (^gem bcom x y)
(define position (vector x y 1))
@@ -200,6 +238,35 @@
(('describe) `(gate ,position ,($ open?)))
(('collide other offset grid-info) #f)))
+(define (^and-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)
+ (('enter obj grid-info) #f)
+ (('exit obj grid-info) #f)
+ (('wire-state) ($ 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 (pk 'GRID ($ grid-info 'wireworld-neighbor-grid x y))
+ (#('electron-head #f #f
+ #f _ 'copper
+ 'electron-head #f #f)
+ (pk 'COOL)
+ ($ state 'electron-head))
+ (_ ($ state 'copper)))))
+ (pk 'NEW-STATE ($ state)))
+ (('alive?) #t)
+ (('describe) `(and-gate ,position))
+ (('collide other offset grid-info) #f)))
+
(define (^player bcom x y)
(define position (spawn ^cell (vector x y 2)))
(define velocity (spawn ^cell #(0 0)))
diff --git a/modules/game/level.scm b/modules/game/level.scm
index c7f2f2e..c3b30f3 100644
--- a/modules/game/level.scm
+++ b/modules/game/level.scm
@@ -42,9 +42,14 @@
(spawn ^floor-switch x y target-x target-y)))
(9 (and spawn-gem? (spawn ^gem x y)))
(10 (spawn ^gate x y))
+ (11 (spawn ^and-gate x y))
+ (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)))
(id (error "invalid level object" id))))
(i* (+ i (match id
- (8 5) ; floor-switch
+ ;; floor-switch or electric-switch
+ ((or 8 12) 5)
(_ 3)))))
(when obj
($ level* 'add-object obj))
diff --git a/modules/game/levels/level-3.tmx b/modules/game/levels/level-3.tmx
index 3ecf9a6..cfaacb2 100644
--- a/modules/game/levels/level-3.tmx
+++ b/modules/game/levels/level-3.tmx
@@ -7,7 +7,7 @@
23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,
23,23,24,24,24,24,24,24,24,24,24,24,24,24,23,23,23,23,23,23,
23,24,24,24,24,24,24,24,24,24,24,24,24,24,24,23,24,24,24,23,
-23,49,3,3,3,24,3,3,3,3,3,3,24,24,24,23,24,24,24,23,
+23,24,49,3,3,24,3,3,3,3,3,3,24,24,24,23,24,24,24,23,
23,24,24,24,24,24,24,24,24,24,24,24,24,3,24,23,24,24,24,23,
23,24,24,24,24,24,49,3,3,3,3,3,24,24,24,24,24,24,24,23,
23,24,24,24,24,24,24,24,24,24,24,24,24,24,24,23,24,24,24,23,
@@ -27,13 +27,12 @@
-