Commit before generalising FromWest/South etc

src/Dodge/Annotation.hs

@@ -7,7 +7,7 @@ module Dodge.Annotation
 import Dodge.UseAll
 import RandomHelp
 import Dodge.Tree
---import Dodge.Data
+import Dodge.Data
 import Dodge.Annotation.Data
 import LensHelp
 
@@ -16,7 +16,8 @@ import Data.Maybe
 
 annoToRoomTree :: Annotation -> State (StdGen,Int) MTRS
 annoToRoomTree an = case an of
-    SpecificRoom r -> zoom _1 r 
+    AnTree t -> zoom _1 t 
+    AnRoom r -> MTree "SingleRoom" . NodeTree . pure . (rmClusterStatus . csLinks . at OnwardCluster ?~ ())  <$> zoom _1 r <*> return []
     OnwardList ans -> do
         mts <- mapM annoToRoomTree ans
         return $ foldr1 attachOnward mts

src/Dodge/Annotation/Data.hs

@@ -16,7 +16,8 @@ data Annotation
     = ModifyTree (MetaTree Room String -> MetaTree Room String) Annotation
     | OnwardList [Annotation]
     | IntAnno (Int -> Annotation)
-    | SpecificRoom (State StdGen (MetaTree Room String))
+    | AnRoom (State StdGen Room)
+    | AnTree (State StdGen (MetaTree Room String))
     | PassthroughLockKeyLists
         [(Int -> State StdGen (MetaTree Room String), State StdGen ItemBaseType)]
         [(ItemBaseType, State StdGen (MetaTree Room String))]

src/Dodge/Floor.hs

@@ -38,65 +38,67 @@ import Data.List (intersperse)
 
 initialAnoTree :: Annotation
 initialAnoTree = OnwardList 
-        $ intersperse (SpecificRoom $ tToBTree "cori" . pure <$> shuffleLinks (cleatOnward corridor))
+        $ intersperse (AnTree $ tToBTree "cori" . pure <$> shuffleLinks (cleatOnward corridor))
-    [ IntAnno $ SpecificRoom . startRoom
+    [ IntAnno $ AnTree . startRoom
 --     ,  (SpecificRoom . return . tToBTree $ treePost [corridor,corridor,cleatOnward corridor])
+    , AnRoom $ roomCCrits 10
+    , AnRoom doubleCorridorBarrels
     , IntAnno $ PassthroughLockKeyLists
         [(sensorRoomRunPast ELECTRICAL, takeOne [STATICMODULE,SPARKGUN] )] itemRooms
     , IntAnno $ PassthroughLockKeyLists keyCardRunPastRand itemRooms
-    , IntAnno $ SpecificRoom . warningRooms
+    , IntAnno $ AnTree . warningRooms
-    , SpecificRoom $ rToOnward "chaseCrit+armourChaseCrit rectRoom"
+    , AnTree $ rToOnward "chaseCrit+armourChaseCrit rectRoom"
         $ return . cleatOnward $ roomRectAutoLinks 400 400 & rmPmnts .++~ 
             [ spNoID anyUnusedSpot (PutCrit invisibleChaseCrit)
             , spNoID anyUnusedSpot (PutCrit armourChaseCrit)
             ]
-    , IntAnno $ SpecificRoom . fmap (tToBTree "healthTest") . healthTest
+    , IntAnno $ AnTree . fmap (tToBTree "healthTest") . healthTest
-    , SpecificRoom (tanksRoom [] [] >>= rToOnward "empty tanksRoom" . pure . cleatOnward)
+    , AnTree (tanksRoom [] [] >>= rToOnward "empty tanksRoom" . pure . cleatOnward)
     , IntAnno $ PassthroughLockKeyLists lockRoomKeyItems itemRooms
-    , SpecificRoom randomChallenges
+    , AnTree randomChallenges
-    , IntAnno $ SpecificRoom . lasSensorTurretTest
+    , IntAnno $ AnTree . lasSensorTurretTest
---    ,[SpecificRoom $ fmap pure roomCCrits]
+--    ,[AnTree $ fmap pure roomCCrits]
 --    ,[AirlockAno]
 --    ,[Corridor]
-------    ,[SpecificRoom roomCCrits]
+------    ,[AnTree roomCCrits]
 ------    ,[Corridor]
-------    ,[SpecificRoom . pure . pure . useAll $ roomGlassOctogon 400 
+------    ,[AnTree . pure . pure . useAll $ roomGlassOctogon 400 
 ------        & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit armourChaseCrit 
 ------                    ,sPS (V2 50 25) 0 $ PutCrit armourChaseCrit 
 ------                    ,sPS (V2 50 0) 0 $ PutCrit armourChaseCrit 
 ------                    ]++)
 ------     ]
-------    --,[SpecificRoom . pure . pure . useAll $ roomGlassOctogon 400 
+------    --,[AnTree . pure . pure . useAll $ roomGlassOctogon 400 
 ------    --    & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200,202] ]++)
 ------    -- ]
