From 6b9edbca25c9dce0abc7f88cc5f866f73a782697 Mon Sep 17 00:00:00 2001 From: Juliana Sims Date: Wed, 22 May 2024 13:32:37 -0400 Subject: [PATCH] Add or gate, update level 4 to use all logic gates --- game.scm | 4 ++ modules/game/actors.scm | 71 +++++++++++++++++++++++++++------ modules/game/level.scm | 1 + modules/game/levels/level-4.tmx | 30 +++++++------- scripts/compile-map.scm | 2 + 5 files changed, 81 insertions(+), 27 deletions(-) diff --git a/game.scm b/game.scm index 521b2dd..d72b5ce 100644 --- a/game.scm +++ b/game.scm @@ -298,6 +298,9 @@ (define (draw-and-gate 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) (draw-tile context tileset 44 (vec2-x pos) (vec2-y pos))) @@ -317,6 +320,7 @@ (('gate pos open?) (draw-gate pos open?)) (('and-gate pos) (draw-and-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?)))) (define (draw-background) diff --git a/modules/game/actors.scm b/modules/game/actors.scm index c3acc80..dd59fa1 100644 --- a/modules/game/actors.scm +++ b/modules/game/actors.scm @@ -11,6 +11,7 @@ ^gem ^and-gate ^xor-gate + ^or-gate ^electric-switch ^player ^level)) @@ -43,7 +44,7 @@ (('post-tick grid-info) #f) (('enter obj grid-info) #f) (('exit obj grid-info) #f) - (('wire-state) #f) + (('wire-state grid-info) #f) (('update-wire-state grid-info) #f) (('alive?) #t) (('describe) `(exit ,position)) @@ -59,7 +60,7 @@ (('post-tick grid-info) #f) (('enter obj grid-info) #f) (('exit obj grid-info) #f) - (('wire-state) + (('wire-state grid-info) (match type ((or 'copper 'electron-head 'electron-tail) type) @@ -86,7 +87,7 @@ (('post-tick grid-info) #f) (('enter obj grid-info) #f) (('exit obj grid-info) #f) - (('wire-state) + (('wire-state grid-info) (match type ((or 'copper 'electron-head 'electron-tail) type) @@ -130,7 +131,7 @@ (('post-tick grid-info) #f) (('enter obj grid-info) #f) (('exit obj grid-info) #f) - (('wire-state) + (('wire-state grid-info) (let ((t ($ timer))) (cond ((= (modulo t interval) 0) @@ -169,7 +170,7 @@ (match (first-non-player-occupant grid-info target-x target-y) (#f (pk "no switch target!")) (target ($ target 'deactivate))))) - (('wire-state) #f) + (('wire-state grid-info) #f) (('update-wire-state grid-info) #f) (('alive?) #t) (('describe) `(floor-switch ,position ,($ on?))) @@ -190,7 +191,7 @@ (('post-tick grid-info) #f) (('enter obj grid-info) #f) (('exit obj grid-info) #f) - (('wire-state) #f) + (('wire-state grid-info) #f) (('update-wire-state grid-info) (if ($ on?) (let ((t (1- ($ timer)))) @@ -220,7 +221,7 @@ (('post-tick grid-info) #f) (('enter obj grid-info) #f) (('exit obj grid-info) #f) - (('wire-state) #f) + (('wire-state grid-info) #f) (('update-wire-state grid-info) #f) (('alive?) (not ($ picked-up?))) (('describe) `(gem ,position)) @@ -240,7 +241,7 @@ (('exit obj grid-info) #f) (('activate) ($ open? #t)) (('deactivate) ($ open? #f)) - (('wire-state) #f) + (('wire-state grid-info) #f) (('update-wire-state grid-info) #f) (('alive?) #t) (('open?) ($ open?)) @@ -257,7 +258,7 @@ (('post-tick grid-info) #f) (('enter obj grid-info) #f) (('exit obj grid-info) #f) - (('wire-state) ($ state)) + (('wire-state grid-info) ($ state)) (('update-wire-state grid-info) (match ($ state) ('electron-head ($ state 'electron-tail)) @@ -285,7 +286,7 @@ (('post-tick grid-info) #f) (('enter obj grid-info) #f) (('exit obj grid-info) #f) - (('wire-state) ($ state)) + (('wire-state grid-info) ($ state)) (('update-wire-state grid-info) (match ($ state) ('electron-head ($ state 'electron-tail)) @@ -293,7 +294,7 @@ ('copper ;; TODO: Match other shapes? This only allows left-to-right ;; 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 #f _ 'copper #f #f #f) @@ -315,6 +316,50 @@ (('describe) `(xor-gate ,position)) (('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 position (spawn ^cell (vector x y 2))) (define velocity (spawn ^cell #(0 0))) @@ -362,7 +407,7 @@ (_ (lp rest))))))))) (('enter obj grid-info) #f) (('exit obj grid-info) #f) - (('wire-state) #f) + (('wire-state grid-info) #f) (('update-wire-state grid-info) #f) (('alive?) ($ alive?)) (('describe) `(player ,($ position))) @@ -429,7 +474,7 @@ ;; TODO: Handle tiles with many occupants. Might not be ;; necessary in practice. ((refr . _) - ($ wire-cell ($ refr 'wire-state)))))))) + ($ 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) diff --git a/modules/game/level.scm b/modules/game/level.scm index 3f77b2f..c165567 100644 --- a/modules/game/level.scm +++ b/modules/game/level.scm @@ -47,6 +47,7 @@ (target-y (bytevector-u8-ref objects (+ i 4)))) (spawn ^electric-switch x y target-x target-y))) (13 (spawn ^xor-gate x y)) + (15 (spawn ^or-gate x y)) (id (error "invalid level object" id)))) (i* (+ i (match id ;; floor-switch or electric-switch diff --git a/modules/game/levels/level-4.tmx b/modules/game/levels/level-4.tmx index 87ca4c1..40db31d 100644 --- a/modules/game/levels/level-4.tmx +++ b/modules/game/levels/level-4.tmx @@ -1,39 +1,41 @@ - + 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,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,24,24,24,24,24,24,24,24,3,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,24,3,24,24,24,24,24,24,23,24,28,24,23, +23,24,24,24,24,24,24,24,24,24,3,24,24,24,24,23,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,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,24,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 - - + + - + - + - - + + + + diff --git a/scripts/compile-map.scm b/scripts/compile-map.scm index 4b01df9..786fb67 100644 --- a/scripts/compile-map.scm +++ b/scripts/compile-map.scm @@ -558,6 +558,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:or-gate 15) (define (compile-environment-layer tile-map layer-name) (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)) ('and-gate (list x y obj:and-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 (assq-ref properties 'target-x) (assq-ref properties 'target-y)))