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

src/Dodge/Floor.hs

@@ -36,41 +36,41 @@ lev1 = do
             ++ [return $ connectRoom corridor
                ,return $ connectRoom door
                ,glassSwitchBack >>= randomiseLinks]
---            ++ [return $ connectRoom corridor
---               ,return $ connectRoom door]
---            ++ [miniRoom3]
---            ++ [return $ connectRoom corridor
---               ,return $ connectRoom door]
---            ++ [roomCCrits]
---            ++ [return $ connectRoom corridor
---               ,return $ connectRoom door]
---            ++[roomMiniIntro]
---            ++ [longRoom >>= randomiseLinks]
---            ++ [return $ connectRoom corridor
---               ,return $ connectRoom door]
+            ++ [return $ connectRoom corridor
+               ,return $ connectRoom door]
+            ++ [miniRoom3]
+            ++ [return $ connectRoom corridor
+               ,return $ connectRoom door]
+            ++ [roomCCrits]
+            ++ [return $ connectRoom corridor
+               ,return $ connectRoom door]
+            ++[roomMiniIntro]
+            ++ [longRoom >>= randomiseLinks]
+            ++ [return $ connectRoom corridor
+               ,return $ connectRoom door]
             ++ firstWeapon
---            ++ [return $ connectRoom corridor
---               ,return $ connectRoom door]
---            ++ [randomiseLinks =<< pistolerRoom]
---            ++ [return $ connectRoom door]
---             ++ [randomiseLinks =<< shooterRoom]
---             ++ (replicate 3 $ randomiseLinks corridor)
---            ++ [return $ connectRoom (set rmPS [PS (20,40) 0 basicLS] corridor)]
---            ++ [return $ connectRoom corridor]
---             ++ (replicate 3 $ randomiseLinks corridor)
---            ++ [return $ connectRoom corridor]
---            ++[return $ connectRoom corridor,return $ connectRoom door]
---            ++ [shootingRange]
---               ++ (replicate 3 $ randomiseLinks corridor)
---              ++[roomMiniIntro]
---               ++ (replicate 3 $ randomiseLinks corridor)
---              ++ [return $ connectRoom corridor
---                 ,return $ connectRoom door
---                 ,slowDoorRoom]
---            ++ [return $ connectRoom corridor
---               ,spawnerRoom
---               ,return $ connectRoom corridor
---               ]
+            ++ [return $ connectRoom corridor
+               ,return $ connectRoom door]
+            ++ [randomiseLinks =<< pistolerRoom]
+            ++ [return $ connectRoom door]
+             ++ [randomiseLinks =<< shooterRoom]
+             ++ (replicate 3 $ randomiseLinks corridor)
+            ++ [return $ connectRoom (set rmPS [PS (20,40) 0 basicLS] corridor)]
+            ++ [return $ connectRoom corridor]
+             ++ (replicate 3 $ randomiseLinks corridor)
+            ++ [return $ connectRoom corridor]
+            ++[return $ connectRoom corridor,return $ connectRoom door]
+            ++ [shootingRange]
+               ++ (replicate 3 $ randomiseLinks corridor)
+              ++[roomMiniIntro]
+               ++ (replicate 3 $ randomiseLinks corridor)
+              ++ [return $ connectRoom corridor
+                 ,return $ connectRoom door
+                 ,slowDoorRoom]
+            ++ [return $ connectRoom corridor
+               ,spawnerRoom
+               ,return $ connectRoom corridor
+               ]
             )
             $ randomiseLinks corridor
 

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: