Add ^switched-emitter, test in level 4

game.scm

@@ -316,6 +316,9 @@
 (define (draw-clock-emitter pos)
   (draw-tile context tileset 48 (vec2-x pos) (vec2-y pos)))
 
+(define (draw-switched-emitter pos on?)
+  (draw-tile context tileset (if on? 48 47) (vec2-x pos) (vec2-y pos)))
+
 (define (draw-floor-switch pos on?)
   (draw-tile context tileset (if on? 25 24) (vec2-x pos) (vec2-y pos)))
 
@@ -352,6 +355,7 @@
     (('wall pos type) (draw-wall pos type))
     (('block pos type) (draw-block pos type))
     (('clock-emitter pos) #t)           ; drawn via background
+    (('switched-emitter pos on?) (draw-switched-emitter pos on?))
     (('floor-switch pos on?) (draw-floor-switch pos on?))
     (('gem pos) (draw-gem pos))
     (('ghost-gem pos) (draw-ghost-gem pos))

modules/game/actors.scm

@@ -6,6 +6,7 @@
             ^wall
             ^block
             ^clock-emitter
+            ^switched-emitter
             ^floor-switch
             ^gate
             ^gem
@@ -145,6 +146,39 @@
     (('describe) `(clock-emitter ,position))
     (('collide other offset grid-info) #f)))
 
+(define (^switched-emitter bcom x y interval)
+  (define timer (spawn ^cell -1))
+  (define on? (spawn ^cell))
+  (define position (vector x y 0))
+  (match-lambda*
+    (('type) 'switched-emitter)
+    (('position) position)
+    (('tick grid-info)
+     (when ($ on?)
+       ($ timer (+ ($ timer) 1))))
+    (('post-tick grid-info) #f)
+    (('enter obj grid-info) #f)
+    (('exit obj grid-info) #f)
+    (('activate grid-info)
+     ($ on? #t)
+     ($ timer 0))
+    (('deactivate grid-info) ($ on? #f))
+    (('wire-state grid-info)
+     (when ($ on?)
+       (let ((t ($ timer)))
+         (cond
+          ((= (modulo t interval) 0)
+           'electron-head)
+          ((= (modulo t interval) 1)
+           'electron-tail)
+          (else
+           'copper)))))
+    (('update-wire-state grid-info) #f)
+    (('alive?) #t)
+    (('on?) ($ on?))
+    (('describe) `(switched-emitter ,position ,($ on?)))
+    (('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

modules/game/level.scm

@@ -83,6 +83,7 @@
                                   (target-y (bytevector-u8-ref objects (+ i 4))))
                               (spawn ^electron-warp x y target-x target-y)))
                         (15 (spawn ^or-gate x y))
+                        (16 (spawn ^switched-emitter x y 4))
                         (id (error "invalid level object" id))))
                  (i* (+ i (match id
                             ;; floor-switch

modules/game/levels/level-4.tmx

@@ -1,5 +1,5 @@
 <?xml version="1.0" encoding="UTF-8"?>
-<map version="1.8" tiledversion="1.8.6" orientation="orthogonal" renderorder="right-down" width="20" height="15" tilewidth="16" tileheight="16" infinite="0" nextlayerid="3" nextobjectid="18">
+<map version="1.8" tiledversion="1.8.6" orientation="orthogonal" renderorder="right-down" width="20" height="15" tilewidth="16" tileheight="16" infinite="0" nextlayerid="3" nextobjectid="21">
  <tileset firstgid="1" source="tiles.tsx"/>
  <layer id="1" name="background" width="20" height="15">
   <data encoding="csv">
@@ -10,7 +10,7 @@
 23,24,24,24,24,24,24,24,24,24,24,24,24,24,24,23,24,24,24,23,
 23,24,24,24,24,49,3,24,3,24,24,24,24,24,24,23,24,28,24,23,
 23,24,24,24,24,24,24,24,24,24,3,24,24,24,24,23,24,24,24,23,
-23,24,24,24,24,49,3,3,3,24,24,24,3,24,24,24,24,24,24,23,
+23,24,24,24,24,48,3,3,3,24,24,24,3,24,24,24,24,24,24,23,
 23,24,24,24,24,24,24,24,24,24,3,24,24,24,24,23,24,24,24,23,
 23,24,49,3,3,24,3,3,3,24,24,24,24,24,24,23,24,24,24,23,
 23,24,24,24,24,24,24,24,24,24,24,24,24,24,24,23,24,24,24,23,
@@ -37,5 +37,11 @@
   <object id="13" type="xor-gate" gid="45" x="144" y="96" width="16" height="16"/>
   <object id="15" type="and-gate" gid="43" x="176" y="112" width="16" height="16"/>
   <object id="17" type="or-gate" gid="44" x="144" y="128" width="16" height="16"/>
+  <object id="18" type="floor-switch" gid="25" x="112" y="48" width="16" height="16">
+   <properties>
+    <property name="target-x" type="int" value="5"/>
+    <property name="target-y" type="int" value="7"/>
+   </properties>
+  </object>
  </objectgroup>
 </map>

modules/game/levels/tiles.tsx

@@ -12,6 +12,7 @@
   </properties>
  </tile>
  <tile id="27" type="exit"/>
+ <tile id="47" type="switched-emitter"/>
  <tile id="48" type="clock-emitter"/>
  <tile id="80" type="wall">
   <properties>

scripts/compile-map.scm

@@ -562,6 +562,7 @@ the default ORIENTATION value of 'orthogonal' is supported."
 (define obj:xor-gate 13)
 (define obj:electron-warp 14)
 (define obj:or-gate 15)
+(define obj:switched-emitter 16)
 
 (define (compile-environment-layer tile-map layer-name)
   (let ((tw (tile-map-tile-width tile-map))
@@ -582,6 +583,7 @@ the default ORIENTATION value of 'orthogonal' is supported."
                                          (kind (error "unsupported wall kind" kind))))
                                       ("exit" (list x y obj:exit))
                                       ("clock-emitter" (list x y obj:clock-emitter))
+                                      ("switched-emitter" (list x y obj:switched-emitter))
                                       (type (error "unsupported background object" type))))))
                                (iota (tile-layer-width layer)))))
                 (iota (tile-layer-height layer)))))