-------    ,[SpecificRoom . pure . pure . useAll $ roomGlassOctogon 400 
+------    ,[AnTree . pure . pure . useAll $ roomGlassOctogon 400 
 ------        & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit pistolCrit ]++)
 ------     ]
 ------    ,[Corridor]
-----    --,[SpecificRoom $ pure . useAll <$> twinSlowDoorChasers]
+----    --,[AnTree $ pure . useAll <$> twinSlowDoorChasers]
------    ,[SpecificRoom $ pure $ (pure . useAll) (twinSlowDoorRoom 80 200 40)]
+-----    ,[AnTree $ pure $ (pure . useAll) (twinSlowDoorRoom 80 200 40)]
 -----    ,[DoorAno]
------    ,[SpecificRoom $ pure . useAll <$> centerVaultExplosiveExit]
+-----    ,[AnTree $ pure . useAll <$> centerVaultExplosiveExit]
------    ,[SpecificRoom blockedCorridor]
+-----    ,[AnTree blockedCorridor]
 -----    ,[OrAno [[DoorAno]
 -----            ,[Corridor]
 -----            ,[DoorNumAno 0,AirlockAno]] 
 -----            ]
 -----    ,[FirstWeapon]
 -----    ,[CorridorDebug]
------    ,[SpecificRoom $ fmap (pure . useAll) randomFourCornerRoom]
+-----    ,[AnTree $ fmap (pure . useAll) randomFourCornerRoom]
 --    ,[OrAno 
---        [[SpecificRoom $ branchRectWith $ fmap (fmap ) armouredChasers]
+--        [[AnTree $ branchRectWith $ fmap (fmap ) armouredChasers]
 --        ,[BossAno $ addArmour launcherCrit & crHP +~ 800
 --            & crState . crDropsOnDeath .~ DropSpecific [0] ]
 --        ]
 --     ]
-----    ,[SpecificRoom $ fmap (pure . useAll) armouredCorridor]
+----    ,[AnTree $ fmap (pure . useAll) armouredCorridor]
 --    ,[Corridor]
 --    ,[TreasureAno [addArmour autoCrit,addArmour autoCrit] [launcher]]
 --    ,[Corridor]
-    ,SpecificRoom $ randomFourCornerRoom [] >>= rToOnward "randomFourCornerRoom" . pure . cleatOnward 
+    ,AnTree $ randomFourCornerRoom [] >>= rToOnward "randomFourCornerRoom" . pure . cleatOnward 
-    ,SpecificRoom $ telRoomLev 1 >>= rToOnward "telRoomLev" . pure . cleatOnward
+    ,AnTree $ telRoomLev 1 >>= rToOnward "telRoomLev" . pure . cleatOnward
     ]
 
 {- | A test level tree. -}

src/Dodge/LevelGen.hs

@@ -53,7 +53,6 @@ layoutLevelFromSeed i seed = do
             putStrLnAppend "log/attemptedSeeds" $ "After " ++ show i' 
                 ++ " attempt(s), Successful generation of level with seed " 
                 ++ show seed
-            --return (fmap setLastLinkToUsed rs)
             putStrLnAppend "log/attemptedSeeds" $ show (Prelude.length rs) ++ " rooms in total"
             return (IM.fromList $ map reversePair rs , bounds)
         Nothing -> do

src/Dodge/PlacementSpot.hs

@@ -105,8 +105,8 @@ setFallback fallback
     )
 
 unusedOffPathAwayFromLink :: Float -> PlacementSpot
-unusedOffPathAwayFromLink x = rprBool $ \rp r -> _rpLinkStatus rp == NotLink 
+--unusedOffPathAwayFromLink x = rprBool $ \rp r -> _rpLinkStatus rp == NotLink 
-    && _rpPlacementUse rp == 0 
+unusedOffPathAwayFromLink x = rprBool $ \rp r -> _rpPlacementUse rp == 0 
     && all ( (>x) . dist (_rpPos rp) ) (usedRoomLinkPoss r)
     && RoomPosOffPath `S.member` _rpType rp
 

src/Dodge/Room/Girder.hs

@@ -1,2 +1,28 @@
 module Dodge.Room.Girder where
+import Dodge.Data
+import RandomHelp
+import Dodge.Room.Foreground
+import Dodge.Room.Modify.Girder
+import Color
 
+addRandomGirderEW :: RandomGen g => Room -> State g Room
+addRandomGirderEW rm = do
+    hgshape <- takeOne [girder 96 20 10, girderZ 96 20 10, girderV 96 20 10]
+    lgshape <- takeOne [girder 60 20 10, girderZ 60 20 10, girderV 60 20 10]
+    addgird <- takeOne $
+        [ addGirderNS' hgshape black
+        , addGirderNS' lgshape red
+        ]
+    addgird rm
+
+addRandomGirderFromWest :: RandomGen g => Int -> Room -> State g Room
+addRandomGirderFromWest i rm = do
+    (h,col) <- takeOne [(96,black),(60,red)]
+    gtype   <- takeOne [girder,girderZ,girderV]
+    addGirderFromWest i (gtype h 20 10) col rm
+
+addRandomGirderFrom :: RandomGen g => CardinalPoint -> Int -> Room -> State g Room
+addRandomGirderFrom cp i rm = do
+    (h,col) <- takeOne [(96,black),(60,red)]
+    gtype   <- takeOne [girder,girderZ,girderV]
+    addGirderFrom cp i (gtype h 20 10) col rm

src/Dodge/Room/Modify/Girder.hs

@@ -1,8 +1,11 @@
 module Dodge.Room.Modify.Girder 
     ( addGirderLights
+    , addGirderFrom
     , addHighGirder
     , addGirderEW
     , addGirderNS
+    , addGirderNS'
+    , addGirderFromWest
     ) where
 --import Dodge.Data
 import Dodge.LevelGen.Data
@@ -36,6 +39,43 @@ addGirderNS shapef col room = do
             $ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) 
        | i <- girderPosOrder]
         )
