Make Placement into a product type

2025-09-02 12:31:55 +01:00
parent dc13c61dca
commit f278af0f30
29 changed files with 168 additions and 168 deletions
@@ -1,4 +1,4 @@
-Seed: 7114951007332849727
+Seed: 897386367644826610
 Room layout (compact): 
 0,1,2,3,4,5,6
 |
@@ -1,4 +1,4 @@
-Generating level with seed 7114951007332849727
+Generating level with seed 897386367644826610

-After 1 attempt(s), Successful generation of level with seed 7114951007332849727
+After 1 attempt(s), Successful generation of level with seed 897386367644826610
 15 rooms in total
@@ -1,4 +1,4 @@
-Seed: 7114951007332849727
+Seed: 897386367644826610
 0:teststart
 |
 1:TutDrop
@@ -1 +1 @@
-7114951007332849727
+897386367644826610
@@ -85,7 +85,7 @@ data Placement
        , _plMID :: Maybe Int
        , _plIDCont :: World -> Placement -> Maybe Placement
        }
-    | RandomPlacement {_unRandomPlacement :: State StdGen Placement}
+--    | RandomPlacement {_unRandomPlacement :: State StdGen Placement}

 {- The '_rmPolys' lists which polygons should be cut out to form the indestructible walls of the room.
 Link pairs contain a position and rotation to attach to another room;
@@ -66,12 +66,12 @@ initialAnoTree =
              PassthroughLockKeyLists keyCardRunPastRand itemRooms
            , AnTree . intAnno $ warningRooms "INVISIBLE CREATURE AHEAD"
            , AnTree $
-                rToOnward "chaseCrit+armourChaseCrit rectRoom" $
-                    return . cleatOnward $
-                        roomRectAutoLinks 400 400 & rmPmnts
+                rToOnward "chaseCrit+armourChaseCrit rectRoom" =<<
+                    return . cleatOnward <$>
+                        (roomRectAutoLinks 400 400 <&> rmPmnts
                            .++~ [ psPtPl anyUnusedSpot (PutCrit invisibleChaseCrit)
                                 , psPtPl anyUnusedSpot (PutCrit armourChaseCrit)
-                                 ]
+                                 ])
            , AnTree . intAnno $ fmap (tToBTree "healthTest") . healthTest
            , AnTree . zoom lyGen $ 
                (tanksRoom [] [] >>= rToOnward "empty tanksRoom" . pure . cleatOnward)
@@ -86,7 +86,7 @@ ps0PushPSw pst f = Placement 10 (PSNoShiftCont (V2 0 0) 0) pst Nothing $

 addPlmnt :: Placement -> Placement -> Placement
 addPlmnt pl pl2 = case pl2 of
-    (RandomPlacement rp) -> RandomPlacement $ fmap (addPlmnt pl) rp
+--    (RandomPlacement rp) -> RandomPlacement $ fmap (addPlmnt pl) rp
    (Placement i ps pt mi f) -> Placement i ps pt mi (fmap (fmap g) f)
  where
    g Nothing = Just pl
@@ -155,13 +155,13 @@ mntLSCond shp ps =

 -- note that this perhaps pushes the vshape light out too far

-mntLight :: Point2 -> Point2 -> Placement
-mntLight a b = RandomPlacement $ do
+mntLight :: RandomGen g => Point2 -> Point2 -> State g Placement
+mntLight a b = do
    shp <- takeOne [vShape, iShape, lShape, jShape, liShape]
    return $ mntLS shp a (addZ 90 b)

-mntLightLnkCond :: PlacementSpot -> Placement
-mntLightLnkCond ps = RandomPlacement $ do
+mntLightLnkCond :: RandomGen g => PlacementSpot -> State g Placement
+mntLightLnkCond ps = do
    shp <- takeOne [vShape, lShape, jShape, liShape]
    return $ mntLSCond (fmap (fmap $ colorSH black) shp) ps

@@ -33,19 +33,9 @@ placeSpot (w, rm) plmnt = case plmnt of
    Placement{_plSpot = PSPos extract eff fallback} ->
        placeSpotUsingLink w rm plmnt extract eff fallback
    Placement{} -> placePlainPSSpot w rm plmnt shift
