Hack fix to wall carving, expand polygon and retry if first cut fails

src/Dodge/LevelGen/StaticWalls.hs

@@ -25,8 +25,20 @@ type WallP = (Point2,Point2)
 
 -- | Cut out a polygon from a set of walls, and check for errors in the
 -- created walls.
+-- If created walls are not consistent, expand poly and retry.
 cutWalls :: [Point2] -> [WallP] -> [WallP]
 cutWalls ps wls = case mapMaybe (flip checkWallRight newWalls) newWalls of
+    [] -> newWalls
+    _  -> cutWalls (expandPolyBy 0.01 ps) wls
+  where
+    newWalls = cutWalls' ps wls
+    errsL = mapMaybe (flip checkWallLeft newWalls) newWalls
+
+-- | Cut out a polygon from a set of walls, and check for errors in the
+-- created walls.
+-- Give error if created walls are not consistent.
+cutWalls'' :: [Point2] -> [WallP] -> [WallP]
+cutWalls'' ps wls = case mapMaybe (flip checkWallRight newWalls) newWalls of
     [] -> newWalls
     errs -> error $ "during level generation function cutWalls: when cutting poly:\n" ++ show ps 
         ++ "\nRight corner errors:\n"
@@ -73,13 +85,16 @@ checkWallLeft (x,y) wls
 -- (possibly three if the wall extends across the polygon),
 -- 2. remove any created walls that are inside the polygon,
 -- 3. create the required new walls along the polygon boundary.
+-- 4. fuse wall endpoints that end up close to each or to polygon intersection points
+-- 5. remove any walls that ended up zero length after fusing
+-- 6. remove any duplicate walls
 -- Unclear behaviour if a line in the polygon is colinear with a wall.
 cutWalls' :: [Point2] -> [WallP] -> [WallP]
 cutWalls' qs walls = 
---    nub
---    . filter (not.wallIsZeroLength) 
---    . fuseWallsWith zs
-    addPolyWalls rs  
+    nub
+    . filter (not.wallIsZeroLength) 
+    . fuseWallsWith zs
+    . addPolyWalls rs  
 --    . removeWallsInPolygon ps 
 --    . filter (not.wallIsZeroLength) 
 --    . fuseWallsWith zs
@@ -89,10 +104,14 @@ cutWalls' qs walls =
     (zs,cwals) = cutWallsWithPoints ps walls
     ps = orderPolygon qs
     rs = orderPolygon $ nub $ zs ++ qs
--- unused steps:
--- 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
+
+-- | Given a value and a poly, pushes the poly points out from the center by the
+-- value amount.
+expandPolyBy :: Float -> [Point2] -> [Point2]
+expandPolyBy x ps = map f ps
+  where
+    cp = (1/(fromIntegral (length ps))) *.* (foldr (+.+) (0,0) ps)
+    f p = p +.+ x *.* (p -.- cp)
 
 -- | Given a polygon expressed as a list of points and a collection of walls,
 -- returns: