Make Placement into a product type

log/aGeneratedRoomLayout

@@ -1,4 +1,4 @@
-Seed: 7114951007332849727
+Seed: 897386367644826610
 Room layout (compact): 
 0,1,2,3,4,5,6
 |

log/attemptedSeeds

@@ -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

log/treeCluster

@@ -1,4 +1,4 @@
-Seed: 7114951007332849727
+Seed: 897386367644826610
 0:teststart
 |
 1:TutDrop

saveSlot/seed

@@ -1 +1 @@
-7114951007332849727
+897386367644826610

src/Dodge/Data/GenWorld.hs

@@ -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;

src/Dodge/Floor.hs

@@ -66,12 +66,12 @@ initialAnoTree =
               PassthroughLockKeyLists keyCardRunPastRand itemRooms
             , AnTree . intAnno $ warningRooms "INVISIBLE CREATURE AHEAD"
             , AnTree $
-                rToOnward "chaseCrit+armourChaseCrit rectRoom" $
+                rToOnward "chaseCrit+armourChaseCrit rectRoom" =<<
-                    return . cleatOnward $
+                    return . cleatOnward <$>
-                        roomRectAutoLinks 400 400 & rmPmnts
+                        (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)

src/Dodge/LevelGen/PlacementHelper.hs

@@ -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

src/Dodge/Placement/Instance/LightSource.hs

@@ -155,13 +155,13 @@ mntLSCond shp ps =
 
 -- note that this perhaps pushes the vshape light out too far
 
-mntLight :: Point2 -> Point2 -> Placement
+mntLight :: RandomGen g => Point2 -> Point2 -> State g Placement
-mntLight a b = RandomPlacement $ do
+mntLight a b = do
     shp <- takeOne [vShape, iShape, lShape, jShape, liShape]
     return $ mntLS shp a (addZ 90 b)
 
-mntLightLnkCond :: PlacementSpot -> Placement
+mntLightLnkCond :: RandomGen g => PlacementSpot -> State g Placement
-mntLightLnkCond ps = RandomPlacement $ do
+mntLightLnkCond ps = do
     shp <- takeOne [vShape, lShape, jShape, liShape]
     return $ mntLSCond (fmap (fmap $ colorSH black) shp) ps
 

src/Dodge/Placement/PlaceSpot.hs

@@ -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 ->

src/Dodge/Placement/Shift.hs

@@ -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

src/Dodge/Room/Airlock.hs

@@ -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
+    return $
-        & rmPolys .~ [rectNSWE 100 0 0 40, switchcut]
+        defaultRoom
-        & rmLinks .~ muout lnks ++ muin [last lnks]
+            & rmPolys .~ [rectNSWE 100 0 0 40, switchcut]
-        & rmPath .~ foldMap doublePairSet [(V2 20 95, V2 20 45), (V2 20 45, V2 20 5)]
+            & rmLinks .~ muout lnks ++ muin [last lnks]
-        & rmPmnts .~
+            & rmPath .~ foldMap doublePairSet [(V2 20 95, V2 20 45), (V2 20 45, V2 20 5)]
-            [ pContID (PS (V2 (-35) 50) (negate $ pi / 2)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
+            & rmPmnts
-                \btid -> Just $
+                .~ [ pContID (PS (V2 (-35) 50) (negate $ pi / 2)) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
-                    putDoubleDoorThen DoorObstacle thewall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $
+                        \btid -> Just $
-                        \_ _ -> Just $ putDoubleDoor DoorObstacle thewall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
+                            putDoubleDoorThen DoorObstacle thewall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $
-            , invisibleWall $ rectNSWE 60 40 (-40) (-30)
+                                \_ _ -> Just $ putDoubleDoor DoorObstacle thewall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
-            , spanLightI (V2 (-2) 30) (V2 (-2) 70)
+                   , invisibleWall $ rectNSWE 60 40 (-40) (-30)
-            , analyser (RequireHealth 100) (PS 50 0) (PS (V2 70 50) 0)
+                   , 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]
+                   ]
+            & 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 :: RandomGen g => State g Room
-airlockZ =
+airlockZ = do
-    defaultRoom
+    let cenlight = mntLS vShape (V2 90 60) (V3 90 40 50) `addPlmnt` mntLS vShape (V2 90 60) (V3 90 80 50)
-        { _rmPolys =
+        cornlight =
-            [rectNSWE 120 0 0 180]
+            mntLS vShape (V2 0 120) (V3 30 90 50) `addPlmnt` mntLS vShape (V2 180 120) (V3 150 90 50)
-        , _rmLinks = muout [(V2 0 30, pi / 2)] ++ muin [(V2 180 30, 1.5 * pi)]
+                `addPlmnt` sps0 (putShape (thinHighBar 50 (V2 30 90) (V2 150 90)))
-        , _rmPath = mempty
+    lighting <- takeOne [cenlight, cornlight]
-        , --         [(V2 0 40,V2 40 0)
+    return
-          --         ,(V2 40 0,V2 0 40)
+        defaultRoom
-          --         ]
+            { _rmPolys =
-          _rmPmnts =
+                [rectNSWE 120 0 0 180]
-            [ pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
+            , _rmLinks = muout [(V2 0 30, pi / 2)] ++ muin [(V2 180 30, 1.5 * pi)]
-                \btid -> airlockDoubleDoor (V2 0 60) (V2 180 60) col (WdBlBtOn btid) outDoorps inDoorps
+            , _rmPath = mempty
-            , --            jspsJ (V2 0 60) 0 (airlockDoor col (cond btid) outDoorps)
+            , --         [(V2 0 40,V2 40 0)
-              --            $ sPS (V2 180 60) 0 (airlockDoor col (cond btid) inDoorps)
+              --         ,(V2 40 0,V2 0 40)
-              sps0 $ PutWall (reverse $ rectNSWE 70 50 60 120) defaultWall
+              --         ]
-            , lighting
+              _rmPmnts =
-            ]
+                [ pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red NoWorldEffect NoWorldEffect) $
-        , _rmBound =
+                    \btid -> airlockDoubleDoor (V2 0 60) (V2 180 60) col (WdBlBtOn btid) outDoorps inDoorps
-            [rectNSWE 120 0 0 180]
+                , --            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 =

src/Dodge/Room/BlinkAcross.hs

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

src/Dodge/Room/Branch.hs

@@ -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

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 =<< (roomRectAutoLinks (2 * x) (2 * x) <&> rmPmnts .:~ sPS (V2 x x) 0 flit)
-            , shuffleLinks $ roomNgon ngon x & rmPmnts .:~ sps0 flit
+            , shuffleLinks =<< (roomNgon ngon x <&> rmPmnts .:~ sps0 flit)
             ]
     r <&> rmName .++~ "ped-"

src/Dodge/Room/GlassLesson.hs

@@ -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

src/Dodge/Room/LasTurret.hs

@@ -21,15 +21,16 @@ import Geometry
 import LensHelp
 import RandomHelp
 
-cenLasTur :: Room
+cenLasTur :: RandomGen g => State g Room
-cenLasTur =
+cenLasTur = do
-    roomNgon 8 200 & rmPmnts
+    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] $

src/Dodge/Room/LongDoor.hs

@@ -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

src/Dodge/Room/Ngon.hs

@@ -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 :: RandomGen g => Int -> Float -> State g Room
-roomNgon n x =
+roomNgon n x = do
-    defaultRoom
+    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"

src/Dodge/Room/Pillar.hs

@@ -48,9 +48,10 @@ smallPillar = PutBlock defaultBlock baseBlockPane $ reverse $ square 5
 
 roomPillarsSquare :: RandomGen g => State g Room
 roomPillarsSquare = do
-    let rm' = roomRectAutoLinks 300 300
+    rm' <- roomRectAutoLinks 300 300
-        nlew = _numLinkEW (_rmType rm')
+    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
                              ]
                   )
             ]

