diff --git a/Internal/Karel.hs b/Internal/Karel.hs index cc5b4b7..43092a7 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,97 @@ data Karel = Karel karelBeepers :: Int, karelWorld :: World } - deriving (Show, Eq) + 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", + 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 + (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 && not (westWall || westWallAbove) = "+-" + | northWall = "--" + | otherwise = " " + rightPart + | northWall && wallEnds && verticalWall = "-|" + | wallEnds || (northWall && eastWallAbove) = "-+" + | northWall = "--" + | (verticalWall && northWallOnRight) || (eastWall `xor` eastWallAbove) = " +" + | verticalWall = " |" + | 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