Tweak ledge room, rename roomRectAutoLinks

src/Dodge/Floor.hs

@@ -55,7 +55,7 @@ initialRoomTree =
             , intAnno $ warningRooms "INVISIBLE CREATURE AHEAD"
             , rToOnward "chaseCrit+armourChaseCrit rectRoom" .
                     return . cleatOnward =<<
-                        (roomRectAutoLinks 400 400 <&> rmPmnts
+                        (roomRectAutoLights 400 400 <&> rmPmnts
                             .++~ [ psPtPl anyUnusedSpot (PutCrit invisibleChaseCrit)
                                  , psPtPl anyUnusedSpot (PutCrit armourChaseCrit)
                                  ])

src/Dodge/Room/BlinkAcross.hs

@@ -14,8 +14,8 @@ import System.Random
 
 blinkAcrossChallenge :: RandomGen g => State g (MetaTree Room String)
 blinkAcrossChallenge = do
-    teleFromRoom <- shuffleLinks =<< roomRectAutoLinks 200 200
-    teleToRoom <- shuffleLinks =<< roomRectAutoLinks 200 200
+    teleFromRoom <- shuffleLinks =<< roomRectAutoLights 200 200
+    teleToRoom <- shuffleLinks =<< roomRectAutoLights 200 200
     emptylink <- shuffleLinks emptyCorridor
     rToOnward "blinkAcrossChallenge" $
         treePost [teleFromRoom, emptylink, cleatOnward teleToRoom]

src/Dodge/Room/Branch.hs

@@ -18,7 +18,7 @@ branchRectWith t = do
     x <- state $ randomR (100, 200)
     y <- state $ randomR (100, 200)
     b <- t
-    rt <- shuffleLinks =<< roomRectAutoLinks x y
+    rt <- shuffleLinks =<< roomRectAutoLights x y
     return $
         Node
             rt

src/Dodge/Room/Containing.hs

@@ -55,7 +55,7 @@ pedestalRoom it = do
     r <-
         takeOne
             [ shuffleLinks =<< (centerVaultRoom x x 50 <&> rmPmnts .:~ sps0 flit)
-            , shuffleLinks =<< (roomRectAutoLinks (2 * x) (2 * x) <&> rmPmnts .:~ sPS (V2 x x) 0 flit)
+            , shuffleLinks =<< (roomRectAutoLights (2 * x) (2 * x) <&> rmPmnts .:~ sPS (V2 x x) 0 flit)
             , shuffleLinks =<< (roomNgon ngon x <&> rmPmnts .:~ sps0 flit)
             ]
     r <&> rmName .++~ "ped-"

src/Dodge/Room/LongDoor.hs

@@ -83,7 +83,7 @@ twinSlowDoorChasers = do
     return $ twinSlowDoorRoom 80 200 40 & rmPmnts %~ (plmnts ++)
 
 southPillarsRoom :: RandomGen g => Float -> Float -> Float -> State g Room
-southPillarsRoom x y h = addSouthPillars x h =<< roomRectAutoLinks x y
+southPillarsRoom x y h = addSouthPillars x h =<< roomRectAutoLights x y
 
 addSouthPillars :: RandomGen g => Float -> Float -> Room -> State g Room
 addSouthPillars x h r = do

src/Dodge/Room/Pillar.hs

@@ -48,7 +48,7 @@ smallPillar = PutBlock defaultBlock baseBlockPane $ reverse $ square 5
 
 roomPillarsSquare :: RandomGen g => State g Room
 roomPillarsSquare = do
-    rm' <- roomRectAutoLinks 300 300
+    rm' <- roomRectAutoLights 300 300
     let nlew = _numLinkEW (_rmType rm')
         nlns = _numLinkNS (_rmType rm')
     thelight <- mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnk rp

src/Dodge/Room/Procedural.hs

@@ -1,7 +1,7 @@
 -- | Procedural creation of rooms and subroom parts.
 module Dodge.Room.Procedural (
     roomRect,
-    roomRectAutoLinks,
+    roomRectAutoLights,
     randomFourCornerRoom,
     randomFourCornerRoomCrsIts,
     centerVaultRoom,
@@ -116,8 +116,8 @@ gridRoomPos xs ys = map makeonpos (grid xs ys) <> map makeoffpos (grid (mids xs)
 {- Creates a rectangular room, automatically creates links and pathfinding graph at a sensible size.  -}
 -- it is not clear to me that this works for very small rooms (but it does seem
 -- to do so)
-roomRectAutoLinks :: RandomGen g => Float -> Float -> State g Room
-roomRectAutoLinks x y = do
+roomRectAutoLights :: RandomGen g => Float -> Float -> State g Room
+roomRectAutoLights x y = do
     l1 <- mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isInLnk rp   
     l2 <- mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnk rp
     return $ roomRect x y (f x) (f y)

src/Dodge/Room/RezBox.hs

@@ -95,7 +95,7 @@ rezBoxesWpCrit = do
     theweapon <- randBlockBreakWeapon
     let bottomEdgeTest (V2 _ y, _) = y < 1
         aroom = rezInvBox thecol
-    centralRoom <- roomRectAutoLinks w h <&> rmPmnts .~ []
+    centralRoom <- roomRectAutoLights w h <&> rmPmnts .~ []
     onwardpassage <-
         over root (rmConnectsTo .~ S.member (OnEdge West)) <$> maybeBlockedPassage
     let n = length $ filter bottomEdgeTest $ map (\rl -> (rl ^. rlPos, rl ^. rlDir)) 
@@ -127,7 +127,7 @@ rezBoxes = do
                 [door & rmConnectsTo .~ S.member (OnEdge South)]
                 (rezInvBox thecol)
     centralRoom <-
-        shuffleLinks =<< (roomRectAutoLinks w h <&> rmPmnts .~ []
+        shuffleLinks =<< (roomRectAutoLights w h <&> rmPmnts .~ []
                 <&> rmLinks %~ setInLinks bottomEdgeTest)
     let n = length $ filter bottomEdgeTest $ _rmLinks centralRoom
     return

src/Dodge/Room/Room.hs

@@ -52,7 +52,7 @@ roomC w h = do
     maybeaddgird <- takeOne [return, addRandomGirderFrom West 0, addRandomGirderFrom North 0]
     maybeaddgird
         =<< shuffleLinks
-        =<< ( roomRectAutoLinks w h
+        =<< ( roomRectAutoLights w h
                 <&> rmLinks
                     %~ ( setInLinks (\rl -> S.fromList [FromEdge East 0, OnEdge South] `S.isSubsetOf` _rlType rl)
                             . setOutLinks (\rl -> OnEdge West `S.member` _rlType rl)
@@ -320,7 +320,7 @@ shootersRoom' = do
                    , spanLightI (V2 (w / 2) 200) (V2 (w + 10) 200)
                    ]
         toPS x y = return (V2 x y, -0.5 * pi)
-    roomRectAutoLinks w 600
+    roomRectAutoLights w 600
         <&> rmPmnts .~ plmnts
         <&> rmRandPSs .~ [toPS x1 y1, toPS x2 y2, toPS x3 y3]
 
@@ -423,7 +423,7 @@ distributerRoom atype aamount = do
     i1 <- nextLayoutInt
     w <- state $ randomR (100, 400)
     h <- state $ randomR (200, 400)
-    r <- roomRectAutoLinks w h
+    r <- roomRectAutoLights w h
     let mcstore = defaultMachine
             & mcMaterial .~ Metal
             & mcType .~ McStorage atype aamount

src/Dodge/Room/RunPast.hs

@@ -36,7 +36,7 @@ lockedStart i = do
     h <- state $ randomR (200, 400 :: Float)
     thels <- roomCritLS
     theweapon <- randBlockBreakWeapon
-    cenroom <- shuffleLinks =<< (roomRectAutoLinks 40 h <&> rmPmnts .~ [])
+    cenroom <- shuffleLinks =<< (roomRectAutoLights 40 h <&> rmPmnts .~ [])
     theedge <- takeOne $ map OnEdge [West, East]
     let linkcor = smallRoom & rmPmnts .~ [spanLS thels (V2 0 65) (V2 40 65)]
         n = length $ filter (elem theedge . _rlType) (_rmLinks cenroom)

src/Dodge/Room/SensorDoor.hs

@@ -25,7 +25,7 @@ import Control.Monad
 -- for roomRectAutoLinks-- make the locked door a center door?
 sensorRoom :: RandomGen g => SensorType -> Int -> State g (Tree Room)
 sensorRoom senseType n = do
-    rm <- join $ takeOne [roomNgon 8 200, roomRectAutoLinks 200 200]
+    rm <- join $ takeOne [roomNgon 8 200, roomRectAutoLights 200 200]
     cenroom <- shuffleLinks $ sensInsideDoor senseType n rm
     return $ treePost
             [ door

src/Dodge/Room/Tanks.hs

@@ -72,7 +72,7 @@ tanksPipesRoom = do
     h <- state $ randomR (200, 300)
     i <- state $ randomR (2, 5)
     tanks <- randEdgeTanks i
-    roomRectAutoLinks w h <&> rmPmnts .++~ tanks
+    roomRectAutoLights w h <&> rmPmnts .++~ tanks
 
 tanksRoom :: RandomGen g => [Creature] -> [Item] -> State g Room
 tanksRoom crs its = do
@@ -81,7 +81,7 @@ tanksRoom crs its = do
     ntanks <- state $ randomR (3, 6)
     thetank <- randomTank <&> plSpot .~ unusedOffPathAwayFromLink 50
     thelight <- mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnk rp
-    room <- roomRectAutoLinks w h
+    room <- roomRectAutoLights w h
     let plmnts =
             map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) its
                 ++ map (\cr -> sps0 (PutCrit cr) & plSpot .~ unusedSpotAwayFromLink 50) crs

src/Dodge/Room/Tutorial.hs

@@ -101,7 +101,7 @@ tutDrop = do
     i <- nextLayoutInt
     --let y = decontamRoom i
     (j, y) <- setRoomInt (decontamRoom i)
-    rm <- roomRectAutoLinks 40 100
+    rm <- roomRectAutoLights 40 100
     return $
         tToBTree "TutDrop" $
             treePost
@@ -134,7 +134,7 @@ cChasm :: State LayoutVars Room
 cChasm = do
     x <- state $ randomR (150, 300)
     y <- state $ randomR (150, 300)
-    roomRectAutoLinks x y
+    roomRectAutoLights x y
         <&> rmLinks %~ setOutLinks (isCornerLink NorthWest)
         <&> rmLinks %~ setInLinks (isCornerLink SouthWest)
         <&> rmPmnts <>~ [sps0 $ putConvexChasm (rectNSWE (y -50) 50 0 (x -50))]
@@ -143,7 +143,7 @@ lChasm :: State LayoutVars Room
 lChasm = do
     x <- state $ randomR (150, 300)
     y <- state $ randomR (150, 300)
-    roomRectAutoLinks x y
+    roomRectAutoLights x y
         <&> rmLinks %~ setOutLinks (isCornerLink NorthWest)
         <&> rmLinks %~ setInLinks (isCornerLink SouthEast)
         <&> rmPmnts <>~ [sps0 $ putConvexChasm (rectNSWE (y -50) 0 0 (x -50))]
@@ -153,7 +153,7 @@ zChasm :: Float -> State LayoutVars Room
 zChasm z = do
     x <- state $ randomR (150, 300)
     y <- state $ randomR (150, 300)
-    roomRectAutoLinks x y
+    roomRectAutoLights x y
         <&> rmLinks %~ setOutLinks (isCornerLink NorthWest)
         <&> rmLinks %~ setInLinks (isCornerLink SouthEast)
         <&> rmPath %~ addNodesCrossing (V2 0 (y/2),V2 x (y/2))
@@ -166,7 +166,7 @@ midChasm :: State LayoutVars Room
 midChasm = do
     x <- state $ randomR (200, 300)
     y <- state $ randomR (200, 300)
-    r <- roomRectAutoLinks x y
+    r <- roomRectAutoLights x y
     cs <- join $ takeOne [cenoct x y, censquare x y]
     shuffleLinks $
         r
@@ -185,7 +185,7 @@ midChasmPlatform :: State LayoutVars Room
 midChasmPlatform = do
     x <- state $ randomR (250, 300)
     y <- state $ randomR (250, 300)
-    r <- roomRectAutoLinks x y
+    r <- roomRectAutoLights x y
     cs <- join $ takeOne [censquare x y]
     shuffleLinks $
         r
@@ -239,17 +239,17 @@ midChasmSpit :: State LayoutVars Room
 midChasmSpit = do
     let x = 300
         y = 300
-    r <- roomRectAutoLinks x y
+    r <- roomRectAutoLights x y
     cs <- join $ takeOne [censquare x y]
     shuffleLinks $
         r
             & rmLinks %~ setOutLinks 
-                (\rl -> isMidEdgeLink r South rl 
-                    || isMidEdgeLink r West rl 
+                (\rl -> isMidEdgeLink r North rl 
                     || isMidEdgeLink r East rl 
+                    || isMidEdgeLink r West rl 
                 )
             & rmLinks %~ setInLinks (isMidEdgeLink r South)
-            & rmPmnts <>~ cs
+            & rmPmnts .~ cs
   where
     censquare x y = do
         z <- state $ randomR (40, 60)
@@ -396,8 +396,8 @@ tutHub = do
         , makeTermLine "---------------------------------------------"
         , makeTermLine ""
         ]
-    r x = roomRectAutoLinks 100 100 <&> rmPmnts .:~ sps (PS 50 0) (PutFlIt x)
-    ammoroom x = roomRectAutoLinks 100 100 <&> rmPmnts .:~ sps (PS 50 0) (PutFlIt x)
+    r x = roomRectAutoLights 100 100 <&> rmPmnts .:~ sps (PS 50 0) (PutFlIt x)
+    ammoroom x = roomRectAutoLights 100 100 <&> rmPmnts .:~ sps (PS 50 0) (PutFlIt x)
     itemshiftterminal =
         putMessageTerminal
             (defaultTerminal & tmBootLines .~ ss' <> tlSetStatus (TerminalPressTo "QUIT") <> tlDoEffect TmWdWdPowerDownTerminal)

src/Dodge/Room/Warning.hs

@@ -33,7 +33,7 @@ import RandomHelp
 warningRooms :: String -> Int -> State StdGen (MetaTree Room String)
 warningRooms str n = do
     rm <- do
-        join $ takeOne [roomNgon 8 200, roomRectAutoLinks 200 200, tanksRoom [] []]
+        join $ takeOne [roomNgon 8 200, roomRectAutoLights 200 200, tanksRoom [] []]
     cenroom <- shuffleLinks $ addWarningTerminal str n rm
     rToOnward "warningRooms" $ treePost [door, cenroom, triggerDoorRoom n, cleatOnward door]
 

src/Dodge/RoomLink.hs

@@ -56,7 +56,9 @@ setInLinks = setLinkType InLink
 isMidEdgeLink :: Room -> CardinalPoint -> RoomLink -> Bool
 isMidEdgeLink r x rl
     | x == North || x == South = g West (f $ r ^?! rmType . numLinkEW)
+        && OnEdge x `S.member` (rl ^. rlType)
     | otherwise = g South (f $ r ^?! rmType . numLinkNS)
+        && OnEdge x `S.member` (rl ^. rlType)
   where
     f y | even y = [y `div` 2]
         | otherwise = [y `div` 2, 1 + (y `div` 2)]