Prepare to support drawing rotated tiles
This commit is contained in:
Juliana Sims
parent
d68b5d0491
commit
1e91411687
5 changed files with 54 additions and 40 deletions
8
game.scm
8
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))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<map version="1.8" tiledversion="1.8.6" orientation="orthogonal" renderorder="right-down" width="20" height="15" tilewidth="16" tileheight="16" infinite="0" nextlayerid="3" nextobjectid="24">
|
||||
<map version="1.8" tiledversion="1.8.6" orientation="orthogonal" renderorder="right-down" width="20" height="15" tilewidth="16" tileheight="16" infinite="0" nextlayerid="3" nextobjectid="27">
|
||||
<tileset firstgid="1" source="tiles.tsx"/>
|
||||
<layer id="1" name="background" width="20" height="15">
|
||||
<data encoding="csv">
|
||||
|
|
@ -70,5 +70,20 @@
|
|||
<property name="interval" type="int" value="4"/>
|
||||
</properties>
|
||||
</object>
|
||||
<object id="24" gid="43" x="128" y="176" width="16" height="16">
|
||||
<properties>
|
||||
<property name="direction" value="left"/>
|
||||
</properties>
|
||||
</object>
|
||||
<object id="25" gid="44" x="144" y="176" width="16" height="16">
|
||||
<properties>
|
||||
<property name="direction" value="up"/>
|
||||
</properties>
|
||||
</object>
|
||||
<object id="26" gid="45" x="160" y="176" width="16" height="16">
|
||||
<properties>
|
||||
<property name="direction" value="down"/>
|
||||
</properties>
|
||||
</object>
|
||||
</objectgroup>
|
||||
</map>
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue