From f71724ae8bd223c614bf7b486312a57cc4764db6 Mon Sep 17 00:00:00 2001
From: jgk <justin.g.kruger@gmail.com>
Date: Sun, 2 May 2021 23:10:36 +0200
Subject: [PATCH] Tweak wall cutting

---
 src/Dodge/Floor.hs                |  2 +-
 src/Dodge/LevelGen/StaticWalls.hs | 15 +++++++++++++--
 2 files changed, 14 insertions(+), 3 deletions(-)

diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs
index 76e767185..884dba5f4 100644
--- a/src/Dodge/Floor.hs
+++ b/src/Dodge/Floor.hs
@@ -38,7 +38,7 @@ roomTreex :: RandomGen g => State g (Maybe [Room])
 roomTreex = do
     struct' <- aTreeStrut
 --    let struct = treeFromPost [[SpecificRoom $ fmap (pure . Right) pistolerRoom]] [EndRoom]
-    let struct = treeFromPost [[SpecificRoom $ fmap (pure . Right) testRoom]] [EndRoom]
+    let struct = treeFromPost [[Corridor,SpecificRoom $ fmap (pure . Right) testRoom]] [EndRoom]
     let t' = padCorridors struct
         t = treeFromTrunk 
             [[StartRoom]
diff --git a/src/Dodge/LevelGen/StaticWalls.hs b/src/Dodge/LevelGen/StaticWalls.hs
index 6fa010355..2f669d7af 100644
--- a/src/Dodge/LevelGen/StaticWalls.hs
+++ b/src/Dodge/LevelGen/StaticWalls.hs
@@ -41,11 +41,22 @@ removeInverseWalls ps = ps
 
 -- | 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.
+-- If created walls are not consistent, rotate and expand poly and retry.
 cutWalls :: [Point2] -> [WallP] -> [WallP]
 cutWalls ps wls = case mapMaybe (`checkWallRight` newWalls) newWalls of
     [] -> newWalls
-    _  -> cutWalls (expandPolyBy 0.01 ps) wls
+--    _  -> cutWalls (expandPolyBy 100 ps) wls
+--    _  -> cutWalls (expandPolyBy 0.01 ps) wls
+    _  -> cutWalls (map (rotateV 0.001) $ expandPolyBy 0.01 ps) wls
+  where
+    newWalls = cutWalls' ps wls
+    errsL = mapMaybe (`checkWallLeft` newWalls) newWalls
+
+cutWallsL ps wls = case mapMaybe (`checkWallRight` newWalls) newWalls of
+    [] -> newWalls
+--    _  -> cutWalls (expandPolyBy 100 ps) wls
+--    _  -> cutWalls (expandPolyBy 0.01 ps) wls
+    _  -> cutWalls (map (rotateV (-0.001)) $ expandPolyBy 0.01 ps) wls
   where
     newWalls = cutWalls' ps wls
     errsL = mapMaybe (`checkWallLeft` newWalls) newWalls