glguy/parabox
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fix into

Browse Source
This commit is contained in:
Eric Mertens 2022-11-30 23:20:18 -08:00
parent 4dec7e103d
commit 8202e48fa8
1 changed files with 47 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
app/Main.hs
View File

@ -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]
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]
] ]
| y <- [ylo .. yhi]
| let myAttr = boxColor box
, y <- [ylo .. yhi]
] ]
where where
unit a x = unit a x =
vertCat (replicate scale (string a (replicate (2*scale) 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
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,
@ -214,9 +241,9 @@ loop vty (world :| history) =
EvKey key _modifier -> EvKey key _modifier ->
case key of case key of
KUp -> loop vty (move world (-1,0) :| world : history) KUp -> loop vty (move world (-1,0) :| world : history)
KDown -> loop vty (move world (1,0) :| world : history) KDown -> loop vty (move world (1,0) :| world : history)
KLeft -> loop vty (move world (0,-1) :| world : history) KLeft -> loop vty (move world (0,-1) :| world : history)
KRight -> loop vty (move world (0,1) :| world : history) KRight -> loop vty (move world (0,1) :| world : history)
KChar 'z' KChar 'z'
| Just worlds <- NonEmpty.nonEmpty history -> | Just worlds <- NonEmpty.nonEmpty history ->
loop vty worlds loop vty worlds
@ -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'