Improve segment intersection test, tweak room bounding

src/Dodge/Room/Corridor.hs

@@ -23,8 +23,8 @@ corridor =
           _rmPath = foldMap (doublePairSet . (,) (V2 20 60)) [V2 20 70, V2 20 5]
         --, _rmPmnts = [spanLightI (V2 0 39.5) (V2 40 39.5)]
         , _rmPmnts = []
-        , _rmBound = [rectNSWE 45 35 (-5) 45]
---        , _rmBound = [rectNSWE 50 40 (-5) 45]
+--        , _rmBound = [rectNSWE 45 35 (-5) 45]
+        , _rmBound = [rectNSWE 60 15 (-5) 45]
         , _rmFloor = Tiled [makeTileFromPoly poly 5]
         , _rmRandPSs = [psRandRanges (10, 30) (30, 60) (0, 2 * pi)]
         , _rmName = "Corridor"

src/Dodge/Room/Room.hs

@@ -404,6 +404,7 @@ doorCor = do
 corDoor :: RandomGen g => State g (MetaTree Room String)
 corDoor = do
     cor <- shuffleLinks corridor <&> rmPmnts .~ []
+--    let cor = corridorN
     return $ tToBTree "corDoor" $ treePost [cor,cor, cleatOnward door]
 
 critsPillarRoom :: Int -> State LayoutVars Room

src/Dodge/Room/Tutorial.hs

@@ -55,20 +55,21 @@ tutAnoTree = do
 --        , return . tToBTree "door" $ treePost [corridor, cleatOnward door]
         , corDoor
 --        , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
---aaa        , lasCenRunClose
---aaa--        , passthroughLockKeyLists lockRoomKeyItems itemRooms
---aaa        , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
---aaa--        , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
---aaa--        , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
---aaa--            , passthroughLockKeyLists
---aaa--                    [(sensorRoomRunPast ElectricSensor, takeOne 
---aaa--                        [-- CRAFT (ENERGYBALLCRAFT TeslaBall) , 
---aaa--                        HELD SPARKGUN])]
---aaa--                    itemRooms
---aaa--        , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
---aaa--        , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
---aaa        , tToBTree "sdr" . return . cleatOnward <$> 
---aaa                (shuffleLinks =<< distributerRoom BulletAmmo 100000)
+        , lasCenRunClose
+--        , passthroughLockKeyLists lockRoomKeyItems itemRooms
+        , tToBTree "door" . return <$> return (cleatOnward door)
+        , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
+--        , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
+--        , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
+--            , passthroughLockKeyLists
+--                    [(sensorRoomRunPast ElectricSensor, takeOne 
+--                        [-- CRAFT (ENERGYBALLCRAFT TeslaBall) , 
+--                        HELD SPARKGUN])]
+--                    itemRooms
+--        , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
+--        , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
+        , tToBTree "sdr" . return . cleatOnward <$> 
+                (shuffleLinks =<< distributerRoom BulletAmmo 100000)
 --aaa--        , return $ tToBTree "cor" $ return $ cleatOnward corridor
 --aaa--        --, tToBTree "sdr" . return . cleatOnward <$> slowDoorRoom
 --aaa----        , tToBTree "sr" . return . cleatOnward <$> tanksRoom [] []

src/Dodge/Tree/Shift.hs

@@ -10,7 +10,7 @@ module Dodge.Tree.Shift (
     PosRooms (..),
 ) where
 
-import Data.Monoid
+--import Data.Monoid
 import Control.Lens
 import Data.Bifunctor
 import Data.List (delete)
@@ -67,9 +67,10 @@ posRms prs parenti@(parent, _) ((numChild, t@(Node childi _)) : its) tseq = do
       where
         tryChildLinks [] = tryParentLinks ls
         tryChildLinks ((numinlink, il) : ils)
-            | Just xs <- clipping' = do
-                putStrLn $ show xs
-                tryChildLinks ils
+--            | Just xs <- clipping' = do
+--                putStrLn $ show xs
+--                tryChildLinks ils
+            | clipping = tryChildLinks ils
             | otherwise = do
                 putStrLn $ show j ++ "-" ++ show numinlink
                 mayrs <-
@@ -86,7 +87,7 @@ posRms prs parenti@(parent, _) ((numChild, t@(Node childi _)) : its) tseq = do
           where
             newBounds = map pointsToPoly . _rmBound . doRoomShift . fst $ rootLabel shiftedt
             clipping = or (convexPolysOverlap <$> newBounds <*> _prBounds prs)
-            clipping' = getFirst . foldMap First $ convexPolysOverlapWitness <$> newBounds <*> _prBounds prs
+--            clipping' = getFirst . foldMap First $ convexPolysOverlapWitness <$> newBounds <*> _prBounds prs
             updateparent rm =
                 _rmLinkEff rm il child numChild outlnk rm
                     & rmLinks %~ delete outlnk