diff --git a/game.scm b/game.scm index 6b406fb..ee1b35b 100644 --- a/game.scm +++ b/game.scm @@ -359,7 +359,7 @@ (define (draw-gate pos open?) (draw-tile context tileset (if open? 46 45) (vec2-x pos) (vec2-y pos))) -(define (draw-logic-gate pos state id) +(define (draw-logic-gate pos direction state id) (let ((x (vec2-x pos)) (y (vec2-y pos))) (draw-tile context tileset 2 x y) @@ -386,9 +386,9 @@ (('gem pos) (draw-gem pos)) (('ghost-gem pos) (draw-ghost-gem pos)) (('gate pos open?) (draw-gate pos open?)) - (('and-gate pos state) (draw-logic-gate pos state 42)) - (('or-gate pos state) (draw-logic-gate pos state 43)) - (('xor-gate pos state) (draw-logic-gate pos state 44)) + (('and-gate pos direction state) (draw-logic-gate pos direction state 42)) + (('or-gate pos direction state) (draw-logic-gate pos direction state 43)) + (('xor-gate pos direction state) (draw-logic-gate pos direction state 44)) (('electric-switch pos on?) (draw-electric-switch pos on?)) (('electron-warp pos state) (draw-electron-warp pos state)))) diff --git a/modules/game/actors.scm b/modules/game/actors.scm index 43ee1f9..2136bd2 100644 --- a/modules/game/actors.scm +++ b/modules/game/actors.scm @@ -354,7 +354,7 @@ (('describe) `(gate ,position ,($ open?))) (('collide other offset grid-info) #f))) -(define (^logic-gate bcom x y name update-wire-state) +(define (^logic-gate bcom x y name direction update-wire-state) (define position (vector x y 0)) (define state (spawn ^cell 'copper)) (match-lambda* @@ -372,51 +372,46 @@ ('copper (update-wire-state state ($ grid-info 'wireworld-neighbor-grid x y))))) (('alive?) #t) - (('describe) `(,name ,position ,($ state))) + (('describe) `(,name ,position ,direction ,($ state))) (('collide other offset grid-info) #f))) -(define direction:right 1) -(define direction:left 2) -(define direction:up 3) -(define direction:down 4) - (define (^and-gate bcom x y direction) (define (update-wire-state state neighbor-grid) (match direction - (direction:right + ('right (match neighbor-grid (#('electron-head #f #f #f _ 'copper 'electron-head #f #f) ($ state 'electron-head)) (_ ($ state 'copper)))) - (direction:left + ('left (match neighbor-grid (#(#f #f 'electron-head 'copper _ #f #f #f 'electron-head) ($ state 'electron-head)) (_ ($ state 'copper)))) - (direction:up + ('up (match neighbor-grid (#(#f 'copper #f #f _ #f 'electron-head #f 'electron-head) ($ state 'electron-head)) (_ ($ state 'copper)))) - (direction:down + ('down (match neighbor-grid (#('electron-head #f 'electron-head #f _ #f #f 'copper #f) ($ state 'electron-head)) (_ ($ state 'copper)))))) - (^logic-gate bcom x y 'and-gate update-wire-state)) + (^logic-gate bcom x y 'and-gate direction update-wire-state)) (define (^xor-gate bcom x y direction) (define (update-wire-state state neighbor-grid) (match direction - (direction:right + ('right (match neighbor-grid (#('electron-head #f #f #f _ 'copper @@ -435,7 +430,7 @@ 'electron-head #f #f) ($ state 'electron-head)) (_ ($ state 'copper)))) - (direction:left + ('left (match neighbor-grid (#(#f #f 'electron-head 'copper _ #f @@ -454,7 +449,7 @@ #f #f 'electron-head) ($ state 'electron-head)) (_ ($ state 'copper)))) - (direction:up + ('up (match neighbor-grid (#(#f 'copper #f #f _ #f @@ -473,7 +468,7 @@ 'copper #f 'electron-head) ($ state 'electron-head)) (_ ($ state 'copper)))) - (direction:down + ('down (match neighbor-grid (#('electron-head #f #f #f _ #f @@ -492,12 +487,12 @@ #f 'copper #f) ($ state 'electron-head)) (_ ($ state 'copper)))))) - (^logic-gate bcom x y 'xor-gate update-wire-state)) + (^logic-gate bcom x y 'xor-gate direction update-wire-state)) (define (^or-gate bcom x y direction) (define (update-wire-state state neighbor-grid) (match direction - (direction:right + ('right (match neighbor-grid (#('electron-head #f #f #f _ 'copper @@ -520,7 +515,7 @@ 'electron-head #f #f) ($ state 'electron-head)) (_ ($ state 'copper)))) - (direction:left + ('left (match neighbor-grid (#(#f #f 'electron-head 'copper _ #f @@ -543,7 +538,7 @@ #f #f 'electron-head) ($ state 'electron-head)) (_ ($ state 'copper)))) - (direction:up + ('up (match neighbor-grid (#(#f 'copper #f #f _ #f @@ -566,7 +561,7 @@ 'electron-head #f 'electron-head) ($ state 'electron-head)) (_ ($ state 'copper)))) - (direction:down + ('down (match neighbor-grid (#('electron-head #f #f #f _ #f @@ -589,7 +584,7 @@ #f 'copper #f) ($ state 'electron-head)) (_ ($ state 'copper)))))) - (^logic-gate bcom x y 'or-gate update-wire-state)) + (^logic-gate bcom x y 'or-gate direction update-wire-state)) (define (^player bcom x y) (define position (spawn ^cell (vector x y 2))) diff --git a/modules/game/level.scm b/modules/game/level.scm index 52baed2..3f0ee31 100644 --- a/modules/game/level.scm +++ b/modules/game/level.scm @@ -39,7 +39,13 @@ (define (make-level width height background objects collected-gem?) (let ((level* (spawn ^level width height)) - (background* (make-vector (* width height)))) + (background* (make-vector (* width height))) + (direction->symbol + (match-lambda + (1 'right) + (2 'left) + (3 'up) + (4 'down)))) ;; Unpack background tile data. (let y-loop ((y 0)) (when (< y height) @@ -76,17 +82,20 @@ (spawn ^gem x y))) (10 (spawn ^gate x y)) (11 (spawn ^and-gate x y - (bytevector-u8-ref objects (+ i 3)))) + (direction->symbol + (bytevector-u8-ref objects (+ i 3))))) (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))) (13 (spawn ^xor-gate x y - (bytevector-u8-ref objects (+ i 3)))) + (direction->symbol + (bytevector-u8-ref objects (+ i 3))))) (14 (let ((target-x (bytevector-u8-ref objects (+ i 3))) (target-y (bytevector-u8-ref objects (+ i 4)))) (spawn ^electron-warp x y target-x target-y))) (15 (spawn ^or-gate x y - (bytevector-u8-ref objects (+ i 3)))) + (direction->symbol + (bytevector-u8-ref objects (+ i 3))))) (16 (spawn ^switched-emitter x y (bytevector-u8-ref objects (+ i 3)))) (id (error "invalid level object" id)))) diff --git a/modules/game/levels/level-4.tmx b/modules/game/levels/level-4.tmx index ad734e4..8f5f141 100644 --- a/modules/game/levels/level-4.tmx +++ b/modules/game/levels/level-4.tmx @@ -1,5 +1,5 @@ - + @@ -70,5 +70,20 @@ + + + + + + + + + + + + + + + diff --git a/scripts/compile-map.scm b/scripts/compile-map.scm index 5cd754c..160b8b3 100644 --- a/scripts/compile-map.scm +++ b/scripts/compile-map.scm @@ -564,11 +564,6 @@ the default ORIENTATION value of 'orthogonal' is supported." (define obj:or-gate 15) (define obj:switched-emitter 16) -(define direction:right 1) -(define direction:left 2) -(define direction:up 3) -(define direction:down 4) - (define (compile-environment-layer tile-map layer-name) (let ((tw (tile-map-tile-width tile-map)) (th (tile-map-tile-height tile-map)) @@ -595,10 +590,10 @@ the default ORIENTATION value of 'orthogonal' is supported." (define (compile-object-layer tile-map layer-name) (define parse-direction (match-lambda - ("right" direction:right) - ("left" direction:left) - ("up" direction:up) - ("down" direction:down))) + ("right" 1) + ("left" 2) + ("up" 3) + ("down" 4))) (let ((tw (tile-map-tile-width tile-map)) (th (tile-map-tile-height tile-map)) (layer (tile-map-layer-ref tile-map layer-name)))