+-- this can be cleaned up
+addGirderFromWest :: RandomGen g => Int -> (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room
+addGirderFromWest fromwesti shapef col room = do
+    let nwestlnks = length $ filter ((OnEdge North `S.member`) . _rlType) $ _rmLinks room
+    girderPosOrder <- shuffle [0 .. nwestlnks - 1]
+    return $ room & rmPmnts .:~ foldr1 setFallback 
+        (sps0 PutNothing : [ twoRoomPoss 
+            (isUnusedLnkType (FromWest i)) 
+            (isUnusedLnkType (FromWest i)) 
+            $ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) 
+       | i <- [fromwesti]]
+        )
+
+addGirderFrom :: RandomGen g => CardinalPoint -> Int 
+    -> (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room
+addGirderFrom cp fromwesti shapef col room = do
+    let nwestlnks = length $ filter ((OnEdge North `S.member`) . _rlType) $ _rmLinks room
+    girderPosOrder <- shuffle [0 .. nwestlnks - 1]
+    return $ room & rmPmnts .:~ foldr1 setFallback 
+        (sps0 PutNothing : [ twoRoomPoss 
+            (isUnusedLnkType (FromWest i)) 
+            (isUnusedLnkType (FromWest i)) 
+            $ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) 
+       | i <- [fromwesti]]
+        )
+-- | Allows girder to be on edge
+addGirderNS' :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room
+addGirderNS' shapef col room = do
+    let nwestlnks = length $ filter ((OnEdge North `S.member`) . _rlType) $ _rmLinks room
+    girderPosOrder <- shuffle [0 .. nwestlnks - 1]
+    return $ room & rmPmnts .:~ foldr1 setFallback 
+        (sps0 PutNothing : [ twoRoomPoss 
+            (isUnusedLnkType (FromWest i)) 
+            (isUnusedLnkType (FromWest i)) 
+            $ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) 
+       | i <- girderPosOrder]
+        )
 addGirderEW :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room
 addGirderEW shapef col room = do
     let nwestlnks = length $ filter ((OnEdge West `S.member`) . _rlType) $ _rmLinks room

src/Dodge/Room/Procedural.hs

@@ -74,8 +74,8 @@ roomRect x y xn yn = defaultRoom
     yd = (y - 40) / fromIntegral yn
     xd = (x - 40) / fromIntegral xn
     somelnks poffset ps a = zip (map (+.+ poffset) ps) (repeat a)
-    elnks = somelnks (V2 0 20) (gridPoints  0  1      yd (yn+1))  ( pi/2) 
+    wlnks = somelnks (V2 0 20) (gridPoints  0  1      yd (yn+1))  ( pi/2) 
-    wlnks = somelnks (V2 x 20) (gridPoints  0  1      yd (yn+1))  (-pi/2) 
+    elnks = somelnks (V2 x 20) (gridPoints  0  1      yd (yn+1))  (-pi/2) 
     nlnks = somelnks (V2 20 y) (gridPoints xd (xn+1)  0  1     )       0  
     slnks = somelnks (V2 20 0) (gridPoints xd (xn+1)  0  1     )      pi  
     lnks = m North FromWest FromEast nlnks

src/Dodge/Room/Room.hs

