Add basic AND gate and electric switch.
This commit is contained in:
parent
ff242fd1a5
commit
5756844161
5 changed files with 105 additions and 23 deletions
10
game.scm
10
game.scm
|
@ -280,6 +280,12 @@
|
|||
(define (draw-gate pos open?)
|
||||
(draw-tile context tileset (if open? 46 45) (vec2-x pos) (vec2-y pos)))
|
||||
|
||||
(define (draw-and-gate pos)
|
||||
(draw-tile context tileset 42 (vec2-x pos) (vec2-y pos)))
|
||||
|
||||
(define (draw-electric-switch pos on?)
|
||||
(draw-tile context tileset (if on? 7 6) (vec2-x pos) (vec2-y pos)))
|
||||
|
||||
(define (draw-object obj)
|
||||
(match obj
|
||||
(#f #f)
|
||||
|
@ -290,7 +296,9 @@
|
|||
(('clock-emitter pos) #t) ; drawn via background
|
||||
(('floor-switch pos on?) (draw-floor-switch pos on?))
|
||||
(('gem pos) (draw-gem pos))
|
||||
(('gate pos open?) (draw-gate pos open?))))
|
||||
(('gate pos open?) (draw-gate pos open?))
|
||||
(('and-gate pos) (draw-and-gate pos))
|
||||
(('electric-switch pos on?) (draw-electric-switch pos on?))))
|
||||
|
||||
(define (draw-background)
|
||||
(let* ((bv (level-background *level*))
|
||||
|
|
|
@ -9,6 +9,8 @@
|
|||
^floor-switch
|
||||
^gate
|
||||
^gem
|
||||
^and-gate
|
||||
^electric-switch
|
||||
^player
|
||||
^level))
|
||||
|
||||
|
@ -134,10 +136,18 @@
|
|||
'copper))))
|
||||
(('update-wire-state grid-info) #f)
|
||||
(('alive?) #t)
|
||||
(('set-wire-state type) #f)
|
||||
(('describe) `(clock-emitter ,position))
|
||||
(('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
|
||||
(() #f)
|
||||
((obj . rest)
|
||||
(if (eq? ($ obj 'type) 'player)
|
||||
(lp rest)
|
||||
obj)))))
|
||||
|
||||
(define (^floor-switch bcom x y target-x target-y)
|
||||
(define position (vector x y 0))
|
||||
(define on? (spawn ^cell))
|
||||
|
@ -150,20 +160,48 @@
|
|||
(('exit obj grid-info)
|
||||
(when (= (length ($ grid-info 'occupants x y)) 1)
|
||||
($ on? #f)
|
||||
(match ($ grid-info 'occupants target-x target-y)
|
||||
(() (pk "no switch target!"))
|
||||
((target . _)
|
||||
($ target 'deactivate)))))
|
||||
(match (first-non-player-occupant grid-info target-x target-y)
|
||||
(#f (pk "no switch target!"))
|
||||
(target ($ target 'deactivate)))))
|
||||
(('wire-state) #f)
|
||||
(('update-wire-state grid-info) #f)
|
||||
(('alive?) #t)
|
||||
(('describe) `(floor-switch ,position ,($ on?)))
|
||||
(('collide other offset grid-info)
|
||||
($ on? #t)
|
||||
(match ($ grid-info 'occupants target-x target-y)
|
||||
(() (pk "no switch target!"))
|
||||
((target . _)
|
||||
($ target 'activate))))))
|
||||
(match (first-non-player-occupant grid-info target-x target-y)
|
||||
(#f (pk "no switch target!"))
|
||||
(target ($ target 'activate))))))
|
||||
|
||||
(define (^electric-switch bcom x y target-x target-y)
|
||||
(define position (vector x y 0))
|
||||
(define on? (spawn ^cell))
|
||||
(define timer (spawn ^cell))
|
||||
(match-lambda*
|
||||
(('type) 'switch)
|
||||
(('position) position)
|
||||
(('tick grid-info) #f)
|
||||
(('enter obj grid-info) #f)
|
||||
(('exit obj grid-info) #f)
|
||||
(('wire-state) #f)
|
||||
(('update-wire-state grid-info)
|
||||
(if ($ on?)
|
||||
(let ((t (1- ($ timer))))
|
||||
($ timer t)
|
||||
(when (= t 0)
|
||||
($ on? #f)
|
||||
(match (first-non-player-occupant grid-info target-x target-y)
|
||||
(#f (pk "no switch target!"))
|
||||
(target ($ target 'deactivate)))))
|
||||
(when (>= ($ grid-info 'wireworld-neighbor-count x y) 1)
|
||||
($ on? #t)
|
||||
($ timer 2)
|
||||
(match (first-non-player-occupant grid-info target-x target-y)
|
||||
(#f (pk "no switch target!"))
|
||||
(target ($ target 'activate))))))
|
||||
(('alive?) #t)
|
||||
(('describe) `(electric-switch ,position ,($ on?)))
|
||||
(('collide other offset grid-info) #f)))
|
||||
|
||||
(define (^gem bcom x y)
|
||||
(define position (vector x y 1))
|
||||
|
@ -200,6 +238,35 @@
|
|||
(('describe) `(gate ,position ,($ open?)))
|
||||
(('collide other offset grid-info) #f)))
|
||||
|
||||
(define (^and-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)
|
||||
(('enter obj grid-info) #f)
|
||||
(('exit obj grid-info) #f)
|
||||
(('wire-state) ($ 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 (pk 'GRID ($ grid-info 'wireworld-neighbor-grid x y))
|
||||
(#('electron-head #f #f
|
||||
#f _ 'copper
|
||||
'electron-head #f #f)
|
||||
(pk 'COOL)
|
||||
($ state 'electron-head))
|
||||
(_ ($ state 'copper)))))
|
||||
(pk 'NEW-STATE ($ state)))
|
||||
(('alive?) #t)
|
||||
(('describe) `(and-gate ,position))
|
||||
(('collide other offset grid-info) #f)))
|
||||
|
||||
(define (^player bcom x y)
|
||||
(define position (spawn ^cell (vector x y 2)))
|
||||
(define velocity (spawn ^cell #(0 0)))
|
||||
|
|
|
@ -42,9 +42,14 @@
|
|||
(spawn ^floor-switch x y target-x target-y)))
|
||||
(9 (and spawn-gem? (spawn ^gem x y)))
|
||||
(10 (spawn ^gate x y))
|
||||
(11 (spawn ^and-gate x y))
|
||||
(12 (let ((target-x (bytevector-u8-ref objects (+ i 3)))
|
||||
(target-y (bytevector-u8-ref objects (+ i 4))))
|
||||
(spawn ^electric-switch x y target-x target-y)))
|
||||
(id (error "invalid level object" id))))
|
||||
(i* (+ i (match id
|
||||
(8 5) ; floor-switch
|
||||
;; floor-switch or electric-switch
|
||||
((or 8 12) 5)
|
||||
(_ 3)))))
|
||||
(when obj
|
||||
($ level* 'add-object obj))
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
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,49,3,3,3,24,3,3,3,3,3,3,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,
|
||||
|
@ -27,13 +27,12 @@
|
|||
<property name="kind" value="copper"/>
|
||||
</properties>
|
||||
</object>
|
||||
<object id="7" type="floor-switch" gid="25" x="80" y="96" width="16" height="16">
|
||||
<object id="8" type="electric-switch" gid="8" x="224" y="80" width="16" height="16">
|
||||
<properties>
|
||||
<property name="target-x" type="int" value="11"/>
|
||||
<property name="target-y" type="int" value="7"/>
|
||||
<property name="target-x" type="int" value="15"/>
|
||||
<property name="target-y" type="int" value="6"/>
|
||||
</properties>
|
||||
</object>
|
||||
<object id="8" type="electric-switch" gid="8" x="224" y="80" width="16" height="16"/>
|
||||
<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"/>
|
||||
</objectgroup>
|
||||
|
|
|
@ -555,6 +555,8 @@ the default ORIENTATION value of 'orthogonal' is supported."
|
|||
(define obj:floor-switch 8)
|
||||
(define obj:gem 9)
|
||||
(define obj:gate 10)
|
||||
(define obj:and-gate 11)
|
||||
(define obj:electric-switch 12)
|
||||
|
||||
(define (compile-environment-layer tile-map layer-name)
|
||||
(let ((tw (tile-map-tile-width tile-map))
|
||||
|
@ -601,9 +603,10 @@ the default ORIENTATION value of 'orthogonal' is supported."
|
|||
(assq-ref properties 'target-y)))
|
||||
('gem (list x y obj:gem))
|
||||
('gate (list x y obj:gate))
|
||||
;; TODO: Implement these
|
||||
('and-gate (list x y obj:block:copper))
|
||||
('electric-switch (list x y obj:wall:copper))
|
||||
('and-gate (list x y obj:and-gate))
|
||||
('electric-switch (list x y obj:electric-switch
|
||||
(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