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

Fix export and use correct direction and position

Browse source 
Signed-off-by: Matej Focko <me@mfocko.xyz>
This commit is contained in:
Matej Focko 2020-11-15 13:07:08 +01:00
parent 170a64ef77
commit d31939c6ed
No known key found for this signature in database
GPG key ID: DE0CF444096A468D
1 changed files with 10 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
Internal/World.hs
View file

@ -1,7 +1,7 @@
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
module Internal.World module Internal.World
( World, ( World(..),
worldWithDimensions, worldWithDimensions,
getBeepersAt, getBeepersAt,
setBeepersAt, setBeepersAt,
@ -70,29 +70,29 @@ addWallAt :: Vector -> Direction -> World -> World
addWallAt pos dir w addWallAt pos dir w
| not $ positionWithinWorld w newPosition = error "Invalid position" | not $ positionWithinWorld w newPosition = error "Invalid position"
| isOnEdge (worldDimensions w) newPosition newDirection = w | isOnEdge (worldDimensions w) newPosition newDirection = w
| otherwise = w {worldWalls = M.insert pos newWalls (worldWalls w)} | otherwise = w {worldWalls = M.insert newPosition newWalls (worldWalls w)}
where where
(newPosition, newDirection) = switchDirectionToInternal pos dir (newPosition, newDirection) = switchDirectionToInternal pos dir
oldWalls = M.findWithDefault S.empty pos (worldWalls w) oldWalls = M.findWithDefault S.empty newPosition (worldWalls w)
newWalls = S.union oldWalls $ S.singleton dir newWalls = S.union oldWalls $ S.singleton newDirection
removeWallAt :: Vector -> Direction -> World -> World removeWallAt :: Vector -> Direction -> World -> World
removeWallAt pos dir w removeWallAt pos dir w
| not $ positionWithinWorld w newPosition = error "Invalid position" | not $ positionWithinWorld w newPosition = error "Invalid position"
| isOnEdge (worldDimensions w) newPosition newDirection = w | isOnEdge (worldDimensions w) newPosition newDirection = w
| S.null newWalls = w {worldWalls = M.delete pos (worldWalls w)} | S.null newWalls = w {worldWalls = M.delete newPosition (worldWalls w)}
| otherwise = w {worldWalls = M.insert pos newWalls (worldWalls w)} | otherwise = w {worldWalls = M.insert newPosition newWalls (worldWalls w)}
where where
(newPosition, newDirection) = switchDirectionToInternal pos dir (newPosition, newDirection) = switchDirectionToInternal pos dir
oldWalls = M.findWithDefault S.empty pos (worldWalls w) oldWalls = M.findWithDefault S.empty newPosition (worldWalls w)
newWalls = oldWalls S.\\ S.singleton dir newWalls = oldWalls S.\\ S.singleton newDirection
hasWallAt :: Vector -> Direction -> World -> Bool hasWallAt :: Vector -> Direction -> World -> Bool
hasWallAt pos dir w hasWallAt pos dir w
| not $ positionWithinWorld w newPosition = False | not $ positionWithinWorld w newPosition = False
| isOnEdge (worldDimensions w) newPosition newDirection = True | isOnEdge (worldDimensions w) newPosition newDirection = True
| otherwise = case worldWalls w M.!? pos of | otherwise = case worldWalls w M.!? newPosition of
Just wallsInPlace -> S.member dir wallsInPlace Just wallsInPlace -> S.member newDirection wallsInPlace
Nothing -> False Nothing -> False
where where
(newPosition, newDirection) = switchDirectionToInternal pos dir (newPosition, newDirection) = switchDirectionToInternal pos dir