fix into
This commit is contained in:
parent
4dec7e103d
commit
8202e48fa8
63
app/Main.hs
63
app/Main.hs
@ -60,23 +60,25 @@ renderBox' world locMap box boxName ((ylo,xlo),(yhi,xhi)) scale
|
||||
[
|
||||
horizCat
|
||||
[
|
||||
if not (inRange (bounds (boxWalls box)) (y,x)) then unit defAttr '?' else
|
||||
drawAt boxName box y x | x <- [xlo .. xhi]
|
||||
]
|
||||
| y <- [ylo .. yhi]
|
||||
]
|
||||
where
|
||||
unit a x =
|
||||
vertCat (replicate scale (string a (replicate (2*scale) x)))
|
||||
drawAt boxName box y x
|
||||
| let goodCoord = inRange (bounds (boxWalls box))
|
||||
, not (goodCoord (y,x))
|
||||
= unit defAttr '?'
|
||||
| otherwise
|
||||
, let myAttr = boxColor box =
|
||||
if boxWalls box ! (y,x) then unit myAttr '▓'
|
||||
else case Map.lookup (Location boxName y x) locMap of
|
||||
Nothing -> unit myAttr '░'
|
||||
Just n -> renderBox' world locMap box' n (bounds (boxWalls box')) (scale `div` boxSize box)
|
||||
where
|
||||
box' = worldBoxes world Map.! n
|
||||
| x <- [xlo .. xhi]
|
||||
]
|
||||
|
||||
| let myAttr = boxColor box
|
||||
, y <- [ylo .. yhi]
|
||||
]
|
||||
where
|
||||
unit a x =
|
||||
vertCat (replicate scale (string a (replicate (2*scale) x)))
|
||||
|
||||
|
||||
makeWalls :: [String] -> Array Coord Bool
|
||||
makeWalls rows = listArray ((ylo,xlo),(yhi,xhi)) (map (' '/=) (concat rows))
|
||||
@ -153,7 +155,32 @@ world0 = World {
|
||||
"▓ ▓",
|
||||
"▓▓▓ ▓▓▓"
|
||||
]
|
||||
|
||||
}),
|
||||
('3', Box {
|
||||
boxColor = withForeColor defAttr blue,
|
||||
boxLocation = Location '2' 1 1,
|
||||
boxWalls = makeWalls [
|
||||
"▓▓ ▓▓",
|
||||
"▓ ▓ ▓",
|
||||
"▓ ▓",
|
||||
"▓ ▓",
|
||||
"▓ ▓",
|
||||
"▓ ▓",
|
||||
"▓▓▓ ▓▓▓"
|
||||
]
|
||||
}),
|
||||
('4', Box {
|
||||
boxColor = withForeColor defAttr black,
|
||||
boxLocation = Location '3' (-3) 0,
|
||||
boxWalls = makeWalls [
|
||||
"▓▓ ▓▓",
|
||||
"▓ ▓ ▓",
|
||||
"▓ ▓",
|
||||
"▓ ▓",
|
||||
"▓ ▓",
|
||||
"▓ ▓",
|
||||
"▓▓▓ ▓▓▓"
|
||||
]
|
||||
}),
|
||||
('b', Box {
|
||||
boxColor = withForeColor defAttr red,
|
||||
@ -250,24 +277,22 @@ moveBlock world visited loc dir =
|
||||
-- moving a box
|
||||
(name,box):_ ->
|
||||
do loc' <- nextLoc world loc dir
|
||||
guard (not (isWall loc' world))
|
||||
moveBlock' world visited loc loc' dir name box
|
||||
|
||||
moveBlock' world visited loc loc' dir name box =
|
||||
msum [moveTo loc', moveInto loc', moveToEat loc']
|
||||
where
|
||||
moveTo loc' =
|
||||
do guard (not (isWall loc' world))
|
||||
moveBlock world (addVisited loc loc' visited) loc' dir
|
||||
do moveBlock world (addVisited loc loc' visited) loc' dir
|
||||
|
||||
moveInto loc' =
|
||||
do guard (not (isWall loc' world))
|
||||
(n,b) <- boxAt world loc'
|
||||
do (n,b) <- boxAt world loc'
|
||||
let locI = enterLoc n b dir
|
||||
moveBlock world (addVisited loc locI visited) locI dir
|
||||
moveBlock' world visited loc locI dir name box -- beware epsilon!
|
||||
|
||||
moveToEat loc' =
|
||||
do guard (not (isWall loc' world))
|
||||
let dir' = invert dir
|
||||
do let dir' = invert dir
|
||||
let locE = enterLoc name box dir'
|
||||
(name', box') <- boxAt world loc'
|
||||
moveBlock' world (addVisited loc loc' visited) loc' locE dir' name' box'
|
||||
|
Loading…
Reference in New Issue
Block a user