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
[
if not (inRange (bounds (boxWalls box)) (y,x)) then unit defAttr '?' else
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]
drawAt boxName box y x | x <- [xlo .. xhi]
]
| let myAttr = boxColor box
, y <- [ylo .. yhi]
| 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
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,
@ -214,9 +241,9 @@ loop vty (world :| history) =
EvKey key _modifier ->
case key of
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)
KRight -> loop vty (move world (0,1) :| world : history)
KRight -> loop vty (move world (0,1) :| world : history)
KChar 'z'
| Just worlds <- NonEmpty.nonEmpty history ->
loop vty worlds
@ -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'