@@ -1,6 +1,11 @@
 --{-# LANGUAGE TupleSections #-}
-module Dodge.Room.Room where
+module Dodge.Room.Room 
-import Data.Tile
+    ( shootingRange
+    , weaponRoom
+    , roomMiniIntro
+    , roomCCrits
+    , doubleCorridorBarrels
+    ) where
 import Dodge.UseAll
 import Dodge.Data
 import Dodge.PlacementSpot
@@ -9,6 +14,7 @@ import Dodge.Default.Room
 import Dodge.Item.Weapon.BulletGuns
 import Dodge.Creature
 import Dodge.Room.Pillar
+import Dodge.Room.Girder
 import Dodge.Room.Modify.Girder
 import Dodge.LevelGen.Data
 import RandomHelp
@@ -18,18 +24,16 @@ import Dodge.Placement.Instance
 --import Dodge.LevelGen.Data
 import Dodge.Room.Procedural
 import Dodge.Room.Corridor
+import Dodge.Room.Tanks
 import Dodge.Room.Link
 import Dodge.Room.Door
 import Dodge.Room.Airlock
 import Geometry
-import Tile
 import MonadHelp
 import LensHelp
 --import Color
 
 import qualified Data.Set as S
---import Control.Monad.Loops
-import Data.Bifunctor
 
 roomC :: RandomGen g => Float -> Float -> State g Room
 roomC w h = do
@@ -37,12 +41,18 @@ roomC w h = do
             [ sPS (V2 0 0) 0 $ PutWall (rectNSWE (h-60) 0 (w/2-10) (w/2+10)) defaultCrystalWall
             , windowLine (V2 (w/2) 0) (V2 (w/2) (h-60))
             ]
-    shuffleLinks $ roomRectAutoLinks w h
+    ntanks <- takeOne [0,0,0,0,0,1,1,1,1,2,3,4]
-        & restrictOutLinks fromCond 
+    thetank <- randomTank <&> plSpot .~ unusedOffPathAwayFromLink 50
-        & rmPmnts .:~ wl
+    maybeaddgird <- takeOne [return, addRandomGirderFromWest 0, addRandomGirderFrom North 0]
+    maybeaddgird =<< (shuffleLinks $ roomRectAutoLinks w h
+        & rmLinks %~ 
+            ( (setInLinks (\rl -> S.fromList [FromEast 0,OnEdge South] `S.isSubsetOf` _rlType rl))
+            . (setOutLinks (\rl -> OnEdge West `S.member` _rlType rl))
+            )
+        & rmPmnts .++~ (wl : replicate ntanks thetank)
         & rmRandPSs .~ [farside]
+        )
   where
-    fromCond (V2 x _,_) = x < w / 2 - 10
     farside = do
         x <- state $ randomR (5, w/2 - 20)
         y <- state $ randomR (5, h - 70)
@@ -59,10 +69,6 @@ roomPadCut ps p = defaultRoom
 branchWith :: Room -> [Tree Room] -> Tree Room
 branchWith r ts = Node r $ return (cleatOnward door) : ts
 
-
-manyDoors :: Int -> Tree Room
-manyDoors i = treeFromPost (replicate i door) $ cleatOnward door
-
 glassSwitchBack :: RandomGen g => State g Room
 glassSwitchBack = do
     wth <- state $ randomR (200,400)
@@ -103,23 +109,6 @@ miniTree2 = do
     rm <- glassSwitchBackCrits >>= shuffleLinks . restrictInLinks (\p -> (sndV2 . fst) p < 70)
     return $ branchWith rm (replicate 3 $ treePost [door,corridor,critInDeadEnd])
 
-miniRoom3 :: RandomGen g => State g (Tree Room)
-miniRoom3 = do
-    w <- state $ randomR (300,400)
-    h <- state $ randomR (300,400)
-    let cp = V2 0 (h/2+40)
-    let b = PutBlock StoneBlock 5 [20,20] baseBlockPane $ rectNSEW 10 (-10) (-60) (-80)
-                -- baseBlockPlane might need a reverse...
-    let plmnts = concatMap 
-            (\i -> [ sPS cp (fromIntegral i*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
-                , sPS cp (pi/8+fromIntegral i*pi/4) b]
-            ) [0..7::Int]
-            ++ [ sPS cp 0 $ PutCrit miniGunCrit , sPS (V2 (w/2) (h/2)) 0 putLamp ]
-    pure <$> shuffleLinks (cleatOnward $ set rmPmnts plmnts $ roomRectAutoLinks w h)
-
-rot90Around :: Point2 -> Point2 -> Point2
-rot90Around cen p = cen +.+ vNormal (p -.- cen)
-
 -- So, the idea is to attach outer children to the bottommost right nodes
 -- inside an inner tree
 -- no idea what was going on here...
@@ -142,31 +131,6 @@ roomCenterPillar = shuffleLinks . restrictInLinks ((\p -> dist p (V2 120 0) < 10
         , mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isInLnk rp)       
         ]
 
-roomOctogon :: Room
-roomOctogon = defaultRoom
-    { _rmPolys = [poly ]
-    , _rmLinks = muout (init lnks) ++ muin [last lnks]
-    , _rmPath  = allPairs $ map fst lnks -- this is too much
-    , _rmPmnts = []
-    , _rmBound = [map toV2 [(-20,30),(20,30),(60,70),(60,110),(20,150),(-20,150),(-60,110),(-60,70)] ]
-    , _rmFloor = Tiled [makeTileFromPoly poly 7]
-    }
-  where 
-    poly = map toV2 [(-20,40),(20,40),(50,70),(50,110),(20,140),(-20,140),(-50,110),(-50,70)]
-    lnks = map (first toV2)
-        [((0,140),0)
-        ,((35,125),negate $ pi/4)
-        ,((-35,125),pi/4)
-        ,( (50,90),negate $ pi/2)
-        ,( (-50,90),pi/2)
-        ,((35,55),negate $ 3*pi/4)
-        ,((-35,55),3*pi/4)
-        ,( (0,40),pi)
-        ]
-
-allPairs :: Eq a => [a] -> [(a,a)]
-allPairs xs = [(x,y) | x <- xs, y <- xs, x /= y]
-
 {- Probabilites of the type of the first floor weapon.  -}
 randFirstWeapon :: State StdGen PSType
 randFirstWeapon = do
@@ -287,9 +251,9 @@ weaponRoom i = join $ takeOne
     , weaponLongCorridor    >>= rToOnward "weaponLongCorridor"
     ]
 
-roomCCrits :: RandomGen g => State g Room
+roomCCrits :: RandomGen g => Int -> State g Room
-roomCCrits = roomC 200 200
+roomCCrits i = roomC 200 200
-    <&> rmPmnts %~ (replicate 20 (spNoID (PSRoomRand 0 (uncurry PS)) randC1) ++ )
+    <&> rmPmnts .++~ replicate i (spNoID (PSRoomRand 0 (uncurry PS)) randC1)
 
 doubleCorridorBarrels :: RandomGen g => State g Room
 doubleCorridorBarrels = do
@@ -297,13 +261,11 @@ doubleCorridorBarrels = do
     let cond x = (sndV2 . fst) x < h - 40
     return $ restrictInLinks cond $ roomRect 100 h 1 1 & rmPmnts .~
         [blockLine (V2 50 50) (V2 50 h)
-        ,sPS (V2 25 (h-25)) 0 $ PutCrit $ addArmour autoCrit
+        ,sPS (V2 25 (h-25)) (negate pi/2) $ PutCrit $ addArmour autoCrit
-        ,sPS (V2 75 (h-30)) 0 $ PutCrit explosiveBarrel
-        ,sPS (V2 75 (h-60)) 0 $ PutCrit explosiveBarrel
-        ,sPS (V2 85 (h-10)) 0 $ PutCrit explosiveBarrel
-        ,sPS (V2 85 (h-45)) 0 $ PutCrit explosiveBarrel
         ,sPS (V2 75 (h-80)) 0 putLamp
-        ]
+        ] ++
+        [sPS p 0 $ PutCrit explosiveBarrel
+            | p <- [ V2 75 (h-30) ,V2 75 (h-60) ,V2 85 (h-10) ,V2 85 (h-45) ]   ]
 
 shootersRoom' :: RandomGen g => State g Room
 shootersRoom' = do

