diff --git a/game.scm b/game.scm index 3eaf110..77f8a8d 100644 --- a/game.scm +++ b/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)) diff --git a/modules/game/actors.scm b/modules/game/actors.scm index 6ce8ba5..4f53b8f 100644 --- a/modules/game/actors.scm +++ b/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 diff --git a/modules/game/level.scm b/modules/game/level.scm index 846c36e..75f93b3 100644 --- a/modules/game/level.scm +++ b/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 diff --git a/modules/game/levels/level-4.tmx b/modules/game/levels/level-4.tmx index 40db31d..ad44008 100644 --- a/modules/game/levels/level-4.tmx +++ b/modules/game/levels/level-4.tmx @@ -1,5 +1,5 @@ - + @@ -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 @@ + + + + + + diff --git a/modules/game/levels/tiles.tsx b/modules/game/levels/tiles.tsx index f6e3cac..31efecd 100644 --- a/modules/game/levels/tiles.tsx +++ b/modules/game/levels/tiles.tsx @@ -12,6 +12,7 @@ + diff --git a/scripts/compile-map.scm b/scripts/compile-map.scm index e670d28..0c5d197 100644 --- a/scripts/compile-map.scm +++ b/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)))))