diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 42326b4ea..10723e1bd 100644 --- a/src/Dodge/Floor.hs +++ b/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) ]) diff --git a/src/Dodge/Room/BlinkAcross.hs b/src/Dodge/Room/BlinkAcross.hs index 631f87f66..87b74213c 100644 --- a/src/Dodge/Room/BlinkAcross.hs +++ b/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] diff --git a/src/Dodge/Room/Branch.hs b/src/Dodge/Room/Branch.hs index 2d56aade5..dc86bc564 100644 --- a/src/Dodge/Room/Branch.hs +++ b/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 diff --git a/src/Dodge/Room/Containing.hs b/src/Dodge/Room/Containing.hs index 0692ebb7d..a28a0a4ad 100644 --- a/src/Dodge/Room/Containing.hs +++ b/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-" diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index 9ed559cb3..25d077d48 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/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 diff --git a/src/Dodge/Room/Pillar.hs b/src/Dodge/Room/Pillar.hs index 3fd21c450..44d632c19 100644 --- a/src/Dodge/Room/Pillar.hs +++ b/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 diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index faafb6a5f..3ba80b46f 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/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) diff --git a/src/Dodge/Room/RezBox.hs b/src/Dodge/Room/RezBox.hs index e6c26115b..fa37f657a 100644 --- a/src/Dodge/Room/RezBox.hs +++ b/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 diff --git a/src/Dodge/Room/Room.hs b/src/Dodge/Room/Room.hs index d8d0de97d..40a533d79 100644 --- a/src/Dodge/Room/Room.hs +++ b/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 diff --git a/src/Dodge/Room/RunPast.hs b/src/Dodge/Room/RunPast.hs index 690d26877..d2fa33851 100644 --- a/src/Dodge/Room/RunPast.hs +++ b/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) diff --git a/src/Dodge/Room/SensorDoor.hs b/src/Dodge/Room/SensorDoor.hs index a26f68b22..16af31fb4 100644 --- a/src/Dodge/Room/SensorDoor.hs +++ b/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 diff --git a/src/Dodge/Room/Tanks.hs b/src/Dodge/Room/Tanks.hs index 8efc1c3ad..1fe9b74f9 100644 --- a/src/Dodge/Room/Tanks.hs +++ b/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 diff --git a/src/Dodge/Room/Tutorial.hs b/src/Dodge/Room/Tutorial.hs index 2e4eb815c..25b229e7c 100644 --- a/src/Dodge/Room/Tutorial.hs +++ b/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) diff --git a/src/Dodge/Room/Warning.hs b/src/Dodge/Room/Warning.hs index 426d282d0..364a2a53c 100644 --- a/src/Dodge/Room/Warning.hs +++ b/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] diff --git a/src/Dodge/RoomLink.hs b/src/Dodge/RoomLink.hs index b5f33557c..4a442a6aa 100644 --- a/src/Dodge/RoomLink.hs +++ b/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)]