diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 26e3a6174..a1461cd9e 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -68,7 +68,7 @@ wallsFromTree t = . divideWalls . assignKeys . foldr cutWalls [] -- $ map (map (g . roundPoint2)) - . map (map roundPoint2) +-- . map (map roundPoint2) $ (concatMap _rmPolys $ flatten t) where assignKeys = IM.fromList . zip [0..] . zipWith f [0..] diff --git a/src/Dodge/LevelGen/StaticWalls.hs b/src/Dodge/LevelGen/StaticWalls.hs index c31212278..192104f16 100644 --- a/src/Dodge/LevelGen/StaticWalls.hs +++ b/src/Dodge/LevelGen/StaticWalls.hs @@ -51,7 +51,7 @@ cutWalls' qs walls = nub . filter (not.wallIsZeroLength) . fuseWallsWith zs - . createPolyWalls rs + . addPolyWalls rs -- . removeWallsInPolygon ps -- . filter (not.wallIsZeroLength) -- . fuseWallsWith zs @@ -65,7 +65,7 @@ cutWalls' qs walls = -- split walls that intersect with the polygon into two -- (possibly three if the wall extends across the polygon) -- remove any created walls that are inside the polygon --- draw the required new walls along the polygon boundary +-- create the required new walls along the polygon boundary -- fuse wall endpoints that end up close to each or to polygon intersection points -- remove any walls that ended up zero length after fusing -- remove any duplicate walls @@ -77,7 +77,7 @@ cutWallsWithPoints :: [Point2] -> [WallP] -> ([Point2], [WallP] ) cutWallsWithPoints (p:ps) ws = foldr f ([],ws) (zip (p:ps) (ps++[p])) where f (p1,p2) (as,ws') = - ( as ++ cutWallsPoints p1 p2 ws' + ( nub $ as ++ cutWallsPoints p1 p2 ws' , concatMap (cutWall p1 p2) ws' ) @@ -86,20 +86,19 @@ cutWallsPoints :: Point2 -> Point2 -> [WallP] -> [Point2] --cutWallsPoints p1 p2 ws = mapMaybe (\(x:y:_) -> intersectExtendedSegSeg p1 p2 x y) cutWallsPoints p1 p2 ws = mapMaybe (uncurry $ myIntersectSegSeg p1 p2) ws --- given a segment and a wall, adds a cut point to the wall if it intersects the --- segment +-- given a segment and a wall, split the wall into two if it crosses the segment cutWall :: Point2 -> Point2 -> WallP -> [WallP] cutWall p1 p2 (x,y) = case myIntersectSegSeg p1 p2 x y of Nothing -> [(x,y)] Just cp -> [(x,cp),(cp,y)] -createPolyWalls :: [Point2] -> [WallP] -> [WallP] -createPolyWalls (q:qs) walls = foldr createPolyWall walls (zip (q:qs) (qs++[q])) +addPolyWalls :: [Point2] -> [WallP] -> [WallP] +addPolyWalls (q:qs) walls = foldr addPolyWall walls (zip (q:qs) (qs++[q])) -- adds a wall if there is not already a wall on the clockwise normal to this wall -- such that this existing wall faces towards the new wall -createPolyWall :: WallP -> [WallP] -> [WallP] -createPolyWall (p1,p2) walls = +addPolyWall :: WallP -> [WallP] -> [WallP] +addPolyWall (p1,p2) walls = case maybeW of Just (x,y) -> if isLHS x y p3 then walls else (p1,p2) : walls diff --git a/src/Geometry.hs b/src/Geometry.hs index af5147c2b..d4df0464b 100644 --- a/src/Geometry.hs +++ b/src/Geometry.hs @@ -101,7 +101,6 @@ safeNormalizeV !(0,0) = (0,0) safeNormalizeV !p = normalizeV p -- tests whether a point is on the LHS of a line --- this has been called somewhere with l1 == l2 isLHS :: Point2 -> Point2 -> Point2 -> Bool {-# INLINE isLHS #-} isLHS' :: (Float, Float) -> (Float, Float) -> Point2 -> Bool