src/Dodge/Room/RunPast.hs

@@ -1,37 +1,25 @@
-module Dodge.Room.RunPast where
+module Dodge.Room.RunPast 
+    ( lockedStart
+    ) where
 import Dodge.UseAll
 import Geometry.Polygon
 import Dodge.LevelGen.Data
 import Dodge.LightSource
---import Dodge.RoomLink
 import Dodge.Data
---import Dodge.Default
---import Dodge.Layout.Tree.Either
 import RandomHelp
 import Dodge.Room.Door
---import Dodge.Room.Room
 import Dodge.Room.Link
 import Dodge.Room.Procedural
 import Dodge.Room.Corridor
---import Dodge.Room.Foreground
---import Dodge.Room.RoadBlock
 import Dodge.PlacementSpot
 import Dodge.Placement.Instance
 import Dodge.Tree
 import Dodge.Item.Random
---import Dodge.Item.Weapon.SprayGuns
---import Dodge.Item.Weapon.Grenade
---import Dodge.LevelGen.Data
 import Geometry.Data
---import Padding
 import Color
 import LensHelp
 
 import qualified Data.Set as S
---import qualified Data.IntMap.Strict as IM
-
-horEdgeTest :: (Float -> Bool) -> ((Point2,Float) -> Bool)
-horEdgeTest t (V2 x _,_) = t x
 
 roomCritLS :: RandomGen g => State g LightSource
 roomCritLS = do
