From 66c91096abd0eaa70694ace88aa0d7695d90a8b1 Mon Sep 17 00:00:00 2001 From: Matej Focko Date: Sun, 15 Nov 2020 13:08:10 +0100 Subject: [PATCH 1/2] Implement Show instance for Karel Signed-off-by: Matej Focko --- Internal/Karel.hs | 95 ++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 94 insertions(+), 1 deletion(-) diff --git a/Internal/Karel.hs b/Internal/Karel.hs index cc5b4b7..c981546 100644 --- a/Internal/Karel.hs +++ b/Internal/Karel.hs @@ -2,6 +2,8 @@ module Internal.Karel where +import Text.Printf + import Internal.Types import Internal.World @@ -11,7 +13,98 @@ data Karel = Karel karelBeepers :: Int, karelWorld :: World } - deriving (Show, Eq) + deriving (Eq) + +getHeader :: Karel -> String +getHeader karel = unlines [ + printf " %8s %s %s %s" "POSITION" "FACING" "BEEP-BAG" "BEEP-POS", + printf "(%3d, %3d) %6s %8d %8d" x y dir bag pos, + " Y +" <> replicate (4 * width - 1) '-' <> "+" + ] + where + (x, y) = karelPosition karel + dir = show $ karelDirection karel + bag = karelBeepers karel + pos = getBeepersAt (x, y) $ karelWorld karel + (width, _) = worldDimensions $ karelWorld karel + +getFooter :: Karel -> String +getFooter karel = unlines [ + " +" <> replicate (4 * width - 1) '-' <> "+", + " " <> foldl1 (<>) [ printf " %-2d " column | column <- [1..width] ] <> " X" + ] + where + (width, _) = worldDimensions $ karelWorld karel + +mapDirection :: Karel -> String +mapDirection karel = case karelDirection karel of + North -> " ^ " + East -> " > " + South -> " v " + West -> " < " + +mapCell :: Karel -> Int -> Int -> String +mapCell karel x y + | karelPosition karel == (x, y) = mapDirection karel + | beepersAt > 0 = printf " %-2d" beepersAt + | otherwise = " . " + where beepersAt = getBeepersAt (x, y) $ karelWorld karel + +mapWall :: Karel -> Int -> Int -> String +mapWall karel x y = leftPart <> rightPart + where + world = karelWorld karel + (width, height) = worldDimensions world + wallAtNorth = hasWallAt (x, y) North world + vWallAbove = hasWallAt (x, y + 1) East world + vWallBelow = hasWallAt (x, y - 1) East world + vWallAt = hasWallAt (x, y) East world + verticalWall = vWallAt && vWallAbove + wallEnds = wallAtNorth && (not $ hasWallAt (x + 1, y) North world) + wallStarts = wallAtNorth && x > 1 && (not $ hasWallAt (x - 1, y) North world) + noVWall = not (hasWallAt (x, y) West world || hasWallAt (x, y + 1) West world) + leftPart + | wallStarts && noVWall = "+-" + | wallAtNorth = "--" + | otherwise = " " + rightPart + | wallAtNorth && wallEnds && verticalWall = "-|" + | wallEnds = "-+" + | wallAtNorth && (vWallAbove) = "-+" + | wallAtNorth = "--" + | verticalWall && hasWallAt (x+1, y) North world = " +" + | verticalWall = " |" + | not vWallAbove && vWallAt = " +" + | not vWallAt && vWallAbove = " +" + | otherwise = " " + +getRow :: Karel -> Int -> String +getRow karel row + | row == height = line + | otherwise = horizontalWalls <> "\n" <> line + where + world = karelWorld karel + (width, height) = worldDimensions world + horizontalWalls = " |" <> foldl1 (<>) [ + mapWall karel column row + | column <- [1..width] + ] + line = (printf "%2d |" row) <> foldl1 (<>) [ + position <> wall + | column <- [1..width], + let wall = if hasWallAt (column, row) East world then "|" else " ", + let position = mapCell karel column row + ] + +getMap :: Karel -> String +getMap karel = unlines [ + getRow karel row + | row <- reverse [1..height] + ] + where (_, height) = worldDimensions $ karelWorld karel + +instance Show Karel where + show karel = getHeader karel <> getMap karel <> getFooter karel stepVector :: Direction -> Vector stepVector = \case From bd69dacb93039e0d7f4a167128ca724a32c85e7a Mon Sep 17 00:00:00 2001 From: Matej Focko Date: Sun, 15 Nov 2020 13:28:11 +0100 Subject: [PATCH 2/2] Refactor wall handling in prettyprint Signed-off-by: Matej Focko --- Internal/Karel.hs | 37 ++++++++++++++++++------------------- 1 file changed, 18 insertions(+), 19 deletions(-) diff --git a/Internal/Karel.hs b/Internal/Karel.hs index c981546..43092a7 100644 --- a/Internal/Karel.hs +++ b/Internal/Karel.hs @@ -15,6 +15,10 @@ data Karel = Karel } deriving (Eq) +xor :: Bool -> Bool -> Bool +xor True a = not a +xor False a = a + getHeader :: Karel -> String getHeader karel = unlines [ printf " %8s %s %s %s" "POSITION" "FACING" "BEEP-BAG" "BEEP-POS", @@ -50,32 +54,27 @@ mapCell karel x y | otherwise = " . " where beepersAt = getBeepersAt (x, y) $ karelWorld karel + mapWall :: Karel -> Int -> Int -> String mapWall karel x y = leftPart <> rightPart where world = karelWorld karel - (width, height) = worldDimensions world - wallAtNorth = hasWallAt (x, y) North world - vWallAbove = hasWallAt (x, y + 1) East world - vWallBelow = hasWallAt (x, y - 1) East world - vWallAt = hasWallAt (x, y) East world - verticalWall = vWallAt && vWallAbove - wallEnds = wallAtNorth && (not $ hasWallAt (x + 1, y) North world) - wallStarts = wallAtNorth && x > 1 && (not $ hasWallAt (x - 1, y) North world) - noVWall = not (hasWallAt (x, y) West world || hasWallAt (x, y + 1) West world) + (northWall:eastWall:westWall:_) = map (\d -> hasWallAt (x, y) d world) [North, East, West] + (northWallOnLeft:northWallOnRight:_) = map (\d -> hasWallAt (x + d, y) North world) [-1, 1] + (eastWallAbove:westWallAbove:_) = map (\d -> hasWallAt (x, y + 1) d world) [East, West] + verticalWall = eastWall && eastWallAbove + wallEnds = northWall && not northWallOnRight + wallStarts = northWall && x > 1 && not northWallOnLeft leftPart - | wallStarts && noVWall = "+-" - | wallAtNorth = "--" + | wallStarts && not (westWall || westWallAbove) = "+-" + | northWall = "--" | otherwise = " " rightPart - | wallAtNorth && wallEnds && verticalWall = "-|" - | wallEnds = "-+" - | wallAtNorth && (vWallAbove) = "-+" - | wallAtNorth = "--" - | verticalWall && hasWallAt (x+1, y) North world = " +" + | northWall && wallEnds && verticalWall = "-|" + | wallEnds || (northWall && eastWallAbove) = "-+" + | northWall = "--" + | (verticalWall && northWallOnRight) || (eastWall `xor` eastWallAbove) = " +" | verticalWall = " |" - | not vWallAbove && vWallAt = " +" - | not vWallAt && vWallAbove = " +" | otherwise = " " getRow :: Karel -> Int -> String @@ -89,7 +88,7 @@ getRow karel row mapWall karel column row | column <- [1..width] ] - line = (printf "%2d |" row) <> foldl1 (<>) [ + line = printf "%2d |" row <> foldl1 (<>) [ position <> wall | column <- [1..width], let wall = if hasWallAt (column, row) East world then "|" else " ",