Fix bug that allowed for in links to be used as out links

src/Dodge/Floor.hs

@@ -8,7 +8,6 @@ import Dodge.Data
 import Dodge.LockAndKey
 import Dodge.Creature.State.Data
 import Dodge.Room
-import Dodge.Room
 import Dodge.Placement.Instance.Button
 import Dodge.Tree
 import Dodge.Annotation
@@ -37,8 +36,7 @@ initialAnoTree :: RandomGen g => Tree [Annotation g]
 initialAnoTree = padSucWithCorridors $ treeFromTrunk 
     [[AnoApplyInt 0 startRoom]
     , [PassthroughLockKeyLists 2 lockRoomKeyItems itemRooms]
-    , [AnoApplyInt 2 room2]
+    --, [AnoApplyInt 1 lasSensorTurretTest]
-    , [AnoApplyInt 1 lasSensorTurretTest]
 --    ,[ChainAnos 
 --        [[SetLabel 0 $ return $ roomRectAutoLinks 200 200 
 --            & rmExtPmnt ?~ triggerSwitchSPicLight (drawSwitchWire red red)
@@ -49,12 +47,12 @@ initialAnoTree = padSucWithCorridors $ treeFromTrunk
 --        ]
 --     ]
 --    ,[SpecificRoom $ return $ connectRoom lasTunnel ]
---    ,[SpecificRoom $ fmap connectRoom slowDoorRoom ]
+    ,[SpecificRoom $ fmap singleUseAll slowDoorRoom ]
---    ,[Corridor]
+    ,[Corridor]
---    ,[Corridor]
+    ,[Corridor]
---    ,[SpecificRoom $ fmap connectRoom roomCCrits]
+    ,[SpecificRoom $ fmap singleUseAll roomCCrits]
---    ,[AirlockAno]
+    ,[AirlockAno]
---    ,[Corridor]
+    ,[Corridor]
 ------    ,[SpecificRoom roomCCrits]
 ------    ,[Corridor]
 ------    ,[SpecificRoom . pure . pure . UseAll $ roomGlassOctogon 400 

src/Dodge/Room/Airlock.hs

@@ -128,6 +128,7 @@ airlock90 = defaultRoom
         , (150,100)
         , (100,10)
         ]]
+    , _rmName = "airlock90"
     }
   where 
     --cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)

src/Dodge/Room/Boss.hs

@@ -13,6 +13,7 @@ import Dodge.Room.Path
 import Dodge.Creature
 import Dodge.RandomHelp
 import Dodge.Tree
+import Dodge.LevelGen.StaticWalls
 import Geometry
 
 import Data.Tree
@@ -146,7 +147,7 @@ roomTwistCross x y z =
             , _rmLinks  = [(V2 z (y-20), pi/2)]
             , _rmPath   = []
             , _rmPmnts  = [mntLS iShape (V2 x x) (V3 (x-20) (x-20) 70)]
-            , _rmBound  = ps
+            , _rmBound  = map (expandPolyCorners 10) ps
             }
     in (foldr1 combineRooms $ map (\r -> shiftRoomBy (V2 0 0, r) corner) [0,pi/2,pi,3*pi/2])
         {_rmName = "twistCross" }

src/Dodge/Room/LasTurret.hs

@@ -53,8 +53,8 @@ lightSensByDoor rm = rm
     & rmPmnts %~ ( 
         [ psPt atFstLnkOut $ PutForeground $ colorSH yellow 
             $ barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80)
-        , heightWallPS (atNthLnkOutShiftInward 1 100) 30 (rectNSEW (10) (-10) 20 (-20))
+        , heightWallPS (atNthLnkOutShiftInward 1 100) 30 (rectNSEW 10 (-10) 20 (-20))
-        , heightWallPS (atFstLnkOutShiftInward 100) 30 (rectNSEW (10) (-10) 20 (-20))
+        , heightWallPS (atFstLnkOutShiftInward 100) 30 (rectNSEW 10 (-10) 20 (-20))
         ] ++ )
     & rmExtPmnt ?~
         extTrigLitPos (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))

src/Dodge/Tree/Polymorphic.hs

@@ -84,7 +84,7 @@ updateSingleNode f update t@(Node x ts)
     updateChildren = map (Node x) (subMap (updateSingleNode f update) ts)
 
 subMap :: (a -> [a]) -> [a] -> [[a]]
-subMap f (x:xs) = (f x <&> (: xs)) ++ ( (x :) <$> (subMap f xs) )
+subMap f (x:xs) = (f x <&> (: xs)) ++ ( (x :) <$> subMap f xs ) 
 subMap _ [] = []
 
 --subMap' :: Monad m => (a -> m a) -> [a] -> m [a]

src/Dodge/Tree/Shift.hs

@@ -33,10 +33,10 @@ posRms bounds (parent,_) _ [] st = case st of
     Node childi ts :<| tseq 
         -> fmap (finalLinksUpdate parent:) <$> posRms bounds childi 0 ts tseq
 posRms bounds parenti@(pr,i) numChild (t@(Node (cr,i') _):ts) tseq = do
-    putStr $ (rpns 20 (_rmName cr ++ "-" ++ show i')) 
+    putStr $ rpns 20 (_rmName cr ++ "-" ++ show i')
-          ++ (rpns 9 (" child " ++ show numChild ))
+          ++ rpns 9 (" child " ++ show numChild )
-          ++ (rpns 25 (" of " ++ _rmName pr ++ "-" ++ show i ))
+          ++ rpns 25 (" of " ++ _rmName pr ++ "-" ++ show i )
-    tryLinks (0::Int) (_rmLinks parent)
+    tryLinks (0::Int) (init $ _rmLinks parent)
   where
     rpns x s = rightPadNoSquash x ' ' s
     parent = fst parenti
@@ -50,9 +50,9 @@ posRms bounds parenti@(pr,i) numChild (t@(Node (cr,i') _):ts) tseq = do
             case mayrs of
                 --Nothing -> putStr ("Backtracking to room " ++ show i' ++ ": ") >> tryLinks (j+1) ls
                 Nothing -> do
-                    putStr $ "Backtracking to " ++ (rpns 20 (_rmName cr ++ "-" ++ show i')) 
+                    putStr $ "Backtracking to " ++ rpns 20 (_rmName cr ++ "-" ++ show i')
-                        ++ (rpns 9 (" child " ++ show numChild ))
+                        ++ rpns 9 (" child " ++ show numChild )
-                        ++ (rpns 25 (" of " ++ _rmName pr ++ "-" ++ show i ))
+                        ++ rpns 25 (" of " ++ _rmName pr ++ "-" ++ show i )
                     tryLinks (j+1) ls
                 Just rs -> return (Just rs)
       where