Add bombs and explodable bricks

game.scm

@@ -365,6 +365,10 @@
       (_ (draw-tile context tileset 3 x y)))
     (draw-wire-state pos type)))
 
+(define (draw-brick pos exploding?)
+  ;; TODO use exploding for different sprite?
+  (draw-tile context tileset 22 (vec2-x pos) (vec2-y pos)))
+
 (define (draw-clock-emitter pos)
   (draw-tile context tileset 48 (vec2-x pos) (vec2-y pos)))
 
@@ -374,6 +378,9 @@
 (define (draw-floor-switch pos on?)
   (draw-tile context tileset (if on? 25 24) (vec2-x pos) (vec2-y pos)))
 
+(define (draw-bomb pos exploding?)
+  (draw-tile context tileset (if exploding? 51 50) (vec2-x pos) (vec2-y pos)))
+
 (define (draw-gem pos)
   (draw-tile context tileset 28 (vec2-x pos) (vec2-y pos)))
 
@@ -410,9 +417,11 @@
     (('exit pos) #t)                    ; drawn via background
     (('wall pos type) (draw-wall pos type))
     (('block pos type) (draw-block pos type))
+    (('brick pos exploding?) (draw-brick pos exploding?))
     (('clock-emitter pos) (draw-clock-emitter pos))
     (('switched-emitter pos on?) (draw-switched-emitter pos on?))
     (('floor-switch pos on?) (draw-floor-switch pos on?))
+    (('bomb pos exploding?) (draw-bomb pos exploding?))
     (('gem pos) (draw-gem pos))
     (('ghost-gem pos) (draw-ghost-gem pos))
     (('gate pos open?) (draw-gate pos open?))

modules/game/actors.scm

@@ -9,6 +9,8 @@
             ^switched-emitter
             ^floor-switch
             ^gate
+            ^bomb
+            ^brick
             ^gem
             ^ghost-gem
             ^and-gate
@@ -28,6 +30,13 @@
     ('electron-head 'electron-tail)
     ('electron-tail 'copper)))
 
+(define (grid-electrified? neighbor-grid)
+  (let lp ((i 0))
+    (cond
+     ((= i (vector-length neighbor-grid)) #f)
+     ((eq? (vector-ref neighbor-grid i) 'electron-head) #t)
+     (else (lp (+ i 1))))))
+
 (define (electron-head-count neighbor-grid)
   (define (check state)
     (match state
@@ -92,6 +101,27 @@
     (('describe) `(wall ,position ,type))
     (('collide other offset grid-info) #f)))
 
+(define (^brick bcom x y)
+  (define position (vector x y 1))
+  (define alive? (spawn ^cell #t))
+  (define exploding? (spawn ^cell))
+  (match-lambda*
+    (('type) 'brick)
+    (('position) position)
+    (('tick grid-info) #f)
+    (('post-tick grid-info)
+     (when ($ exploding?)
+       ($ alive? #f)))
+    (('enter obj grid-info) #f)
+    (('exit obj grid-info) #f)
+    (('wire-state grid-info from from-x from-y) #f)
+    (('update-wire-state grid-info neighbor-grid) #f)
+    (('alive?) ($ alive?))
+    (('explode)
+     ($ exploding? #t))
+    (('describe) `(brick ,position ,($ exploding?)))
+    (('collide other offset grid-info) #f)))
+
 ;; TODO: Maybe make separate actors for conductive vs. inert blocks.
 (define (^block bcom x y type)
   (define position (spawn ^cell (vector x y 1)))
@@ -315,6 +345,43 @@
     (('describe) `(electron-warp ,position ,($ state)))
     (('collide other offset grid-info) #f)))
 
+(define (^bomb bcom x y)
+  (define position (vector x y 2))
+  (define alive? (spawn ^cell #t))
+  (define lit? (spawn ^cell))
+  (define exploding? (spawn ^cell))
+  (match-lambda*
+    (('type) 'bomb)
+    (('position) position)
+    (('tick grid-info)
+     (cond
+      (($ exploding?)
+       ($ alive? #f)
+       (do ((ix (- x 1) (+ ix 1)))
+           ((> ix (+ x 1)))
+         (do ((iy (- y 1) (+ iy 1)))
+             ((> iy (+ y 1)))
+           (unless (and (= ix x) (= iy y))
+             (let ((obj (match ($ grid-info 'occupants ix iy)
+                          (() #f)
+                          ((obj . rest) obj))))
+               (when (and obj (eq? ($ obj 'type) 'brick))
+                 ($ obj 'explode)))))))
+      (($ lit?)
+       ($ exploding? #t))
+      (else #f)))
+    (('post-tick grid-info) #f)
+    (('enter obj grid-info) #f)
+    (('exit obj grid-info) #f)
+    (('wire-state grid-info from from-x from-y) #f)
+    (('update-wire-state grid-info neighbor-grid)
+     (when (and (not ($ lit?))
+                (grid-electrified? neighbor-grid))
+       ($ lit? #t)))
+    (('alive?) ($ alive?))
+    (('describe) `(bomb ,position ,($ exploding?)))
+    (('collide other offset grid-info) #f)))
+
 (define (^gem bcom x y)
   (define position (vector x y 1))
   (define picked-up? (spawn ^cell))

modules/game/level.scm

@@ -98,6 +98,8 @@
                                     (bytevector-u8-ref objects (+ i 3)))))
                         (16 (spawn ^switched-emitter x y
                                    (bytevector-u8-ref objects (+ i 3))))
+                        (17 (spawn ^bomb x y))
+                        (18 (spawn ^brick x y))
                         (id (error "invalid level object" id))))
                  (i* (+ i (match id
                             ;; floor-switch

modules/game/levels/level-2.tmx

@@ -10,7 +10,7 @@
 130,209,89,129,211,105,24,24,24,24,24,24,24,24,106,209,211,90,211,149,
 111,89,191,151,151,105,24,24,24,24,24,24,24,24,106,131,150,151,91,149,
 109,191,169,209,89,85,24,24,24,24,24,24,24,24,86,211,130,150,129,190,
-91,171,151,131,211,101,102,102,81,82,24,83,84,102,104,189,211,189,169,109,
+91,171,151,131,211,101,102,102,88,31,24,31,87,102,104,189,211,189,169,109,
 89,170,150,209,131,171,81,83,108,24,24,24,107,84,169,151,131,111,191,191,
 130,129,190,209,91,81,108,24,24,24,24,24,24,107,84,131,111,109,189,211,
 171,190,149,189,211,105,24,24,24,24,24,24,24,24,106,131,129,89,90,170,

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="30">
+<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="33">
  <tileset firstgid="1" source="tiles.tsx"/>
  <layer id="1" name="background" width="20" height="15">
   <data encoding="csv">
@@ -70,5 +70,7 @@
     <property name="interval" type="int" value="4"/>
    </properties>
   </object>
+  <object id="30" type="bomb" gid="51" x="64" y="112" width="16" height="16"/>
+  <object id="31" type="brick" gid="23" x="48" y="112" width="16" height="16"/>
  </objectgroup>
 </map>

scripts/compile-map.scm

@@ -563,6 +563,8 @@ the default ORIENTATION value of 'orthogonal' is supported."
 (define obj:electron-warp 14)
 (define obj:or-gate 15)
 (define obj:switched-emitter 16)
+(define obj:bomb 17)
+(define obj:brick 18)
 
 (define (compile-environment-layer tile-map layer-name)
   (let ((tw (tile-map-tile-width tile-map))
@@ -634,6 +636,8 @@ the default ORIENTATION value of 'orthogonal' is supported."
                       ('electron-warp (list x y obj:electron-warp
                                             (assq-ref properties 'target-x)
                                             (assq-ref properties 'target-y)))
+                      ('bomb (list x y obj:bomb))
+                      ('brick (list x y obj:brick))
                       (_ (error "unsupported object type" type)))))
                 (object-layer-objects layer))))