Fix export and use correct direction and position

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

View file

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