Implement Show instance for Karel #3
1 changed files with 93 additions and 1 deletions
|
@ -2,6 +2,8 @@
|
||||||
|
|
||||||
module Internal.Karel where
|
module Internal.Karel where
|
||||||
|
|
||||||
|
import Text.Printf
|
||||||
|
|
||||||
import Internal.Types
|
import Internal.Types
|
||||||
import Internal.World
|
import Internal.World
|
||||||
|
|
||||||
|
@ -11,7 +13,97 @@ data Karel = Karel
|
||||||
karelBeepers :: Int,
|
karelBeepers :: Int,
|
||||||
karelWorld :: World
|
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 :: Direction -> Vector
|
||||||
stepVector = \case
|
stepVector = \case
|
||||||
|
|
Loading…
Reference in a new issue