Cheap trick to make logic gates enforce electron directionality.
This commit is contained in:
parent
1b51dde9bc
commit
00df10dc12
1 changed files with 81 additions and 79 deletions
|
@ -28,6 +28,22 @@
|
|||
('electron-head 'electron-tail)
|
||||
('electron-tail 'copper)))
|
||||
|
||||
(define (electron-head-count neighbor-grid)
|
||||
(define (check state)
|
||||
(match state
|
||||
('electron-head 1)
|
||||
(_ 0)))
|
||||
(match neighbor-grid
|
||||
(#(a b c d '_ e f g h)
|
||||
(+ (check a)
|
||||
(check b)
|
||||
(check c)
|
||||
(check d)
|
||||
(check e)
|
||||
(check f)
|
||||
(check g)
|
||||
(check h)))))
|
||||
|
||||
(define* (^cell bcom #:optional val)
|
||||
(case-lambda
|
||||
(() val)
|
||||
|
@ -44,8 +60,8 @@
|
|||
(('post-tick grid-info) #f)
|
||||
(('enter obj grid-info) #f)
|
||||
(('exit obj grid-info) #f)
|
||||
(('wire-state grid-info) #f)
|
||||
(('update-wire-state grid-info) #f)
|
||||
(('wire-state grid-info from from-x from-y) #f)
|
||||
(('update-wire-state grid-info neighbor-grid) #f)
|
||||
(('alive?) #t)
|
||||
(('describe) `(exit ,position))
|
||||
(('collide other offset grid-info) #f)))
|
||||
|
@ -60,15 +76,15 @@
|
|||
(('post-tick grid-info) #f)
|
||||
(('enter obj grid-info) #f)
|
||||
(('exit obj grid-info) #f)
|
||||
(('wire-state grid-info)
|
||||
(('wire-state grid-info from from-x from-y)
|
||||
(match type
|
||||
((or 'copper 'electron-head 'electron-tail)
|
||||
type)
|
||||
(_ #f)))
|
||||
(('update-wire-state grid-info)
|
||||
(('update-wire-state grid-info neighbor-grid)
|
||||
(match type
|
||||
((or 'copper 'electron-head 'electron-tail)
|
||||
(let* ((neighbors ($ grid-info 'wireworld-neighbor-count x y))
|
||||
(let* ((neighbors (electron-head-count neighbor-grid))
|
||||
(type (wireworld-next type neighbors)))
|
||||
(bcom (^wall bcom x y type))))
|
||||
(_ #f)))
|
||||
|
@ -87,17 +103,17 @@
|
|||
(('post-tick grid-info) #f)
|
||||
(('enter obj grid-info) #f)
|
||||
(('exit obj grid-info) #f)
|
||||
(('wire-state grid-info)
|
||||
(('wire-state grid-info from from-x from-y)
|
||||
(match type
|
||||
((or 'copper 'electron-head 'electron-tail)
|
||||
type)
|
||||
(_ #f)))
|
||||
(('update-wire-state grid-info)
|
||||
(('update-wire-state grid-info neighbor-grid)
|
||||
(match type
|
||||
((or 'copper 'electron-head 'electron-tail)
|
||||
(match ($ position)
|
||||
(#(x y z)
|
||||
(let* ((neighbors ($ grid-info 'wireworld-neighbor-count x y))
|
||||
(let* ((neighbors (electron-head-count neighbor-grid))
|
||||
(type (wireworld-next type neighbors)))
|
||||
(bcom (^block bcom x y type))))))
|
||||
(_ #f)))
|
||||
|
@ -135,12 +151,12 @@
|
|||
(('post-tick grid-info) #f)
|
||||
(('enter obj grid-info) #f)
|
||||
(('exit obj grid-info) #f)
|
||||
(('wire-state grid-info)
|
||||
(('wire-state grid-info from from-x from-y)
|
||||
(match ($ timer)
|
||||
(0 'electron-head)
|
||||
(1 'electron-tail)
|
||||
(_ 'copper)))
|
||||
(('update-wire-state grid-info) #f)
|
||||
(('update-wire-state grid-info neighbor-grid) #f)
|
||||
(('alive?) #t)
|
||||
(('describe) `(clock-emitter ,position))
|
||||
(('collide other offset grid-info) #f)))
|
||||
|
@ -168,13 +184,13 @@
|
|||
(('deactivate grid-info)
|
||||
($ on? #f)
|
||||
($ grid-info 'append-event `(emitter-off ,x ,y)))
|
||||
(('wire-state grid-info)
|
||||
(('wire-state grid-info from from-x from-y)
|
||||
(and ($ on?)
|
||||
(match ($ timer)
|
||||
(0 'electron-head)
|
||||
(1 'electron-tail)
|
||||
(_ 'copper))))
|
||||
(('update-wire-state grid-info) #f)
|
||||
(('update-wire-state grid-info neighbor-grid) #f)
|
||||
(('alive?) #t)
|
||||
(('on?) ($ on?))
|
||||
(('describe) `(switched-emitter ,position ,($ on?)))
|
||||
|
@ -207,8 +223,8 @@
|
|||
(target
|
||||
($ grid-info 'append-event `(floor-switch-off ,x ,y))
|
||||
($ target 'deactivate grid-info)))))
|
||||
(('wire-state grid-info) #f)
|
||||
(('update-wire-state grid-info) #f)
|
||||
(('wire-state grid-info from from-x from-y) #f)
|
||||
(('update-wire-state grid-info neighbor-grid) #f)
|
||||
(('alive?) #t)
|
||||
(('describe) `(floor-switch ,position ,($ on?)))
|
||||
(('collide other offset grid-info)
|
||||
|
@ -230,8 +246,8 @@
|
|||
(('post-tick grid-info) #f)
|
||||
(('enter obj grid-info) #f)
|
||||
(('exit obj grid-info) #f)
|
||||
(('wire-state grid-info) #f)
|
||||
(('update-wire-state grid-info)
|
||||
(('wire-state grid-info from from-x from-y) #f)
|
||||
(('update-wire-state grid-info neighbor-grid)
|
||||
(if ($ on?)
|
||||
(let ((t (1- ($ timer))))
|
||||
($ timer t)
|
||||
|
@ -242,7 +258,7 @@
|
|||
(target
|
||||
($ grid-info 'append-event `(electric-switch-off ,x ,y))
|
||||
($ target 'deactivate grid-info)))))
|
||||
(when (>= ($ grid-info 'wireworld-neighbor-count x y) 1)
|
||||
(when (>= (electron-head-count neighbor-grid) 1)
|
||||
($ on? #t)
|
||||
($ timer 2)
|
||||
(match (first-non-player-occupant grid-info target-x target-y)
|
||||
|
@ -273,8 +289,8 @@
|
|||
(('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)
|
||||
(('wire-state grid-info from from-x from-y) ($ state))
|
||||
(('update-wire-state grid-info neighbor-grid)
|
||||
(match ($ state)
|
||||
('electron-head ($ state 'electron-tail))
|
||||
('electron-tail ($ state 'copper))
|
||||
|
@ -284,7 +300,7 @@
|
|||
($ state 'electron-head)
|
||||
($ electron? #f)
|
||||
($ grid-info 'append-event `(receive-electron ,x ,y)))
|
||||
(let ((neighbors ($ grid-info 'wireworld-neighbor-count x y)))
|
||||
(let ((neighbors (electron-head-count neighbor-grid)))
|
||||
(if (<= 1 neighbors 2)
|
||||
(begin
|
||||
($ state 'electron-head)
|
||||
|
@ -307,8 +323,8 @@
|
|||
(('post-tick grid-info) #f)
|
||||
(('enter obj grid-info) #f)
|
||||
(('exit obj grid-info) #f)
|
||||
(('wire-state grid-info) #f)
|
||||
(('update-wire-state grid-info) #f)
|
||||
(('wire-state grid-info from from-x from-y) #f)
|
||||
(('update-wire-state grid-info neighbor-grid) #f)
|
||||
(('alive?) (not ($ picked-up?)))
|
||||
(('describe) `(gem ,position))
|
||||
(('collide other offset grid-info)
|
||||
|
@ -325,8 +341,8 @@
|
|||
(('post-tick grid-info) #f)
|
||||
(('enter obj grid-info) #f)
|
||||
(('exit obj grid-info) #f)
|
||||
(('wire-state grid-info) #f)
|
||||
(('update-wire-state grid-info) #f)
|
||||
(('wire-state grid-info from from-x from-y) #f)
|
||||
(('update-wire-state grid-info neighbor-grid) #f)
|
||||
(('alive?) #t)
|
||||
(('describe) `(ghost-gem ,position))
|
||||
(('collide other offset grid-info) #f)))
|
||||
|
@ -347,8 +363,8 @@
|
|||
(('deactivate grid-info)
|
||||
($ open? #f)
|
||||
($ grid-info 'append-event `(gate-close ,x ,y)))
|
||||
(('wire-state grid-info) #f)
|
||||
(('update-wire-state grid-info) #f)
|
||||
(('wire-state grid-info from from-x from-y) #f)
|
||||
(('update-wire-state grid-info neighbor-grid) #f)
|
||||
(('alive?) #t)
|
||||
(('open?) ($ open?))
|
||||
(('describe) `(gate ,position ,($ open?)))
|
||||
|
@ -364,13 +380,26 @@
|
|||
(('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)
|
||||
(('wire-state grid-info from from-x from-y)
|
||||
;; We are compressing what would take many cells in the actual
|
||||
;; Wireworld into a single tile. A naive approach to this would
|
||||
;; send electrons flowing backwards through the logic gates. So,
|
||||
;; need to play a trick to make enforce directionality. The
|
||||
;; trick is that we know who is asking for our wire state. If
|
||||
;; the object is opposes the direction we are pushing electrons,
|
||||
;; then we tell them we're just copper. Otherwise, we reveal our
|
||||
;; true state. Sneaky, sneaky.
|
||||
(match direction
|
||||
('left (if (> from-x x) 'copper ($ state)))
|
||||
('right (if (< from-x x) 'copper ($ state)))
|
||||
('up (if (> from-y y) 'copper ($ state)))
|
||||
('down (if (< from-y y) 'copper ($ state)))))
|
||||
(('update-wire-state grid-info neighbor-grid)
|
||||
(match ($ state)
|
||||
('electron-head ($ state 'electron-tail))
|
||||
('electron-tail ($ state 'copper))
|
||||
('copper
|
||||
(update-wire-state state ($ grid-info 'wireworld-neighbor-grid x y)))))
|
||||
(update-wire-state state neighbor-grid))))
|
||||
(('alive?) #t)
|
||||
(('describe) `(,name ,position ,direction ,($ state)))
|
||||
(('collide other offset grid-info) #f)))
|
||||
|
@ -626,7 +655,7 @@
|
|||
(_ (lp rest)))))))))
|
||||
(('enter obj grid-info) #f)
|
||||
(('exit obj grid-info) #f)
|
||||
(('wire-state grid-info) #f)
|
||||
(('wire-state grid-info from from-x from-y) #f)
|
||||
(('alive?) ($ alive?))
|
||||
(('describe) `(player ,($ position), ($ alive?)))
|
||||
(('collide other offset grid-info)
|
||||
|
@ -692,62 +721,35 @@
|
|||
(vector-set! grid (+ (* y width) x) val))
|
||||
(define grid (make-grid '()))
|
||||
|
||||
(define wire-grid (make-grid #f))
|
||||
(define (refresh-wire-grid)
|
||||
(for-each-coord
|
||||
(lambda (x y)
|
||||
(let ((obj-cell (grid-ref grid x y))
|
||||
(wire-cell (grid-ref wire-grid x y)))
|
||||
(match ($ obj-cell)
|
||||
(define (wire-state-at who who-x who-y target-x target-y)
|
||||
(match ($ (grid-ref/wrap grid target-x target-y))
|
||||
(() #f)
|
||||
;; TODO: Handle tiles with many occupants. Might not be
|
||||
;; 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)
|
||||
($ (grid-ref/wrap wire-grid x y)))
|
||||
(define (neighbor-count x y)
|
||||
(define (check x y)
|
||||
(match (wire-state-at x y)
|
||||
('electron-head 1)
|
||||
(_ 0)))
|
||||
(+ (check (- x 1) (- y 1))
|
||||
(check x (- y 1))
|
||||
(check (+ x 1) (- y 1))
|
||||
(check (- x 1) y)
|
||||
(check (+ x 1) y)
|
||||
(check (- x 1) (+ y 1))
|
||||
(check x (+ y 1))
|
||||
(check (+ x 1) (+ y 1))))
|
||||
((obj . _)
|
||||
($ obj 'wire-state grid-info who who-x who-y))))
|
||||
;; flattened 3x3 grid of neighbor states. '_' used to mark the
|
||||
;; center.
|
||||
(define (neighbor-grid x y)
|
||||
(vector (wire-state-at (- x 1) (- y 1))
|
||||
(wire-state-at x (- y 1))
|
||||
(wire-state-at (+ x 1) (- y 1))
|
||||
(define (neighbor-grid obj)
|
||||
(match ($ obj 'position)
|
||||
(#(x y z)
|
||||
(vector (wire-state-at obj x y (- x 1) (- y 1))
|
||||
(wire-state-at obj x y x (- y 1))
|
||||
(wire-state-at obj x y (+ x 1) (- y 1))
|
||||
|
||||
(wire-state-at (- x 1) y)
|
||||
(wire-state-at obj x y (- x 1) y)
|
||||
'_
|
||||
(wire-state-at (+ x 1) y)
|
||||
(wire-state-at obj x y (+ x 1) y)
|
||||
|
||||
(wire-state-at (- x 1) (+ y 1))
|
||||
(wire-state-at x (+ y 1))
|
||||
(wire-state-at (+ x 1) (+ y 1))))
|
||||
(wire-state-at obj x y (- x 1) (+ y 1))
|
||||
(wire-state-at obj x y x (+ y 1))
|
||||
(wire-state-at obj x y (+ x 1) (+ y 1))))))
|
||||
|
||||
;; Read-only access to query the grid.
|
||||
;; Read-only access to query the grid, but can write events.
|
||||
(define (^grid-info bcom)
|
||||
(match-lambda*
|
||||
(('occupied? x y)
|
||||
(not (null? ($ (grid-ref grid x y)))))
|
||||
(('occupants x y)
|
||||
($ (grid-ref grid x y)))
|
||||
;; How many electron heads around (x, y)?
|
||||
(('wireworld-neighbor-count x y)
|
||||
(neighbor-count x y))
|
||||
(('wireworld-neighbor-grid x y)
|
||||
(neighbor-grid x y))
|
||||
(('append-event event)
|
||||
($ event-log 'append event))))
|
||||
(define grid-info (spawn ^grid-info))
|
||||
|
@ -827,10 +829,10 @@
|
|||
;; Tick all the non-player objects.
|
||||
(iter-objects tick-object)
|
||||
;; Advance Wirewold simulation.
|
||||
(refresh-wire-grid)
|
||||
(for-each (lambda (obj)
|
||||
($ obj 'update-wire-state grid-info))
|
||||
($ objects))
|
||||
(let ((neighbor-grids (map neighbor-grid ($ objects))))
|
||||
(for-each (lambda (obj neighbor-grid)
|
||||
($ obj 'update-wire-state grid-info neighbor-grid))
|
||||
($ objects) neighbor-grids))
|
||||
;; Run post-tick hooks.
|
||||
($ player 'post-tick grid-info)
|
||||
(iter-objects (lambda (obj) ($ obj 'post-tick grid-info)))))
|
||||
|
|
Loading…
Add table
Reference in a new issue