diff --git a/game.scm b/game.scm index 2eac3b5..11cc699 100644 --- a/game.scm +++ b/game.scm @@ -301,6 +301,10 @@ (define (draw-electric-switch pos on?) (draw-tile context tileset (if on? 7 6) (vec2-x pos) (vec2-y pos))) +(define (draw-electron-warp pos state) + (draw-tile context tileset 71 (vec2-x pos) (vec2-y pos)) + (draw-wire-state pos state)) + (define (draw-object obj) (match obj (#f #f) @@ -315,7 +319,8 @@ (('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)) - (('electric-switch pos on?) (draw-electric-switch pos on?)))) + (('electric-switch pos on?) (draw-electric-switch pos on?)) + (('electron-warp pos state) (draw-electron-warp pos state)))) (define (draw-background) (let ((bg (level-background *level*)) diff --git a/modules/game/actors.scm b/modules/game/actors.scm index 9e1593e..3a4ce1f 100644 --- a/modules/game/actors.scm +++ b/modules/game/actors.scm @@ -13,6 +13,7 @@ ^xor-gate ^or-gate ^electric-switch + ^electron-warp ^player ^level)) @@ -31,9 +32,6 @@ ((new-val) (bcom (^cell bcom new-val))))) -;; TODO: Add layer info to 'describe' output for sorting sprites when -;; rendering. - ;; TODO: Port actor-lib methods and use it. (define (^exit bcom x y) (define position (vector x y 1)) @@ -211,6 +209,47 @@ (('describe) `(electric-switch ,position ,($ on?))) (('collide other offset grid-info) #f))) +(define (^electron-warp bcom x y target-x target-y) + (define position (vector x y 0)) + (define state (spawn ^cell 'copper)) + (define electron? (spawn ^cell)) + (define (find-receiver grid-info) + (let lp ((objs ($ grid-info 'occupants target-x target-y))) + (match objs + (() (error "no electron receiver at tile" target-x target-y)) + ((obj . rest) + (if (eq? ($ obj 'type) 'electron-warp) + obj + (lp rest)))))) + (match-lambda* + (('type) 'electron-warp) + (('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 + (if ($ electron?) + (begin + ($ state 'electron-head) + ($ electron? #f)) + (let ((neighbors ($ grid-info 'wireworld-neighbor-count x y))) + (if (<= 1 neighbors 2) + (begin + ($ state 'electron-head) + ;; Forward an electron head to the receiver. + ($ (find-receiver grid-info) 'give-electron)) + ($ state 'copper))))))) + (('give-electron) ($ electron? #t)) + (('alive?) #t) + (('describe) `(electron-warp ,position ,($ state))) + (('collide other offset grid-info) #f))) + (define (^gem bcom x y) (define position (vector x y 1)) (define picked-up? (spawn ^cell)) @@ -403,7 +442,6 @@ (('enter obj grid-info) #f) (('exit obj grid-info) #f) (('wire-state grid-info) #f) - (('update-wire-state grid-info) #f) (('alive?) ($ alive?)) (('describe) `(player ,($ position))) (('collide other offset grid-info) @@ -468,7 +506,9 @@ (match ($ obj-cell) (() #f) ;; TODO: Handle tiles with many occupants. Might not be - ;; necessary in practice. + ;; 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) diff --git a/modules/game/level.scm b/modules/game/level.scm index 46b4114..f5cfef0 100644 --- a/modules/game/level.scm +++ b/modules/game/level.scm @@ -77,11 +77,16 @@ (target-y (bytevector-u8-ref objects (+ i 4)))) (spawn ^electric-switch x y target-x target-y))) (13 (spawn ^xor-gate x y)) + (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)) (id (error "invalid level object" id)))) (i* (+ i (match id - ;; floor-switch or electric-switch - ((or 8 12) 5) + ;; floor-switch + ;; electric-switch + ;; electron-warp + ((or 8 12 14) 5) (_ 3))))) (when obj ($ level* 'add-object obj)) diff --git a/modules/game/levels/level-3.tmx b/modules/game/levels/level-3.tmx index f5ca22d..f44c48b 100644 --- a/modules/game/levels/level-3.tmx +++ b/modules/game/levels/level-3.tmx @@ -1,21 +1,21 @@ - + 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,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, -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,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23, +81,83,83,82,83,83,83,82,83,83,83,83,82,83,83,84,23,23,23,23, +85,24,24,24,24,24,24,24,24,24,24,24,24,24,24,106,81,82,82,84, +105,24,24,24,24,24,24,24,24,24,24,24,24,24,24,106,105,24,24,86, +105,24,49,3,3,24,3,3,3,3,3,3,24,24,24,106,105,24,24,106, +85,24,24,24,24,24,24,24,24,24,24,24,24,3,24,106,105,24,24,106, +85,24,24,24,24,24,49,3,3,3,3,3,24,24,24,24,24,24,24,106, +85,24,24,24,24,24,24,24,24,24,24,24,24,24,24,106,105,24,24,106, +85,24,24,24,24,24,24,24,24,24,24,24,24,24,24,106,105,28,24,86, +105,24,24,24,24,24,24,24,24,24,24,24,24,24,81,104,105,24,24,86, +105,49,3,3,24,61,61,66,24,24,24,24,24,24,106,23,105,24,24,86, +85,24,24,24,24,24,24,64,61,61,24,3,3,24,86,23,101,102,102,104, +101,103,103,102,102,102,103,102,103,103,102,102,102,102,104,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 @@ -35,5 +35,23 @@ + + + + + + + + + + + + + + + + + + diff --git a/modules/game/levels/tiles.tsx b/modules/game/levels/tiles.tsx index 905737f..8b699dc 100644 --- a/modules/game/levels/tiles.tsx +++ b/modules/game/levels/tiles.tsx @@ -13,4 +13,64 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/scripts/compile-map.scm b/scripts/compile-map.scm index 982f222..b9c0c4e 100644 --- a/scripts/compile-map.scm +++ b/scripts/compile-map.scm @@ -306,7 +306,7 @@ the default ORIENTATION value of 'orthogonal' is supported." (match type ((or 'string 'file) value) ('bool (not (string=? value "false"))) - ((or 'int 'float) (string->number value)) + ((or 'int 'float 'object) (string->number value)) ('color (make-color (parse-color-channel value 3) (parse-color-channel value 5) @@ -560,6 +560,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:electron-warp 14) (define obj:or-gate 15) (define (compile-environment-layer tile-map layer-name) @@ -613,6 +614,9 @@ the default ORIENTATION value of 'orthogonal' is supported." ('electric-switch (list x y obj:electric-switch (assq-ref properties 'target-x) (assq-ref properties 'target-y))) + ('electron-warp (list x y obj:electron-warp + (assq-ref properties 'target-x) + (assq-ref properties 'target-y))) (_ (error "unsupported object type" type))))) (object-layer-objects layer))))