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
|
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 '▓'
|
if boxWalls box ! (y,x) then unit myAttr '▓'
|
||||||
else case Map.lookup (Location boxName y x) locMap of
|
else case Map.lookup (Location boxName y x) locMap of
|
||||||
Nothing -> unit myAttr '░'
|
Nothing -> unit myAttr '░'
|
||||||
Just n -> renderBox' world locMap box' n (bounds (boxWalls box')) (scale `div` boxSize box)
|
Just n -> renderBox' world locMap box' n (bounds (boxWalls box')) (scale `div` boxSize box)
|
||||||
where
|
where
|
||||||
box' = worldBoxes world Map.! n
|
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 :: [String] -> Array Coord Bool
|
||||||
makeWalls rows = listArray ((ylo,xlo),(yhi,xhi)) (map (' '/=) (concat rows))
|
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 {
|
('b', Box {
|
||||||
boxColor = withForeColor defAttr red,
|
boxColor = withForeColor defAttr red,
|
||||||
|
@ -250,24 +277,22 @@ moveBlock world visited loc dir =
|
||||||
-- moving a box
|
-- moving a box
|
||||||
(name,box):_ ->
|
(name,box):_ ->
|
||||||
do loc' <- nextLoc world loc dir
|
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
|
||||||
|
|
||||||
moveBlock' world visited loc loc' dir name box =
|
moveBlock' world visited loc loc' dir name box =
|
||||||
msum [moveTo loc', moveInto loc', moveToEat loc']
|
msum [moveTo loc', moveInto loc', moveToEat loc']
|
||||||
where
|
where
|
||||||
moveTo loc' =
|
moveTo loc' =
|
||||||
do guard (not (isWall loc' world))
|
do moveBlock world (addVisited loc loc' visited) loc' dir
|
||||||
moveBlock world (addVisited loc loc' visited) loc' dir
|
|
||||||
|
|
||||||
moveInto loc' =
|
moveInto loc' =
|
||||||
do guard (not (isWall loc' world))
|
do (n,b) <- boxAt world loc'
|
||||||
(n,b) <- boxAt world loc'
|
|
||||||
let locI = enterLoc n b dir
|
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' =
|
moveToEat loc' =
|
||||||
do guard (not (isWall loc' world))
|
do let dir' = invert dir
|
||||||
let dir' = invert dir
|
|
||||||
let locE = enterLoc name box dir'
|
let locE = enterLoc name box dir'
|
||||||
(name', box') <- boxAt world loc'
|
(name', box') <- boxAt world loc'
|
||||||
moveBlock' world (addVisited loc loc' visited) loc' locE dir' name' box'
|
moveBlock' world (addVisited loc loc' visited) loc' locE dir' name' box'
|
||||||
|
|
Loading…
Reference in New Issue
Block a user