Add bombs and explodable bricks

This commit is contained in:
Juliana Sims 2024-05-24 12:46:15 -04:00
parent 23f034a868
commit feb5b8f3d6
No known key found for this signature in database
GPG key ID: 2A00BD4B0090029E
6 changed files with 86 additions and 2 deletions

View file

@ -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?))

View file

@ -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))

View file

@ -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

View file

@ -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,

View file

@ -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>

View file

@ -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))))