diff --git a/modules/game/actors.scm b/modules/game/actors.scm index 4f53b8f..8bd0ca5 100644 --- a/modules/game/actors.scm +++ b/modules/game/actors.scm @@ -353,7 +353,7 @@ (('describe) `(gate ,position ,($ open?))) (('collide other offset grid-info) #f))) -(define (^and-gate bcom x y) +(define (^logic-gate bcom x y name update-wire-state) (define position (vector x y 0)) (define state (spawn ^cell 'copper)) (match-lambda* @@ -365,105 +365,86 @@ (('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 - 'electron-head #f #f) - ($ state 'electron-head)) - (_ ($ state 'copper)))))) + (update-wire-state state grid-info)) (('alive?) #t) - (('describe) `(and-gate ,position ,($ state))) + (('describe) `(,name ,position ,($ state))) (('collide other offset grid-info) #f))) +(define (^and-gate bcom x y) + (define (update-wire-state 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 + 'electron-head #f #f) + ($ state 'electron-head)) + (_ ($ state 'copper)))))) + (^logic-gate bcom x y 'and-gate update-wire-state)) + (define (^xor-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)) - (_ ($ state 'copper)))))) - (('alive?) #t) - (('describe) `(xor-gate ,position ,($ state))) - (('collide other offset grid-info) #f))) + (define (update-wire-state 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)) + (_ ($ state 'copper)))))) + (^logic-gate bcom x y 'xor-gate update-wire-state)) (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 ,($ state))) - (('collide other offset grid-info) #f))) + (define (update-wire-state 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)))))) + (^logic-gate bcom x y 'or-gate update-wire-state)) (define (^player bcom x y) (define position (spawn ^cell (vector x y 2)))