-    RandomPlacement rplmnt -> placeRandomPlacement rplmnt w rm
  where
    shift = _rmShift rm

-placeRandomPlacement ::
-    State StdGen Placement ->
-    GenWorld ->
-    Room ->
-    ((GenWorld, Room), [Placement])
-placeRandomPlacement rplmnt w rm = placeSpot (w & gwWorld . randGen .~ g, rm) plmnt'
-  where
-    (plmnt', g) = runState rplmnt (_randGen (_gwWorld w))
-
 placePlainPSSpot ::
    GenWorld ->
    Room ->
@@ -25,4 +25,4 @@ shiftPlacement shift plmnt = case plmnt of
    Placement{} ->
        plmnt & plSpot %~ shiftPSBy shift
            & plIDCont %~ fmap (fmap (fmap $ shiftPlacement shift))
-    RandomPlacement rpl -> RandomPlacement $ fmap (shiftPlacement shift) rpl
+--    RandomPlacement rpl -> RandomPlacement $ fmap (shiftPlacement shift) rpl
@@ -3,7 +3,8 @@
 {- Rooms that contain two doors and a switch alternating both.  -}
 module Dodge.Room.Airlock where

-import Dodge.Placement.Instance.Analyser
+import Control.Lens
+import Control.Monad
 import Dodge.Annotation.Data
 import Dodge.Data.GenWorld
 import Dodge.Default.Door
@@ -11,34 +12,37 @@ import Dodge.Default.Room
 import Dodge.LevelGen.PlacementHelper
 import Dodge.LevelGen.Switch
 import Dodge.Placement.Instance
+import Dodge.Placement.Instance.Analyser
 import Dodge.Room.Foreground
 import Dodge.RoomLink
 import Geometry
 import Picture
 import RandomHelp
-import Control.Lens

 -- | A passage with a switch that opens forward access while closing backwards access.
 airlock :: RandomGen g => State g Room
-airlock = takeOne [airlock0, airlock90, airlockCrystal, airlockZ]
+airlock =
+    join $
+        takeOne [return airlock0, return airlock90, return airlockCrystal, airlockZ]

 --airlock = takeOne [airlockCrystal]
 decontamRoom :: State LayoutVars Room
 decontamRoom = do
-    return $ defaultRoom
-        & rmPolys .~ [rectNSWE 100 0 0 40, switchcut]
-        & rmLinks .~ muout lnks ++ muin [last lnks]
-        & rmPath .~ foldMap doublePairSet [(V2 20 95, V2 20 45), (V2 20 45, V2 20 5)]
-        & rmPmnts .~
-            [ pContID (PS (V2 (-35) 50) (negate $ pi / 2)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
-                \btid -> Just $
-                    putDoubleDoorThen DoorObstacle thewall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $
-                        \_ _ -> Just $ putDoubleDoor DoorObstacle thewall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
-            , invisibleWall $ rectNSWE 60 40 (-40) (-30)
-            , spanLightI (V2 (-2) 30) (V2 (-2) 70)
-            , analyser (RequireHealth 100) (PS 50 0) (PS (V2 70 50) 0)
-            ]
-        & rmBound .~ [rectNSWE 75 15 0 40, switchcut]
+    return $
+        defaultRoom
+            & rmPolys .~ [rectNSWE 100 0 0 40, switchcut]
+            & rmLinks .~ muout lnks ++ muin [last lnks]
+            & rmPath .~ foldMap doublePairSet [(V2 20 95, V2 20 45), (V2 20 45, V2 20 5)]
+            & rmPmnts
+                .~ [ pContID (PS (V2 (-35) 50) (negate $ pi / 2)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
+                        \btid -> Just $
+                            putDoubleDoorThen DoorObstacle thewall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $
+                                \_ _ -> Just $ putDoubleDoor DoorObstacle thewall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
+                   , invisibleWall $ rectNSWE 60 40 (-40) (-30)
+                   , spanLightI (V2 (-2) 30) (V2 (-2) 70)
+                   , analyser (RequireHealth 100) (PS 50 0) (PS (V2 70 50) 0)
+                   ]
+            & rmBound .~ [rectNSWE 75 15 0 40, switchcut]
  where
    thewall = switchWallCol col
    switchcut = rectNSWE 65 35 (-40) 80
@@ -115,36 +119,37 @@ airlockSimple =
    outDoorps = (V2 0 0,) <$> arcStepwise 3 (negate $ pi / 2) (V2 0 0) (V2 0 55)
    inDoorps = (V2 0 0,) <$> arcStepwise 3 (negate $ pi / 2) (V2 0 0) (V2 (-55) 0)

-airlockZ :: Room
-airlockZ =
-    defaultRoom
-        { _rmPolys =
-            [rectNSWE 120 0 0 180]
-        , _rmLinks = muout [(V2 0 30, pi / 2)] ++ muin [(V2 180 30, 1.5 * pi)]
-        , _rmPath = mempty
-        , --         [(V2 0 40,V2 40 0)
-          --         ,(V2 40 0,V2 0 40)
-          --         ]
-          _rmPmnts =
-            [ pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
-                \btid -> airlockDoubleDoor (V2 0 60) (V2 180 60) col (WdBlBtOn btid) outDoorps inDoorps
-            , --            jspsJ (V2 0 60) 0 (airlockDoor col (cond btid) outDoorps)
-              --            $ sPS (V2 180 60) 0 (airlockDoor col (cond btid) inDoorps)
-              sps0 $ PutWall (reverse $ rectNSWE 70 50 60 120) defaultWall
-            , lighting
-            ]
-        , _rmBound =
-            [rectNSWE 120 0 0 180]
-        }
+airlockZ :: RandomGen g => State g Room
+airlockZ = do
+    let cenlight = mntLS vShape (V2 90 60) (V3 90 40 50) `addPlmnt` mntLS vShape (V2 90 60) (V3 90 80 50)
+        cornlight =
+            mntLS vShape (V2 0 120) (V3 30 90 50) `addPlmnt` mntLS vShape (V2 180 120) (V3 150 90 50)
+                `addPlmnt` sps0 (putShape (thinHighBar 50 (V2 30 90) (V2 150 90)))
+    lighting <- takeOne [cenlight, cornlight]
+    return
+        defaultRoom
+            { _rmPolys =
+                [rectNSWE 120 0 0 180]
+            , _rmLinks = muout [(V2 0 30, pi / 2)] ++ muin [(V2 180 30, 1.5 * pi)]
+            , _rmPath = mempty
+            , --         [(V2 0 40,V2 40 0)
+              --         ,(V2 40 0,V2 0 40)
+              --         ]
+              _rmPmnts =
+                [ pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
+                    \btid -> airlockDoubleDoor (V2 0 60) (V2 180 60) col (WdBlBtOn btid) outDoorps inDoorps
+                , --            jspsJ (V2 0 60) 0 (airlockDoor col (cond btid) outDoorps)
+                  --            $ sPS (V2 180 60) 0 (airlockDoor col (cond btid) inDoorps)
+                  sps0 $ PutWall (reverse $ rectNSWE 70 50 60 120) defaultWall
+                , lighting
+                ]
+            , _rmBound =
+                [rectNSWE 120 0 0 180]
+            }
  where
    col = dim $ dim $ bright red
    outDoorps = (V2 0 0,) <$> arcStepwise 3 (pi / 2) (V2 0 0) (V2 0 (-61))
    inDoorps = (V2 0 0,) <$> arcStepwise 3 (pi / 2) (V2 0 0) (V2 (-61) 0)
-    cenlight = mntLS vShape (V2 90 60) (V3 90 40 50) `addPlmnt` mntLS vShape (V2 90 60) (V3 90 80 50)
-    cornlight =
-        mntLS vShape (V2 0 120) (V3 30 90 50) `addPlmnt` mntLS vShape (V2 180 120) (V3 150 90 50)
-            `addPlmnt` sps0 (putShape (thinHighBar 50 (V2 30 90) (V2 150 90)))
-    lighting = RandomPlacement $ takeOne [cenlight, cornlight]

 airlock90 :: Room
 airlock90 =
@@ -13,8 +13,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 =<< roomRectAutoLinks 200 200
+    teleToRoom <- shuffleLinks =<< roomRectAutoLinks 200 200
    emptylink <- shuffleLinks emptyCorridor
    rToOnward "blinkAcrossChallenge" $
        treePost [teleFromRoom, emptylink, cleatOnward teleToRoom]
@@ -17,7 +17,7 @@ branchRectWith t = do
    x <- state $ randomR (100, 200)
    y <- state $ randomR (100, 200)
    b <- t
-    rt <- shuffleLinks $ roomRectAutoLinks x y
+    rt <- shuffleLinks =<< roomRectAutoLinks x y
    return $
        Node
            rt
@@ -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 $ roomNgon ngon x & rmPmnts .:~ sps0 flit
+            , shuffleLinks =<< (roomRectAutoLinks (2 * x) (2 * x) <&> rmPmnts .:~ sPS (V2 x x) 0 flit)
+            , shuffleLinks =<< (roomNgon ngon x <&> rmPmnts .:~ sps0 flit)
            ]
    r <&> rmName .++~ "ped-"
@@ -22,6 +22,33 @@ import Control.Monad

 glassLesson :: RandomGen g => State g (Tree Room)
 glassLesson = do
+    l1 <- takeOne
+                    [ spanLightI (V2 160 (-20)) (V2 160 220)
+                    , mntLS vShape (V2 180 200) (V3 160 180 50)
+                    ]
+    l2 <- takeOne
+                    [ spanLightI (V2 160 (-20)) (V2 160 220)
+                    , mntLS vShape (V2 180 200) (V3 160 180 50)
+                    ]
+    let botplmnts =
+            [ sPS (V2 0 0) 0 $ PutWall (rectNSWE 200 0 90 110) defaultCrystalWall
+            , sPS (V2 50 100) 0 $ PutCrit miniGunCrit
+            , l1
+            ]
+        topplmnts =
+            [ windowLine (V2 100 200) (V2 100 0)
+            , sPS (V2 50 100) 0 $ PutCrit miniGunCrit
+            , l2
+            ]
+        botRoom =
+            roomRect 200 200 1 1
+                & rmPmnts .~ botplmnts
+                & rmLinks %~ setInLinksByType (OnEdge West)
+        topRoom =
+            roomRect 200 200 1 1
+                & rmPmnts .~ topplmnts
+                & rmLinks %~ setInLinks (fromWest South 0 . _rlType)
+        uppers = Node (door & rmConnectsTo .~ fromWest North 0) [pure topRoom]
    i <- takeOne [1, 2, 3]
    corridors <- replicateM i $ shuffleLinks corridor
    return $
@@ -37,33 +64,6 @@ glassLesson = do
            ]
  where
    fromWest edge i s = OnEdge edge `S.member` s && FromEdge West i `S.member` s
-    uppers = Node (door & rmConnectsTo .~ fromWest North 0) [pure topRoom]
-    botRoom =
-        roomRect 200 200 1 1
-            & rmPmnts .~ botplmnts
-            & rmLinks %~ setInLinksByType (OnEdge West)
-    topRoom =
-        roomRect 200 200 1 1
-            & rmPmnts .~ topplmnts
-            & rmLinks %~ setInLinks (fromWest South 0 . _rlType)
-    botplmnts =
-        [ sPS (V2 0 0) 0 $ PutWall (rectNSWE 200 0 90 110) defaultCrystalWall
-        , sPS (V2 50 100) 0 $ PutCrit miniGunCrit
-        , RandomPlacement $
-            takeOne
-                [ spanLightI (V2 160 (-20)) (V2 160 220)
-                , mntLS vShape (V2 180 200) (V3 160 180 50)
-                ]
-        ]
-    topplmnts =
-        [ windowLine (V2 100 200) (V2 100 0)
-        , sPS (V2 50 100) 0 $ PutCrit miniGunCrit
-        , RandomPlacement $
-            takeOne
-                [ spanLightI (V2 160 (-20)) (V2 160 220)
-                , mntLS vShape (V2 180 200) (V3 160 180 50)
-                ]
-        ]

 glassLessonRunPast :: RandomGen g => State g MTRS
 glassLessonRunPast = glassLesson >>= rToOnward "glassLessonRunPast" . f
@@ -21,15 +21,16 @@ import Geometry
 import LensHelp
 import RandomHelp

-cenLasTur :: Room
-cenLasTur =
-    roomNgon 8 200 & rmPmnts
+cenLasTur :: RandomGen g => State g Room
+cenLasTur = do
+    thelight <- mntLightLnkCond $ rprBool $ const . isInLnk
+    roomNgon 8 200 <&> rmPmnts
        .~ [ putLasTurret 0.02
           , heightWallPS
                (resetPLUse $ rprBoolShift (const . isInLnk) (shiftInBy 100))
                30
                covershape
-           , mntLightLnkCond $ rprBool $ const . isInLnk
+           , thelight
           ]
  where
    covershape = rectNSWE 10 (-10) (-20) 20
@@ -59,7 +60,7 @@ lightSensByDoor i rm =

 keyCardRoomRunPast :: RandomGen g => Int -> Int -> State g (MetaTree Room String)
 keyCardRoomRunPast keyid rmid = do
-    cenroom <- shuffleLinks $ keyCardAnalyserByDoor keyid rmid $ roomNgon 6 200
+    cenroom <- shuffleLinks =<< keyCardAnalyserByDoor keyid rmid <$> roomNgon 6 200
    let doorroom = triggerDoorRoom rmid
    rToOnward "keyCardRoomRunPast" $
        treeFromTrunk [door] $
@@ -94,7 +95,7 @@ analyserByDoor = analyserByNthLink 0

 healthTest :: RandomGen g => Int -> State g (Tree Room)
 healthTest n = do
-    cenroom <- shuffleLinks $ healthAnalyserByDoor n $ roomNgon 8 200
+    cenroom <- shuffleLinks =<< healthAnalyserByDoor n <$> roomNgon 8 200
    return $
        treePost
            [ door
@@ -106,14 +107,14 @@ healthTest n = do

 lasSensorTurretTest :: RandomGen g => Int -> State g (MetaTree Room String)
 lasSensorTurretTest n = do
-    cenroom <- shuffleLinks $ lightSensInsideDoor n cenLasTur
+    cenroom <- shuffleLinks =<< lightSensInsideDoor n <$> cenLasTur
    rToOnward "lasSensorTurretTest" $
        treePost
            [door, cenroom, triggerDoorRoom n, cleatOnward door]

 lasCenSensEdge :: RandomGen g => Int -> State g (MetaTree Room String)
 lasCenSensEdge n = do
-    cenroom <- shuffleLinks $ lightSensByDoor n cenLasTur
+    cenroom <- shuffleLinks =<< lightSensByDoor n <$> cenLasTur
    let doorroom = triggerDoorRoom n
    rToOnward "lasCenSensEdge" $
        treeFromTrunk [door] $
@@ -84,7 +84,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 =<< (roomRectAutoLinks x y)

 addSouthPillars :: RandomGen g => Float -> Float -> Room -> State g Room
 addSouthPillars x h r = do
@@ -1,5 +1,6 @@
 module Dodge.Room.Ngon where

+import RandomHelp
 import Data.List
 import Data.Maybe
 import Data.Tile
@@ -11,13 +12,14 @@ import Dodge.RoomLink
 import Geometry
 import Tile

-roomNgon :: Int -> Float -> Room
-roomNgon n x =
-    defaultRoom
+roomNgon :: RandomGen g => Int -> Float -> State g Room
+roomNgon n x = do
+    thelight <-mntLightLnkCond $ resetPLUse $ rprBool $ const . isInLnk
+    return defaultRoom
        { _rmPolys = [poly]
        , _rmLinks = map toBothLnk lnks -- muout (init lnks) ++ muin[last lnks]
        , _rmPath = mempty -- TODO
-        , _rmPmnts = [mntLightLnkCond $ resetPLUse $ rprBool $ const . isInLnk]
+        , _rmPmnts = [thelight]
        , _rmBound = [poly]
        , _rmFloor = Tiled [makeTileFromPoly poly 2]
        , _rmName = show n ++ "gon"
@@ -48,9 +48,10 @@ smallPillar = PutBlock defaultBlock baseBlockPane $ reverse $ square 5

 roomPillarsSquare :: RandomGen g => State g Room
 roomPillarsSquare = do
-    let rm' = roomRectAutoLinks 300 300
-        nlew = _numLinkEW (_rmType rm')
+    rm' <- roomRectAutoLinks 300 300
+    let nlew = _numLinkEW (_rmType rm')
        nlns = _numLinkNS (_rmType rm')
+    thelight <- mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnk rp
    addlights <-
        takeOne
            [ return
@@ -76,7 +77,7 @@ roomPillarsSquare = do
                . ( rmPmnts
                        .++~ [ spanColLightBlackI 0.75 95 (V2 0 130) (V2 300 130)
                             , spanColLightBlackI 0.75 95 (V2 0 170) (V2 300 170)
-                             , mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnk rp
+                             , thelight
                             ]
                  )
            ]
@@ -135,14 +135,13 @@ lnkBothAnd rlt ltcon ltcon2 i (j, (p, a)) =
 {- 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 :: Float -> Float -> Room
-roomRectAutoLinks x y =
-    roomRect x y (f x) (f y)
+roomRectAutoLinks :: RandomGen g => Float -> Float -> State g Room
+roomRectAutoLinks 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)
        & rmName .~ "autoRect"
-        & rmPmnts
-            .~ [ mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isInLnk rp
-               , mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnk rp
-               ]
+        & rmPmnts .~ [ l1 , l2 ]
  where
    f z = max 1 $ (ceiling z - 40) `div` 60

@@ -95,7 +95,7 @@ rezBoxesWpCrit = do
    theweapon <- randBlockBreakWeapon
    let bottomEdgeTest (V2 _ y, _) = y < 1
        aroom = rezInvBox thecol
-    let centralRoom = (roomRectAutoLinks w h){_rmPmnts = []}
+    centralRoom <- roomRectAutoLinks w h <&> rmPmnts .~ []
    onwardpassage <-
        over root (rmConnectsTo .~ S.member (OnEdge West)) <$> maybeBlockedPassage
    let n = length $ filter bottomEdgeTest $ map lnkPosDir $ _rmLinks centralRoom
@@ -126,9 +126,8 @@ rezBoxes = do
                [door & rmConnectsTo .~ S.member (OnEdge South)]
                (rezInvBox thecol)
    centralRoom <-
-        shuffleLinks $
-            (roomRectAutoLinks w h){_rmPmnts = []}
-                & rmLinks %~ setInLinks bottomEdgeTest
+        shuffleLinks =<< (roomRectAutoLinks w h <&> rmPmnts .~ []
+                <&> rmLinks %~ setInLinks bottomEdgeTest)
    let n = length $ filter bottomEdgeTest $ _rmLinks centralRoom
    return
        . tToBTree "rezBoxes"
@@ -41,13 +41,13 @@ roomC w h = do
    maybeaddgird <- takeOne [return, addRandomGirderFrom West 0, addRandomGirderFrom North 0]
    maybeaddgird
        =<< shuffleLinks
-            ( roomRectAutoLinks w h
-                & rmLinks
+        =<< ( roomRectAutoLinks w h
+                <&> rmLinks
                    %~ ( setInLinks (\rl -> S.fromList [FromEdge East 0, OnEdge South] `S.isSubsetOf` _rlType rl)
                            . setOutLinks (\rl -> OnEdge West `S.member` _rlType rl)
                       )
-                & rmPmnts .:~ wallf (V2 (w / 2) 0) (V2 (w / 2) (h -60))
-                & rmRandPSs .~ [farside]
+                <&> rmPmnts .:~ wallf (V2 (w / 2) 0) (V2 (w / 2) (h -60))
+                <&> rmRandPSs .~ [farside]
            )
  where
    farside = do
@@ -118,6 +118,14 @@ roomMiniIntro = do

 roomCenterPillar :: RandomGen g => State g Room
 roomCenterPillar = do
+    l1 <- mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isInLnk rp)
+    l2 <- mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isOutLnk rp)
+    let plmnts =
+            [ blockLine (V2 115 115) (V2 115 125)
+            , blockLine (V2 125 115) (V2 125 125)
+            , l1
+            , l2
+            ]
    addHighGirder'
        =<< ( shuffleLinks . restrictInLinks ((\p -> dist p (V2 120 0) < 10) . fst) $
                cleatSide $
@@ -126,24 +134,18 @@ roomCenterPillar = do
                            roomRect 240 240 2 2
            )
  where
-    plmnts =
-        [ blockLine (V2 115 115) (V2 115 125)
-        , blockLine (V2 125 115) (V2 125 125)
-        , --        , mntLightLnkCond useUnusedLnk
-          mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isInLnk rp)
-        , mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isOutLnk rp)
-        ]

 weaponEmptyRoom :: State StdGen (Tree Room)
 weaponEmptyRoom = do
    w <- state $ randomR (220, 300)
    h <- state $ randomR (220, 300)
    wp <- randFirstWeapon
+    thelight <- mntLightLnkCond useUnusedLnk
    let plmnts =
            [ sPS (V2 (w / 2) (h -40)) 0 $ PutFlIt wp
            , sPS (V2 20 20) (pi / 2) randC1
            , sPS (V2 (w -20) 20) (pi / 2) randC1
-            , mntLightLnkCond useUnusedLnk
+            , thelight
            ]
        f (V2 x y, a) = (a == pi && x > 25 && x < w - 25) || (a /= 0 && y > w - 30)
    rm <-
@@ -153,7 +155,7 @@ weaponEmptyRoom = do

 weaponUnderCrits :: RandomGen g => State g (MetaTree Room String)
 weaponUnderCrits = do
-    let addwpat p = rmPmnts .:~(sPS p 0 $ RandPS $ fmap PutFlIt randFirstWeapon)
+    let addwpat p = rmPmnts .:~ (sPS p 0 $ RandPS $ fmap PutFlIt randFirstWeapon)
        continuationRoom =
            treePost
                [ addwpat (V2 20 0) corridorN
@@ -296,21 +298,19 @@ shootersRoom' = do
                   , spanLightI (V2 (w / 2) 200) (V2 (w + 10) 200)
                   ]
        toPS x y = return (V2 x y, -0.5 * pi)
-    return $
-        set rmPmnts plmnts $
-            roomRectAutoLinks w 600
-                & rmPmnts .~ plmnts
-                & rmRandPSs .~ [toPS x1 y1, toPS x2 y2, toPS x3 y3]
+    roomRectAutoLinks w 600
+                <&> rmPmnts .~ plmnts
+                <&> rmRandPSs .~ [toPS x1 y1, toPS x2 y2, toPS x3 y3]

 shootersRoom1 :: RandomGen g => State g Room
-shootersRoom1 =
-    shootersRoom' <&> rmPmnts
-        .:~ RandomPlacement
-            ( takeOne $
+shootersRoom1 = do
+    pl <- ( takeOne $
                map
                    (\i -> psPtPl (PSRoomRand i (uncurry PS)) (PutCrit autoCrit))
                    [0, 1, 2]
            )
+    shootersRoom' <&> rmPmnts
+        .:~ pl

 shootersRoom :: RandomGen g => State g Room
 shootersRoom =
@@ -37,7 +37,7 @@ lockedStart i = do
    h <- state $ randomR (200, 400 :: Float)
    thels <- roomCritLS
    theweapon <- randBlockBreakWeapon
-    cenroom <- shuffleLinks $ roomRectAutoLinks 40 h & rmPmnts .~ []
+    cenroom <- shuffleLinks =<< (roomRectAutoLinks 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)
@@ -19,12 +19,13 @@ import Dodge.Wire
 import Geometry
 import LensHelp
 import RandomHelp
+import Control.Monad

 -- TODO fix case where the sensor created by sensInsideDoor blocks another door
 -- for roomRectAutoLinks-- make the locked door a center door?
 sensorRoom :: RandomGen g => SensorType -> Int -> State g (Tree Room)
 sensorRoom senseType n = do
-    rm <- takeOne [roomNgon 8 200, roomRectAutoLinks 200 200]
+    rm <- join $ takeOne [roomNgon 8 200, roomRectAutoLinks 200 200]
    cenroom <- shuffleLinks $ sensInsideDoor senseType n rm
    return $ treePost
            [ door
@@ -95,7 +95,7 @@ tanksPipesRoom = do
    h <- state $ randomR (200, 300)
    i <- state $ randomR (2, 5)
    tanks <- randEdgeTanks i
-    return $ roomRectAutoLinks w h & rmPmnts .++~ tanks
+    roomRectAutoLinks w h <&> rmPmnts .++~ tanks

 tanksRoom :: RandomGen g => [Creature] -> [Item] -> State g Room
 tanksRoom crs its = do
@@ -103,12 +103,13 @@ tanksRoom crs its = do
    h <- state $ randomR (200, 400)
    ntanks <- state $ randomR (3, 6)
    thetank <- randomTank <&> plSpot .~ unusedOffPathAwayFromLink 50
-    let room = roomRectAutoLinks w h
+    thelight <- mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnk rp
+    room <- roomRectAutoLinks w h
    let plmnts =
            map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) its
                ++ map (\cr -> sps0 (PutCrit cr) & plSpot .~ unusedSpotAwayFromLink 50) crs
                ++ replicate ntanks thetank
-                ++ [mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnk rp]
+                ++ [thelight]
    --            , sps0 $ PutShape $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)
    hgshape <- takeOne [girder 96 20 10, girderZ 96 20 10, girderV 96 20 10]
    addhighgirds <-
@@ -19,8 +19,7 @@ telRoomLev ::
 telRoomLev _ = do
    w <- state $ randomR (200, 300)
    h <- state $ randomR (200, 300)
-    return $
-        roomRectAutoLinks w h & rmPmnts
+    roomRectAutoLinks w h <&> rmPmnts
            .~ [ sPS (V2 (w / 2) (h / 2)) 0 $ PutPPlate telPP
               , sPS (V2 (w / 2) (h / 2 + 30)) 0 putLamp
               ]
@@ -55,26 +55,29 @@ tutAnoTree =

 tutDrop :: State LayoutVars (MetaTree Room String)
 tutDrop = do
-    x <- shuffleLinks $ roomNgon 6 100
+    x <- shuffleLinks =<< roomNgon 6 100
    y <- decontamRoom
-    return $ tToBTree "TutDrop" $ treePost [x,y,cleatOnward $ roomRectAutoLinks 40 100]
+    rm <- roomRectAutoLinks 40 100
+    return $ tToBTree "TutDrop" $ treePost [x,y,cleatOnward rm]

 tutRooms :: State LayoutVars (MetaTree Room String)
 tutRooms = do
    i <- nextLayoutInt
    j <- nextLayoutInt
-    x <- shuffleLinks $ analyserByDoor (RequireEquipment (AMMOMAG DRUMMAG)) i 
-         $ addDoorAtNthLinkToggleTerminal 1 (makeTermPara s) j
-            $ roomNgon 6 100
+    x <- shuffleLinks =<< analyserByDoor (RequireEquipment (AMMOMAG DRUMMAG)) i 
+         <$> addDoorAtNthLinkToggleTerminal 1 (makeTermPara s) j
+            <$> roomNgon 6 100
    bcor <- blockedCorridor
+    r1 <-(r burstRifle)
+    r2 <-(r (drumMag & itConsumables ?~ 100))
    return $ tToBTree "DoorTest" $ Node x 
-        [treeFromPost [triggerDoorRoom i] (r burstRifle)
-        ,treeFromPost [triggerDoorRoom j] (r (drumMag & itConsumables ?~ 100))
+        [treeFromPost [triggerDoorRoom i] r1
+        ,treeFromPost [triggerDoorRoom j] r2
        ,bcor
        ]
  where
    s = "INTERACTION TEST: USE KEYBOARD OR SCROLL TO ENTER COMMANDS."
-    r x = roomRectAutoLinks 100 100 & rmPmnts .:~ sps (PS 50 0) (PutFlIt x)
+    r x = roomRectAutoLinks 100 100 <&> rmPmnts .:~ sps (PS 50 0) (PutFlIt x)

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