From 0b3555be9eddfb8e9104ca825f3450b87409a188 Mon Sep 17 00:00:00 2001 From: Eric Mertens Date: Fri, 2 Dec 2022 19:33:27 -0800 Subject: [PATCH] fix border render --- app/Rendering.hs | 29 +++++++++++++++++++++++++---- 1 file changed, 25 insertions(+), 4 deletions(-) diff --git a/app/Rendering.hs b/app/Rendering.hs index 629d883..ef9bf53 100644 --- a/app/Rendering.hs +++ b/app/Rendering.hs @@ -55,7 +55,7 @@ drawNestedWorld world = cropRight (2*(2*81 + border)) $ vertCat [ horizCat [ - case stackedLoc world (Location name1 y_ x_) of + case stackedLoc world locMap (Location name1 y_ x_) of Nothing -> unit (withForeColor defAttr black) 81 '?' Just (Location n y x) -> let box = worldBoxes world Map.! n in @@ -74,8 +74,8 @@ drawNestedWorld world = Location name1 y1 x1 = boxLocation (worldBoxes world Map.! name0) -stackedLoc :: World -> Location -> Maybe Location -stackedLoc world = go Set.empty +stackedLoc :: World -> Map Location Char -> Location -> Maybe Location +stackedLoc world locMap = go Set.empty where go visited loc | Set.member loc visited = Nothing @@ -88,7 +88,7 @@ stackedLoc world = go Set.empty let dx = overflow (xlo,xhi) x dy = overflow (ylo,yhi) y Location parent py px = boxLocation box - in go (Set.insert loc visited) (Location parent (py+dy) (px+dx)) + in fixup world locMap dy dx y x <$> go (Set.insert loc visited) (Location parent (py+dy) (px+dx)) overflow :: (Int, Int) -> Int -> Int @@ -96,3 +96,24 @@ overflow (lo,hi) x | x < lo = x - lo | x > hi = x - hi | otherwise = 0 + +fixup :: World -> + Map Location Char -> + Int -> + Int -> + Int -> + Int -> + Location -> + Location +fixup world locMap dy dx py px loc = + case Map.lookup loc locMap of + Nothing -> loc + Just name -> Location name (fixup1 ylo yhi dy py) (fixup1 xlo xhi dx px) + where + ((ylo,xlo),(yhi,xhi)) = bounds (boxWalls world (worldBoxes world Map.! name)) + +fixup1 :: Int -> Int -> Int -> Int -> Int +fixup1 _ _ 0 i = i +fixup1 _ hi (-1) _ = hi +fixup1 lo _ 1 _ = lo +fixup1 _ _ _ _ = error "fixup1: bad delta" \ No newline at end of file