Partial fix to level generation

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..]

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
+-- given a segment and a wall, split the wall into two if it crosses the segment
--- 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]
+addPolyWalls :: [Point2] -> [WallP] -> [WallP]
-createPolyWalls (q:qs) walls = foldr createPolyWall walls (zip (q:qs) (qs++[q]))
+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]
+addPolyWall :: WallP -> [WallP] -> [WallP]
-createPolyWall (p1,p2) walls = 
+addPolyWall (p1,p2) walls = 
     case maybeW of Just (x,y) -> if isLHS x y p3
                                  then walls
                                  else (p1,p2) : walls

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