@@ -43,27 +31,24 @@ roomCritLS = do
 smallRoom :: Room
 smallRoom = corridorWallN & rmRandPSs .~ [psRandRanges (15,25) (30,45) (pi,2*pi)]
 
-lookedStart :: RandomGen g => Int -> State g (Tree Room)
+lockedStart :: RandomGen g => Int -> State g (Tree Room)
-lookedStart i = do
+lockedStart i = do
     h           <- state $ randomR (200,400::Float)
     thels       <- roomCritLS
     theweapon   <- randBlockBreakWeapon
-    cenroom     <- shuffleLinks
+    cenroom     <- shuffleLinks $ roomRectAutoLinks 40 h & rmPmnts .~ []
-        $ roomRectAutoLinks 40 h & rmPmnts .~ [plRRpt 0 (PutFlIt theweapon)]
     theedge     <- takeOne $ map OnEdge [West,East]
     let linkcor = smallRoom & rmPmnts .~ [ spanLS thels (V2 0 65) (V2 40 65) ]
-        critroom = linkcor & rmPmnts .:~ plRRpt 0 randC1
-        switchdoor = triggerDoorRoom i
         n = length $ filter (elem theedge . _rlType) (_rmLinks cenroom)
-        doorrooms = map (treePost . (switchdoor:))
+        doorrooms = map (treePost . (triggerDoorRoom i:))
-            $ [critroom]
+            $ [linkcor & rmPmnts .:~ plRRpt 0 randC1]
             : [linkcor,corridor,corridor,cleatOnward door]
             : replicate (n-2) [linkcor]
     return $ Node cenroom $
         map (over root $ rmConnectsTo .~ S.member theedge) doorrooms
-        ++ [return corridorWallN
+        ++ [return smallRoom
                 {_rmOutPmnt = [OutPlacement (putLitButOnPosExtTrig red useUnusedLnk) i]
-                ,_rmPmnts = []
+                ,_rmPmnts = [plRRpt 0 (PutFlIt theweapon)]
                 ,_rmBound = [rectNSWE 70 30 0 40]
                 }
             ]

src/Dodge/Room/Start.hs

@@ -71,7 +71,7 @@ randomChallenges = shootingRange
 runPastStart :: RandomGen g => Int -> State g (Tree Room)
 runPastStart i = do
     s <- rezBoxStart
-    rp <- lookedStart i
+    rp <- lockedStart i
     return . shiftChildren $ attachTree toOnward rp $ fmap ([],) s
     
 

src/Dodge/RoomLink.hs

@@ -15,6 +15,7 @@ module Dodge.RoomLink
     , setInLinksPD
     , restrictOutLinks
     , restrictInLinks
+    , setOutLinks
     , setInLinks
     , setInLinksByType
     , setLinkType

src/Dodge/Tree/Compose.hs

@@ -9,16 +9,11 @@ module Dodge.Tree.Compose
     , numSelfTree
     , combineTree
     , decomposeSelfTree
---    , composeTree'
     , shiftChildren
     , attachTree
---    , composeTreeRand
---    , composeAndLog
     , toOnward
     , attachOnward
     , showIntsString
---    , cmpToMT
---    , compTree
     , module Dodge.Tree.Compose.Data
     ) where
 import Dodge.Data

src/Dodge/Tree/Compose/Data.hs

@@ -5,7 +5,6 @@ import Data.Tree
 import Control.Lens
 
 
---data MetaTree a = MTree {_mtLabel :: String , _mtTree :: MetaNode a , _mtBranches :: [MetaBranch a] }
 data MetaTree a b = MTree {_mtLabel :: b , _mtTree :: MetaNode a b, _mtBranches :: [MetaBranch a b] }
 data MetaNode a b = NodeTree {_nodeTree :: Tree a} | NodeMTree {_nodeMetaTree :: MetaTree a b}
 data MetaBranch a b = MBranch {_mbAttach :: a -> Maybe a, _mbTree :: MetaTree a b}