src/Dodge/Room/Procedural.hs

@@ -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 :: RandomGen g => Float -> Float -> State g Room
-roomRectAutoLinks x y =
+roomRectAutoLinks x y = do
-    roomRect x y (f x) (f y)
+    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
+        & rmPmnts .~ [ l1 , l2 ]
-            .~ [ mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isInLnk rp
-               , mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnk rp
-               ]
   where
     f z = max 1 $ (ceiling z - 40) `div` 60
 

src/Dodge/Room/RezBox.hs

@@ -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 $
+        shuffleLinks =<< (roomRectAutoLinks w h <&> rmPmnts .~ []
-            (roomRectAutoLinks w h){_rmPmnts = []}
+                <&> rmLinks %~ setInLinks bottomEdgeTest)
-                & rmLinks %~ setInLinks bottomEdgeTest
     let n = length $ filter bottomEdgeTest $ _rmLinks centralRoom
     return
         . tToBTree "rezBoxes"

src/Dodge/Room/Room.hs

@@ -41,13 +41,13 @@ roomC w h = do
     maybeaddgird <- takeOne [return, addRandomGirderFrom West 0, addRandomGirderFrom North 0]
     maybeaddgird
         =<< shuffleLinks
-            ( roomRectAutoLinks w h
+        =<< ( roomRectAutoLinks w h
-                & rmLinks
+                <&> 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))
+                <&> rmPmnts .:~ wallf (V2 (w / 2) 0) (V2 (w / 2) (h -60))
-                & rmRandPSs .~ [farside]
+                <&> 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 $
+    roomRectAutoLinks w 600
-        set rmPmnts plmnts $
+                <&> rmPmnts .~ plmnts
-            roomRectAutoLinks w 600
+                <&> rmRandPSs .~ [toPS x1 y1, toPS x2 y2, toPS x3 y3]
-                & rmPmnts .~ plmnts
-                & rmRandPSs .~ [toPS x1 y1, toPS x2 y2, toPS x3 y3]
 
 shootersRoom1 :: RandomGen g => State g Room
-shootersRoom1 =
+shootersRoom1 = do
-    shootersRoom' <&> rmPmnts
+    pl <- ( takeOne $
-        .:~ RandomPlacement
-            ( takeOne $
                 map
                     (\i -> psPtPl (PSRoomRand i (uncurry PS)) (PutCrit autoCrit))
                     [0, 1, 2]
             )
+    shootersRoom' <&> rmPmnts
+        .:~ pl
 
 shootersRoom :: RandomGen g => State g Room
 shootersRoom =

src/Dodge/Room/RunPast.hs

@@ -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)

src/Dodge/Room/SensorDoor.hs

@@ -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

src/Dodge/Room/Tanks.hs

@@ -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 <-

src/Dodge/Room/Teleport.hs

@@ -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
                ]

src/Dodge/Room/Tutorial.hs

@@ -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 
+    x <- shuffleLinks =<< analyserByDoor (RequireEquipment (AMMOMAG DRUMMAG)) i 
-         $ addDoorAtNthLinkToggleTerminal 1 (makeTermPara s) j
+         <$> addDoorAtNthLinkToggleTerminal 1 (makeTermPara s) j
-            $ roomNgon 6 100
+            <$> 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 i] r1
-        ,treeFromPost [triggerDoorRoom j] (r (drumMag & itConsumables ?~ 100))
+        ,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

src/Dodge/Room/Warning.hs

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