Add ^switched-emitter, test in level 4

This commit is contained in:
Juliana Sims 2024-05-22 15:28:42 -04:00
parent aa8a302fcb
commit 50b6c67db8
6 changed files with 50 additions and 2 deletions

View file

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

View file

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

View file

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

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="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>

View file

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

View file

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