diff --git a/src/Dodge/LevelGen/StaticWalls.hs b/src/Dodge/LevelGen/StaticWalls.hs index feeeb3a94..22c66e976 100644 --- a/src/Dodge/LevelGen/StaticWalls.hs +++ b/src/Dodge/LevelGen/StaticWalls.hs @@ -198,23 +198,25 @@ pointIfNotClose ps p = case findClosePoint ps p of Nothing -> Just p _ -> Nothing -- | Fuses a point with one in a list if any are close enough. -fusePoint :: [Point2] -> Point2 -> Point2 -fusePoint ps p = fromMaybe p $ findClosePoint ps p +fusePoint :: [Point2] -> Point2 -> ([Point2],Point2) +fusePoint ps p = case findClosePoint ps p of + Just q -> (ps,q) + Nothing -> (p:ps,p) -- | Given a list of points and wall, moves the wall to be on the points if it is -- close to any of the points. -- If either wall point is not moved, this point gets added to the list. -fuseWall :: ([Point2], WallP) -> ([Point2], WallP) -fuseWall (ps, (x,y)) = ( nub (x':y':ps) , (x',y') ) +fuseWall :: [Point2] -> WallP -> ([Point2], WallP) +fuseWall ps (x,y) = ( rs , (x',y') ) where - x' = fusePoint ps x - y' = fusePoint (x':ps) y + (qs,y') = fusePoint ps y + (rs,x') = fusePoint qs x -- | Given list of points and collection of walls, fuses the wall ends if -- they are close to the list of points or each other. fuseWallsWith :: [Point2] -> [WallP] -> [WallP] -fuseWallsWith zs ws = snd $ foldr fuseWalls' (zs, []) ws +fuseWallsWith zs ws = snd $ foldr fuseWalls (zs, []) ws where - fuseWalls' w (ps, ws') = - let (qs, w') = fuseWall (ps, w) + fuseWalls w (ps, ws') = + let (qs, w') = fuseWall ps w in (qs, w' : ws') -- | Test if fst p == snd p. wallIsZeroLength :: Eq a => (a,a) -> Bool