Implement Show instance for Karel #3
1 changed files with 94 additions and 1 deletions
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue