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