Add or gate, update level 4 to use all logic gates
This commit is contained in:
parent
c749f22fe8
commit
6b9edbca25
5 changed files with 81 additions and 27 deletions
4
game.scm
4
game.scm
|
@ -298,6 +298,9 @@
|
||||||
(define (draw-and-gate pos)
|
(define (draw-and-gate pos)
|
||||||
(draw-tile context tileset 42 (vec2-x pos) (vec2-y pos)))
|
(draw-tile context tileset 42 (vec2-x pos) (vec2-y pos)))
|
||||||
|
|
||||||
|
(define (draw-or-gate pos)
|
||||||
|
(draw-tile context tileset 43 (vec2-x pos) (vec2-y pos)))
|
||||||
|
|
||||||
(define (draw-xor-gate pos)
|
(define (draw-xor-gate pos)
|
||||||
(draw-tile context tileset 44 (vec2-x pos) (vec2-y pos)))
|
(draw-tile context tileset 44 (vec2-x pos) (vec2-y pos)))
|
||||||
|
|
||||||
|
@ -317,6 +320,7 @@
|
||||||
(('gate pos open?) (draw-gate pos open?))
|
(('gate pos open?) (draw-gate pos open?))
|
||||||
(('and-gate pos) (draw-and-gate pos))
|
(('and-gate pos) (draw-and-gate pos))
|
||||||
(('xor-gate pos) (draw-xor-gate pos))
|
(('xor-gate pos) (draw-xor-gate pos))
|
||||||
|
(('or-gate pos) (draw-or-gate pos))
|
||||||
(('electric-switch pos on?) (draw-electric-switch pos on?))))
|
(('electric-switch pos on?) (draw-electric-switch pos on?))))
|
||||||
|
|
||||||
(define (draw-background)
|
(define (draw-background)
|
||||||
|
|
|
@ -11,6 +11,7 @@
|
||||||
^gem
|
^gem
|
||||||
^and-gate
|
^and-gate
|
||||||
^xor-gate
|
^xor-gate
|
||||||
|
^or-gate
|
||||||
^electric-switch
|
^electric-switch
|
||||||
^player
|
^player
|
||||||
^level))
|
^level))
|
||||||
|
@ -43,7 +44,7 @@
|
||||||
(('post-tick grid-info) #f)
|
(('post-tick grid-info) #f)
|
||||||
(('enter obj grid-info) #f)
|
(('enter obj grid-info) #f)
|
||||||
(('exit obj grid-info) #f)
|
(('exit obj grid-info) #f)
|
||||||
(('wire-state) #f)
|
(('wire-state grid-info) #f)
|
||||||
(('update-wire-state grid-info) #f)
|
(('update-wire-state grid-info) #f)
|
||||||
(('alive?) #t)
|
(('alive?) #t)
|
||||||
(('describe) `(exit ,position))
|
(('describe) `(exit ,position))
|
||||||
|
@ -59,7 +60,7 @@
|
||||||
(('post-tick grid-info) #f)
|
(('post-tick grid-info) #f)
|
||||||
(('enter obj grid-info) #f)
|
(('enter obj grid-info) #f)
|
||||||
(('exit obj grid-info) #f)
|
(('exit obj grid-info) #f)
|
||||||
(('wire-state)
|
(('wire-state grid-info)
|
||||||
(match type
|
(match type
|
||||||
((or 'copper 'electron-head 'electron-tail)
|
((or 'copper 'electron-head 'electron-tail)
|
||||||
type)
|
type)
|
||||||
|
@ -86,7 +87,7 @@
|
||||||
(('post-tick grid-info) #f)
|
(('post-tick grid-info) #f)
|
||||||
(('enter obj grid-info) #f)
|
(('enter obj grid-info) #f)
|
||||||
(('exit obj grid-info) #f)
|
(('exit obj grid-info) #f)
|
||||||
(('wire-state)
|
(('wire-state grid-info)
|
||||||
(match type
|
(match type
|
||||||
((or 'copper 'electron-head 'electron-tail)
|
((or 'copper 'electron-head 'electron-tail)
|
||||||
type)
|
type)
|
||||||
|
@ -130,7 +131,7 @@
|
||||||
(('post-tick grid-info) #f)
|
(('post-tick grid-info) #f)
|
||||||
(('enter obj grid-info) #f)
|
(('enter obj grid-info) #f)
|
||||||
(('exit obj grid-info) #f)
|
(('exit obj grid-info) #f)
|
||||||
(('wire-state)
|
(('wire-state grid-info)
|
||||||
(let ((t ($ timer)))
|
(let ((t ($ timer)))
|
||||||
(cond
|
(cond
|
||||||
((= (modulo t interval) 0)
|
((= (modulo t interval) 0)
|
||||||
|
@ -169,7 +170,7 @@
|
||||||
(match (first-non-player-occupant grid-info target-x target-y)
|
(match (first-non-player-occupant grid-info target-x target-y)
|
||||||
(#f (pk "no switch target!"))
|
(#f (pk "no switch target!"))
|
||||||
(target ($ target 'deactivate)))))
|
(target ($ target 'deactivate)))))
|
||||||
(('wire-state) #f)
|
(('wire-state grid-info) #f)
|
||||||
(('update-wire-state grid-info) #f)
|
(('update-wire-state grid-info) #f)
|
||||||
(('alive?) #t)
|
(('alive?) #t)
|
||||||
(('describe) `(floor-switch ,position ,($ on?)))
|
(('describe) `(floor-switch ,position ,($ on?)))
|
||||||
|
@ -190,7 +191,7 @@
|
||||||
(('post-tick grid-info) #f)
|
(('post-tick grid-info) #f)
|
||||||
(('enter obj grid-info) #f)
|
(('enter obj grid-info) #f)
|
||||||
(('exit obj grid-info) #f)
|
(('exit obj grid-info) #f)
|
||||||
(('wire-state) #f)
|
(('wire-state grid-info) #f)
|
||||||
(('update-wire-state grid-info)
|
(('update-wire-state grid-info)
|
||||||
(if ($ on?)
|
(if ($ on?)
|
||||||
(let ((t (1- ($ timer))))
|
(let ((t (1- ($ timer))))
|
||||||
|
@ -220,7 +221,7 @@
|
||||||
(('post-tick grid-info) #f)
|
(('post-tick grid-info) #f)
|
||||||
(('enter obj grid-info) #f)
|
(('enter obj grid-info) #f)
|
||||||
(('exit obj grid-info) #f)
|
(('exit obj grid-info) #f)
|
||||||
(('wire-state) #f)
|
(('wire-state grid-info) #f)
|
||||||
(('update-wire-state grid-info) #f)
|
(('update-wire-state grid-info) #f)
|
||||||
(('alive?) (not ($ picked-up?)))
|
(('alive?) (not ($ picked-up?)))
|
||||||
(('describe) `(gem ,position))
|
(('describe) `(gem ,position))
|
||||||
|
@ -240,7 +241,7 @@
|
||||||
(('exit obj grid-info) #f)
|
(('exit obj grid-info) #f)
|
||||||
(('activate) ($ open? #t))
|
(('activate) ($ open? #t))
|
||||||
(('deactivate) ($ open? #f))
|
(('deactivate) ($ open? #f))
|
||||||
(('wire-state) #f)
|
(('wire-state grid-info) #f)
|
||||||
(('update-wire-state grid-info) #f)
|
(('update-wire-state grid-info) #f)
|
||||||
(('alive?) #t)
|
(('alive?) #t)
|
||||||
(('open?) ($ open?))
|
(('open?) ($ open?))
|
||||||
|
@ -257,7 +258,7 @@
|
||||||
(('post-tick grid-info) #f)
|
(('post-tick grid-info) #f)
|
||||||
(('enter obj grid-info) #f)
|
(('enter obj grid-info) #f)
|
||||||
(('exit obj grid-info) #f)
|
(('exit obj grid-info) #f)
|
||||||
(('wire-state) ($ state))
|
(('wire-state grid-info) ($ state))
|
||||||
(('update-wire-state grid-info)
|
(('update-wire-state grid-info)
|
||||||
(match ($ state)
|
(match ($ state)
|
||||||
('electron-head ($ state 'electron-tail))
|
('electron-head ($ state 'electron-tail))
|
||||||
|
@ -285,7 +286,7 @@
|
||||||
(('post-tick grid-info) #f)
|
(('post-tick grid-info) #f)
|
||||||
(('enter obj grid-info) #f)
|
(('enter obj grid-info) #f)
|
||||||
(('exit obj grid-info) #f)
|
(('exit obj grid-info) #f)
|
||||||
(('wire-state) ($ state))
|
(('wire-state grid-info) ($ state))
|
||||||
(('update-wire-state grid-info)
|
(('update-wire-state grid-info)
|
||||||
(match ($ state)
|
(match ($ state)
|
||||||
('electron-head ($ state 'electron-tail))
|
('electron-head ($ state 'electron-tail))
|
||||||
|
@ -293,7 +294,7 @@
|
||||||
('copper
|
('copper
|
||||||
;; TODO: Match other shapes? This only allows left-to-right
|
;; TODO: Match other shapes? This only allows left-to-right
|
||||||
;; circuit flow.
|
;; circuit flow.
|
||||||
(match (pk 'xor-grid-info ($ grid-info 'wireworld-neighbor-grid x y))
|
(match ($ grid-info 'wireworld-neighbor-grid x y)
|
||||||
(#('electron-head #f #f
|
(#('electron-head #f #f
|
||||||
#f _ 'copper
|
#f _ 'copper
|
||||||
#f #f #f)
|
#f #f #f)
|
||||||
|
@ -315,6 +316,50 @@
|
||||||
(('describe) `(xor-gate ,position))
|
(('describe) `(xor-gate ,position))
|
||||||
(('collide other offset grid-info) #f)))
|
(('collide other offset grid-info) #f)))
|
||||||
|
|
||||||
|
(define (^or-gate bcom x y)
|
||||||
|
(define position (vector x y 0))
|
||||||
|
(define state (spawn ^cell 'copper))
|
||||||
|
(match-lambda*
|
||||||
|
(('type) 'emitter)
|
||||||
|
(('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
|
||||||
|
;; TODO: Match other shapes? This only allows left-to-right
|
||||||
|
;; circuit flow.
|
||||||
|
(match ($ grid-info 'wireworld-neighbor-grid x y)
|
||||||
|
(#('electron-head #f #f
|
||||||
|
#f _ 'copper
|
||||||
|
#f #f #f)
|
||||||
|
($ state 'electron-head))
|
||||||
|
(#('electron-head #f #f
|
||||||
|
#f _ 'copper
|
||||||
|
'copper #f #f)
|
||||||
|
($ state 'electron-head))
|
||||||
|
(#(#f #f #f
|
||||||
|
#f _ 'copper
|
||||||
|
'electron-head #f #f)
|
||||||
|
($ state 'electron-head))
|
||||||
|
(#('copper #f #f
|
||||||
|
#f _ 'copper
|
||||||
|
'electron-head #f #f)
|
||||||
|
($ state 'electron-head))
|
||||||
|
(#('electron-head #f #f
|
||||||
|
#f _ 'copper
|
||||||
|
'electron-head #f #f)
|
||||||
|
($ state 'electron-head))
|
||||||
|
(_ ($ state 'copper))))))
|
||||||
|
(('alive?) #t)
|
||||||
|
(('describe) `(or-gate ,position))
|
||||||
|
(('collide other offset grid-info) #f)))
|
||||||
|
|
||||||
(define (^player bcom x y)
|
(define (^player bcom x y)
|
||||||
(define position (spawn ^cell (vector x y 2)))
|
(define position (spawn ^cell (vector x y 2)))
|
||||||
(define velocity (spawn ^cell #(0 0)))
|
(define velocity (spawn ^cell #(0 0)))
|
||||||
|
@ -362,7 +407,7 @@
|
||||||
(_ (lp rest)))))))))
|
(_ (lp rest)))))))))
|
||||||
(('enter obj grid-info) #f)
|
(('enter obj grid-info) #f)
|
||||||
(('exit obj grid-info) #f)
|
(('exit obj grid-info) #f)
|
||||||
(('wire-state) #f)
|
(('wire-state grid-info) #f)
|
||||||
(('update-wire-state grid-info) #f)
|
(('update-wire-state grid-info) #f)
|
||||||
(('alive?) ($ alive?))
|
(('alive?) ($ alive?))
|
||||||
(('describe) `(player ,($ position)))
|
(('describe) `(player ,($ position)))
|
||||||
|
@ -429,7 +474,7 @@
|
||||||
;; TODO: Handle tiles with many occupants. Might not be
|
;; TODO: Handle tiles with many occupants. Might not be
|
||||||
;; necessary in practice.
|
;; necessary in practice.
|
||||||
((refr . _)
|
((refr . _)
|
||||||
($ wire-cell ($ refr 'wire-state))))))))
|
($ wire-cell ($ refr 'wire-state grid-info))))))))
|
||||||
(define (wire-state-at x y)
|
(define (wire-state-at x y)
|
||||||
($ (grid-ref/wrap wire-grid x y)))
|
($ (grid-ref/wrap wire-grid x y)))
|
||||||
(define (neighbor-count x y)
|
(define (neighbor-count x y)
|
||||||
|
|
|
@ -47,6 +47,7 @@
|
||||||
(target-y (bytevector-u8-ref objects (+ i 4))))
|
(target-y (bytevector-u8-ref objects (+ i 4))))
|
||||||
(spawn ^electric-switch x y target-x target-y)))
|
(spawn ^electric-switch x y target-x target-y)))
|
||||||
(13 (spawn ^xor-gate x y))
|
(13 (spawn ^xor-gate x y))
|
||||||
|
(15 (spawn ^or-gate x y))
|
||||||
(id (error "invalid level object" id))))
|
(id (error "invalid level object" id))))
|
||||||
(i* (+ i (match id
|
(i* (+ i (match id
|
||||||
;; floor-switch or electric-switch
|
;; floor-switch or electric-switch
|
||||||
|
|
|
@ -1,39 +1,41 @@
|
||||||
<?xml version="1.0" encoding="UTF-8"?>
|
<?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="15">
|
<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">
|
||||||
<tileset firstgid="1" source="tiles.tsx"/>
|
<tileset firstgid="1" source="tiles.tsx"/>
|
||||||
<layer id="1" name="background" width="20" height="15">
|
<layer id="1" name="background" width="20" height="15">
|
||||||
<data encoding="csv">
|
<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,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,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,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,24,24,24,24,24,24,24,24,24,24,24,24,24,23,24,24,24,23,
|
||||||
23,24,49,3,3,3,3,3,3,3,3,3,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,24,24,24,3,24,23,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,3,3,3,24,24,24,24,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,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,
|
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,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,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,
|
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,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,23,23,23,23,23,23,23,23,23,23
|
||||||
</data>
|
</data>
|
||||||
</layer>
|
</layer>
|
||||||
<objectgroup id="2" name="objects">
|
<objectgroup id="2" name="objects">
|
||||||
<object id="1" type="player-spawn" gid="1" x="80" y="128" width="16" height="16"/>
|
<object id="1" type="player-spawn" gid="1" x="80" y="160" width="16" height="16"/>
|
||||||
<object id="4" type="block" gid="4" x="80" y="96" width="16" height="16">
|
<object id="4" type="block" gid="4" x="112" y="80" width="16" height="16">
|
||||||
<properties>
|
<properties>
|
||||||
<property name="kind" value="copper"/>
|
<property name="kind" value="copper"/>
|
||||||
</properties>
|
</properties>
|
||||||
</object>
|
</object>
|
||||||
<object id="8" type="electric-switch" gid="8" x="224" y="80" width="16" height="16">
|
<object id="8" type="electric-switch" gid="8" x="208" y="112" width="16" height="16">
|
||||||
<properties>
|
<properties>
|
||||||
<property name="target-x" type="int" value="15"/>
|
<property name="target-x" type="int" value="15"/>
|
||||||
<property name="target-y" type="int" value="6"/>
|
<property name="target-y" type="int" value="7"/>
|
||||||
</properties>
|
</properties>
|
||||||
</object>
|
</object>
|
||||||
<object id="9" type="gate" gid="46" x="240" y="96" width="16" height="16"/>
|
<object id="9" type="gate" gid="46" x="240" y="112" width="16" height="16"/>
|
||||||
<object id="13" type="xor-gate" gid="45" x="192" y="80" width="16" height="16"/>
|
<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"/>
|
||||||
</objectgroup>
|
</objectgroup>
|
||||||
</map>
|
</map>
|
||||||
|
|
|
@ -558,6 +558,7 @@ the default ORIENTATION value of 'orthogonal' is supported."
|
||||||
(define obj:and-gate 11)
|
(define obj:and-gate 11)
|
||||||
(define obj:electric-switch 12)
|
(define obj:electric-switch 12)
|
||||||
(define obj:xor-gate 13)
|
(define obj:xor-gate 13)
|
||||||
|
(define obj:or-gate 15)
|
||||||
|
|
||||||
(define (compile-environment-layer tile-map layer-name)
|
(define (compile-environment-layer tile-map layer-name)
|
||||||
(let ((tw (tile-map-tile-width tile-map))
|
(let ((tw (tile-map-tile-width tile-map))
|
||||||
|
@ -606,6 +607,7 @@ the default ORIENTATION value of 'orthogonal' is supported."
|
||||||
('gate (list x y obj:gate))
|
('gate (list x y obj:gate))
|
||||||
('and-gate (list x y obj:and-gate))
|
('and-gate (list x y obj:and-gate))
|
||||||
('xor-gate (list x y obj:xor-gate))
|
('xor-gate (list x y obj:xor-gate))
|
||||||
|
('or-gate (list x y obj:or-gate))
|
||||||
('electric-switch (list x y obj:electric-switch
|
('electric-switch (list x y obj:electric-switch
|
||||||
(assq-ref properties 'target-x)
|
(assq-ref properties 'target-x)
|
||||||
(assq-ref properties 'target-y)))
|
(assq-ref properties 'target-y)))
|
||||||
|
|
Loading…
Add table
Reference in a new issue