mfocko/haskell-karel
1
0
Fork 0
Code Issues 1 Pull requests Projects Releases Wiki Activity

Implement Show instance for Karel #3

Manually merged
mfocko merged 2 commits from show-instance into main 2020-11-15 16:56:55 +01:00
Conversation 0 Commits 2 Files changed 1 +18 -19
1 changed files with 18 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files
Showing only changes of commit bd69dacb93 - Show all commits

37
Internal/Karel.hs
View file

@ -15,6 +15,10 @@ data Karel = Karel
} }
deriving (Eq) deriving (Eq)
xor :: Bool -> Bool -> Bool
xor True a = not a
xor False a = a
getHeader :: Karel -> String getHeader :: Karel -> String
getHeader karel = unlines [ getHeader karel = unlines [
printf " %8s %s %s %s" "POSITION" "FACING" "BEEP-BAG" "BEEP-POS", printf " %8s %s %s %s" "POSITION" "FACING" "BEEP-BAG" "BEEP-POS",
@ -50,32 +54,27 @@ mapCell karel x y
| otherwise = " . " | otherwise = " . "
where beepersAt = getBeepersAt (x, y) $ karelWorld karel where beepersAt = getBeepersAt (x, y) $ karelWorld karel
mapWall :: Karel -> Int -> Int -> String mapWall :: Karel -> Int -> Int -> String
mapWall karel x y = leftPart <> rightPart mapWall karel x y = leftPart <> rightPart
where where
world = karelWorld karel world = karelWorld karel
(width, height) = worldDimensions world (northWall:eastWall:westWall:_) = map (\d -> hasWallAt (x, y) d world) [North, East, West]
wallAtNorth = hasWallAt (x, y) North world (northWallOnLeft:northWallOnRight:_) = map (\d -> hasWallAt (x + d, y) North world) [-1, 1]
vWallAbove = hasWallAt (x, y + 1) East world (eastWallAbove:westWallAbove:_) = map (\d -> hasWallAt (x, y + 1) d world) [East, West]
vWallBelow = hasWallAt (x, y - 1) East world verticalWall = eastWall && eastWallAbove
vWallAt = hasWallAt (x, y) East world wallEnds = northWall && not northWallOnRight
verticalWall = vWallAt && vWallAbove wallStarts = northWall && x > 1 && not northWallOnLeft
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 leftPart
| wallStarts && noVWall = "+-" | wallStarts && not (westWall || westWallAbove) = "+-"
| wallAtNorth = "--" | northWall = "--"
| otherwise = " " | otherwise = " "
rightPart rightPart
| wallAtNorth && wallEnds && verticalWall = "-|" | northWall && wallEnds && verticalWall = "-|"
| wallEnds = "-+" | wallEnds || (northWall && eastWallAbove) = "-+"
| wallAtNorth && (vWallAbove) = "-+" | northWall = "--"
| wallAtNorth = "--" | (verticalWall && northWallOnRight) || (eastWall `xor` eastWallAbove) = " +"
| verticalWall && hasWallAt (x+1, y) North world = " +"
| verticalWall = " |" | verticalWall = " |"
| not vWallAbove && vWallAt = " +"
| not vWallAt && vWallAbove = " +"
| otherwise = " " | otherwise = " "
getRow :: Karel -> Int -> String getRow :: Karel -> Int -> String
@ -89,7 +88,7 @@ getRow karel row
mapWall karel column row mapWall karel column row
| column <- [1..width] | column <- [1..width]
] ]
line = (printf "%2d |" row) <> foldl1 (<>) [ line = printf "%2d |" row <> foldl1 (<>) [
position <> wall position <> wall
| column <- [1..width], | column <- [1..width],
let wall = if hasWallAt (column, row) East world then "|" else " ", let wall = if hasWallAt (column, row) East world then "|" else " ",