Add electron warp terminals.
This commit is contained in:
David Thompson
parent
747a1d285a
commit
9b88cb19c0
6 changed files with 154 additions and 22 deletions
7
game.scm
7
game.scm
|
|
@ -301,6 +301,10 @@
|
|||
(define (draw-electric-switch pos on?)
|
||||
(draw-tile context tileset (if on? 7 6) (vec2-x pos) (vec2-y pos)))
|
||||
|
||||
(define (draw-electron-warp pos state)
|
||||
(draw-tile context tileset 71 (vec2-x pos) (vec2-y pos))
|
||||
(draw-wire-state pos state))
|
||||
|
||||
(define (draw-object obj)
|
||||
(match obj
|
||||
(#f #f)
|
||||
|
|
@ -315,7 +319,8 @@
|
|||
(('and-gate pos state) (draw-logic-gate pos state 42))
|
||||
(('or-gate pos state) (draw-logic-gate pos state 43))
|
||||
(('xor-gate pos state) (draw-logic-gate pos state 44))
|
||||
(('electric-switch pos on?) (draw-electric-switch pos on?))))
|
||||
(('electric-switch pos on?) (draw-electric-switch pos on?))
|
||||
(('electron-warp pos state) (draw-electron-warp pos state))))
|
||||
|
||||
(define (draw-background)
|
||||
(let ((bg (level-background *level*))
|
||||
|
|
|
|||
|
|
@ -13,6 +13,7 @@
|
|||
^xor-gate
|
||||
^or-gate
|
||||
^electric-switch
|
||||
^electron-warp
|
||||
^player
|
||||
^level))
|
||||
|
||||
|
|
@ -31,9 +32,6 @@
|
|||
((new-val)
|
||||
(bcom (^cell bcom new-val)))))
|
||||
|
||||
;; TODO: Add layer info to 'describe' output for sorting sprites when
|
||||
;; rendering.
|
||||
|
||||
;; TODO: Port actor-lib methods and use it.
|
||||
(define (^exit bcom x y)
|
||||
(define position (vector x y 1))
|
||||
|
|
@ -211,6 +209,47 @@
|
|||
(('describe) `(electric-switch ,position ,($ on?)))
|
||||
(('collide other offset grid-info) #f)))
|
||||
|
||||
(define (^electron-warp bcom x y target-x target-y)
|
||||
(define position (vector x y 0))
|
||||
(define state (spawn ^cell 'copper))
|
||||
(define electron? (spawn ^cell))
|
||||
(define (find-receiver grid-info)
|
||||
(let lp ((objs ($ grid-info 'occupants target-x target-y)))
|
||||
(match objs
|
||||
(() (error "no electron receiver at tile" target-x target-y))
|
||||
((obj . rest)
|
||||
(if (eq? ($ obj 'type) 'electron-warp)
|
||||
obj
|
||||
(lp rest))))))
|
||||
(match-lambda*
|
||||
(('type) 'electron-warp)
|
||||
(('position) position)
|
||||
(('tick grid-info) #f)
|
||||
(('post-tick grid-info) #f)
|
||||
(('enter obj grid-info) #f)
|
||||
(('exit obj grid-info) #f)
|
||||
(('wire-state grid-info) ($ state))
|
||||
(('update-wire-state grid-info)
|
||||
(match ($ state)
|
||||
('electron-head ($ state 'electron-tail))
|
||||
('electron-tail ($ state 'copper))
|
||||
('copper
|
||||
(if ($ electron?)
|
||||
(begin
|
||||
($ state 'electron-head)
|
||||
($ electron? #f))
|
||||
(let ((neighbors ($ grid-info 'wireworld-neighbor-count x y)))
|
||||
(if (<= 1 neighbors 2)
|
||||
(begin
|
||||
($ state 'electron-head)
|
||||
;; Forward an electron head to the receiver.
|
||||
($ (find-receiver grid-info) 'give-electron))
|
||||
($ state 'copper)))))))
|
||||
(('give-electron) ($ electron? #t))
|
||||
(('alive?) #t)
|
||||
(('describe) `(electron-warp ,position ,($ state)))
|
||||
(('collide other offset grid-info) #f)))
|
||||
|
||||
(define (^gem bcom x y)
|
||||
(define position (vector x y 1))
|
||||
(define picked-up? (spawn ^cell))
|
||||
|
|
@ -403,7 +442,6 @@
|
|||
(('enter obj grid-info) #f)
|
||||
(('exit obj grid-info) #f)
|
||||
(('wire-state grid-info) #f)
|
||||
(('update-wire-state grid-info) #f)
|
||||
(('alive?) ($ alive?))
|
||||
(('describe) `(player ,($ position)))
|
||||
(('collide other offset grid-info)
|
||||
|
|
@ -468,7 +506,9 @@
|
|||
(match ($ obj-cell)
|
||||
(() #f)
|
||||
;; TODO: Handle tiles with many occupants. Might not be
|
||||
;; necessary in practice.
|
||||
;; necessary in practice. Actually this *WILL* cause
|
||||
;; problems for electron warps, at least, since they are
|
||||
;; invisible and the player can stand over them.
|
||||
((refr . _)
|
||||
($ wire-cell ($ refr 'wire-state grid-info))))))))
|
||||
(define (wire-state-at x y)
|
||||
|
|
|
|||
|
|
@ -77,11 +77,16 @@
|
|||
(target-y (bytevector-u8-ref objects (+ i 4))))
|
||||
(spawn ^electric-switch x y target-x target-y)))
|
||||
(13 (spawn ^xor-gate x y))
|
||||
(14 (let ((target-x (bytevector-u8-ref objects (+ i 3)))
|
||||
(target-y (bytevector-u8-ref objects (+ i 4))))
|
||||
(spawn ^electron-warp x y target-x target-y)))
|
||||
(15 (spawn ^or-gate x y))
|
||||
(id (error "invalid level object" id))))
|
||||
(i* (+ i (match id
|
||||
;; floor-switch or electric-switch
|
||||
((or 8 12) 5)
|
||||
;; floor-switch
|
||||
;; electric-switch
|
||||
;; electron-warp
|
||||
((or 8 12 14) 5)
|
||||
(_ 3)))))
|
||||
(when obj
|
||||
($ level* 'add-object obj))
|
||||
|
|
|
|||
|
|
@ -1,21 +1,21 @@
|
|||
<?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="13">
|
||||
<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="23">
|
||||
<tileset firstgid="1" source="tiles.tsx"/>
|
||||
<layer id="1" name="background" width="20" height="15">
|
||||
<data encoding="csv">
|
||||
23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,
|
||||
23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,
|
||||
23,23,24,24,24,24,24,24,24,24,24,24,24,24,23,23,23,23,23,23,
|
||||
23,24,24,24,24,24,24,24,24,24,24,24,24,24,24,23,24,24,24,23,
|
||||
23,24,49,3,3,24,3,3,3,3,3,3,24,24,24,23,24,24,24,23,
|
||||
23,24,24,24,24,24,24,24,24,24,24,24,24,3,24,23,24,24,24,23,
|
||||
23,24,24,24,24,24,49,3,3,3,3,3,24,24,24,24,24,24,24,23,
|
||||
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,24,24,24,24,24,24,24,24,24,24,23,24,28,24,23,
|
||||
23,24,24,24,24,24,24,24,24,24,24,24,24,24,23,23,24,24,24,23,
|
||||
23,24,24,24,24,24,24,24,24,24,24,24,24,24,23,23,24,24,24,23,
|
||||
23,23,24,24,24,24,24,24,24,24,24,24,24,23,23,23,23,23,23,23,
|
||||
23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,
|
||||
81,83,83,82,83,83,83,82,83,83,83,83,82,83,83,84,23,23,23,23,
|
||||
85,24,24,24,24,24,24,24,24,24,24,24,24,24,24,106,81,82,82,84,
|
||||
105,24,24,24,24,24,24,24,24,24,24,24,24,24,24,106,105,24,24,86,
|
||||
105,24,49,3,3,24,3,3,3,3,3,3,24,24,24,106,105,24,24,106,
|
||||
85,24,24,24,24,24,24,24,24,24,24,24,24,3,24,106,105,24,24,106,
|
||||
85,24,24,24,24,24,49,3,3,3,3,3,24,24,24,24,24,24,24,106,
|
||||
85,24,24,24,24,24,24,24,24,24,24,24,24,24,24,106,105,24,24,106,
|
||||
85,24,24,24,24,24,24,24,24,24,24,24,24,24,24,106,105,28,24,86,
|
||||
105,24,24,24,24,24,24,24,24,24,24,24,24,24,81,104,105,24,24,86,
|
||||
105,49,3,3,24,61,61,66,24,24,24,24,24,24,106,23,105,24,24,86,
|
||||
85,24,24,24,24,24,24,64,61,61,24,3,3,24,86,23,101,102,102,104,
|
||||
101,103,103,102,102,102,103,102,103,103,102,102,102,102,104,23,23,23,23,23,
|
||||
23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,
|
||||
23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23
|
||||
</data>
|
||||
|
|
@ -35,5 +35,23 @@
|
|||
</object>
|
||||
<object id="9" type="gate" gid="46" x="240" y="96" width="16" height="16"/>
|
||||
<object id="10" type="and-gate" gid="43" x="192" y="80" width="16" height="16"/>
|
||||
<object id="13" type="electric-switch" gid="8" x="208" y="176" width="16" height="16">
|
||||
<properties>
|
||||
<property name="target-x" type="int" value="11"/>
|
||||
<property name="target-y" type="int" value="10"/>
|
||||
</properties>
|
||||
</object>
|
||||
<object id="21" type="electron-warp" gid="72" x="64" y="160" width="16" height="16">
|
||||
<properties>
|
||||
<property name="target-x" type="int" value="10"/>
|
||||
<property name="target-y" type="int" value="11"/>
|
||||
</properties>
|
||||
</object>
|
||||
<object id="22" type="electron-warp" gid="72" x="160" y="176" width="16" height="16">
|
||||
<properties>
|
||||
<property name="target-x" type="int" value="4"/>
|
||||
<property name="target-y" type="int" value="10"/>
|
||||
</properties>
|
||||
</object>
|
||||
</objectgroup>
|
||||
</map>
|
||||
|
|
|
|||
|
|
@ -13,4 +13,64 @@
|
|||
</tile>
|
||||
<tile id="27" type="exit"/>
|
||||
<tile id="48" type="clock-emitter"/>
|
||||
<tile id="80" type="wall">
|
||||
<properties>
|
||||
<property name="kind" value="brick"/>
|
||||
</properties>
|
||||
</tile>
|
||||
<tile id="81" type="wall">
|
||||
<properties>
|
||||
<property name="kind" value="brick"/>
|
||||
</properties>
|
||||
</tile>
|
||||
<tile id="82" type="wall">
|
||||
<properties>
|
||||
<property name="kind" value="brick"/>
|
||||
</properties>
|
||||
</tile>
|
||||
<tile id="83" type="wall">
|
||||
<properties>
|
||||
<property name="kind" value="brick"/>
|
||||
</properties>
|
||||
</tile>
|
||||
<tile id="84" type="wall">
|
||||
<properties>
|
||||
<property name="kind" value="brick"/>
|
||||
</properties>
|
||||
</tile>
|
||||
<tile id="85" type="wall">
|
||||
<properties>
|
||||
<property name="kind" value="brick"/>
|
||||
</properties>
|
||||
</tile>
|
||||
<tile id="100" type="wall">
|
||||
<properties>
|
||||
<property name="kind" value="brick"/>
|
||||
</properties>
|
||||
</tile>
|
||||
<tile id="101" type="wall">
|
||||
<properties>
|
||||
<property name="kind" value="brick"/>
|
||||
</properties>
|
||||
</tile>
|
||||
<tile id="102" type="wall">
|
||||
<properties>
|
||||
<property name="kind" value="brick"/>
|
||||
</properties>
|
||||
</tile>
|
||||
<tile id="103" type="wall">
|
||||
<properties>
|
||||
<property name="kind" value="brick"/>
|
||||
</properties>
|
||||
</tile>
|
||||
<tile id="104" type="wall">
|
||||
<properties>
|
||||
<property name="kind" value="brick"/>
|
||||
</properties>
|
||||
</tile>
|
||||
<tile id="105" type="wall">
|
||||
<properties>
|
||||
<property name="kind" value="brick"/>
|
||||
</properties>
|
||||
</tile>
|
||||
</tileset>
|
||||
|
|
|
|||
|
|
@ -306,7 +306,7 @@ the default ORIENTATION value of 'orthogonal' is supported."
|
|||
(match type
|
||||
((or 'string 'file) value)
|
||||
('bool (not (string=? value "false")))
|
||||
((or 'int 'float) (string->number value))
|
||||
((or 'int 'float 'object) (string->number value))
|
||||
('color
|
||||
(make-color (parse-color-channel value 3)
|
||||
(parse-color-channel value 5)
|
||||
|
|
@ -560,6 +560,7 @@ the default ORIENTATION value of 'orthogonal' is supported."
|
|||
(define obj:and-gate 11)
|
||||
(define obj:electric-switch 12)
|
||||
(define obj:xor-gate 13)
|
||||
(define obj:electron-warp 14)
|
||||
(define obj:or-gate 15)
|
||||
|
||||
(define (compile-environment-layer tile-map layer-name)
|
||||
|
|
@ -613,6 +614,9 @@ the default ORIENTATION value of 'orthogonal' is supported."
|
|||
('electric-switch (list x y obj:electric-switch
|
||||
(assq-ref properties 'target-x)
|
||||
(assq-ref properties 'target-y)))
|
||||
('electron-warp (list x y obj:electron-warp
|
||||
(assq-ref properties 'target-x)
|
||||
(assq-ref properties 'target-y)))
|
||||
(_ (error "unsupported object type" type)))))
|
||||
(object-layer-objects layer))))
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue