Commit before making out and in placements have ids

src/Dodge/Layout.hs

@@ -142,7 +142,8 @@ doExtendedPlacements :: GenWorld -> ( IM.IntMap [Placement], GenWorld)
 doExtendedPlacements w = let ((pmnts,gw),rms) = mapAccumR doExtendedPlacement (IM.empty,w) (_gRooms w)
     in (pmnts,gw{_gRooms = rms})
 
-doExtendedPlacement :: (IM.IntMap [Placement], GenWorld) -> Room 
+doExtendedPlacement :: (IM.IntMap [Placement], GenWorld) 
+    -> Room 
     -> ( (IM.IntMap [Placement], GenWorld) , Room )
 doExtendedPlacement (im,w) rm = case _rmExtPmnt rm of
     Nothing -> ( (im,w) , rm )
@@ -227,7 +228,7 @@ gameRoomFromRoom rm = GameRoom
         UsedInLink{}  -> ma
         _ -> Nothing
       where
-        ma = Just $ 0.5*pi + (_rpDir rp) + snd (_rmShift rm)
+        ma = Just $ 0.5*pi + _rpDir rp + snd (_rmShift rm)
     closePoints x y = roundPoint2 x == roundPoint2 y
     getDir (rp:xs) = case _rpLinkStatus rp of
         UsedInLink {} -> _rpDir rp + snd (_rmShift rm)

src/Dodge/LevelGen/Data.hs

@@ -89,7 +89,7 @@ data Room = Room
     , _rmTakeFrom   :: Maybe Int
     , _rmStartWires :: IM.IntMap RoomWire
     , _rmEndWires   :: IM.IntMap RoomWire
-    , _rmConnectsTo :: (S.Set RoomLinkType -> Bool)
+    , _rmConnectsTo :: S.Set RoomLinkType -> Bool
     , _rmMID        :: Maybe Int
     , _rmMParent    :: Maybe Int
     , _rmChildren   :: [Int]
@@ -105,7 +105,9 @@ data RoomLinkType
     | LabLink Int
     | OnEdge CardinalPoint
     | FromSouth Int
+    | FromNorth Int
     | FromWest Int
+    | FromEast Int
     deriving (Eq,Ord,Show)
 data CardinalPoint
     = North
@@ -130,7 +132,14 @@ data RPLinkStatus
     | UnusedLink  { _rplsType :: S.Set RoomLinkType }
     | NotLink
   deriving (Eq,Ord,Show)
-
+data OutPlacement = OutPlacement
+    { _opPlacement :: Placement
+    , _opPlacementID :: Int
+    }
+data InPlacement = InPlacement
+    { _ipPlacement :: [Placement] -> Placement
+    , _ipPlacementID :: Int
+    }
 data RoomPos = RoomPos
     { _rpPos :: Point2 
     , _rpDir :: Float

src/Dodge/LockAndKey.hs

@@ -14,11 +14,11 @@ import Control.Monad.State
 
 lockRoomKeyItems :: RandomGen g => [ (Int -> State g (SubCompTree Room) , State g CombineType ) ]
 lockRoomKeyItems = 
---    [(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD] )
+    [(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD] )
-    [(const slowDoorRoomRunPast, return MINIGUN)
+    ,(const slowDoorRoomRunPast, return MINIGUN)
---    ,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD])
+    ,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD])
---    ,(const glassLessonRunPast, takeOne [LASGUN])
+    ,(const glassLessonRunPast, takeOne [LASGUN])
---    ,(const $ lasTunnelRunPast 400, return FLATSHIELD)
+    ,(const $ lasTunnelRunPast 400, return FLATSHIELD)
     ]
 
 itemRooms :: RandomGen g => [(CombineType, State g (SubCompTree Room))]

src/Dodge/Placement/Instance/Button.hs

@@ -90,9 +90,9 @@ extTrigLitPos ps f = psPtCont ps (PutTrigger (const False))
     thels = lsColPosRad (V3 0.5 0 0) (V3 0 0 78) 75
 
 putLitButOnPosExtTrig :: Color 
-   -> (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)) 
+   -> PlacementSpot 
    -> Placement
-putLitButOnPosExtTrig col f 
+putLitButOnPosExtTrig col thePS
     = psPtCont thePS (PutTrigger (const False))
     $ \tp -> Just $ plSpot .~ _plSpot tp $ mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40)
     $ \plmnt -> let lsid = fromJust $ _plMID plmnt
@@ -104,4 +104,3 @@ putLitButOnPosExtTrig col f
     oneff tid = triggers . ix tid .~ const True
     changeLight lsid = lightSources . ix lsid . lsParam . lsCol .~ V3 0 0.5 0
     ls = lsRadCol 75 (V3 0.5 0 0)
-    thePS = PSPos f (const id) Nothing

src/Dodge/Placement/Instance/LightSource.hs

@@ -22,7 +22,7 @@ propLSThen :: (Prop -> World -> World)
     -> Prop
     -> (Placement -> Placement -> Maybe Placement) -- ^ continuation, access to ls and prop placements
     -> Placement
-propLSThen propf lsf ls prop cont = pt0 (PutLS $ ls)
+propLSThen propf lsf ls prop cont = pt0 (PutLS ls)
     $ \lspl -> Just $ pt0 (PutProp $ prop & pjUpdate .~ theupdate (fromJust $ _plMID lspl))
     $ cont lspl
   where

src/Dodge/PlacementSpot.hs

@@ -1,5 +1,26 @@
-{-# LANGUAGE LambdaCase #-}
+--{-# LANGUAGE LambdaCase #-}
-module Dodge.PlacementSpot where
+module Dodge.PlacementSpot 
+    ( atFstLnkOut
+    , useUnusedLnk
+    , psRandRanges
+    , useRoomPosCond
+    , isUsedLnkUnplaced
+    , anyUnusedSpot
+    , unusedSpotAwayFromLink
+    , isUnusedLnk
+    , unusedLnkToPS
+    , unusedSpotNearInLink
+    , randDirPS
+    , unusedSpotAwayFromInLink
+    , useLnkRoomPos
+    , atFstLnkOutShiftInward
+    , atFstLnkOutShiftBy
+    , atNthLnkOutShiftInward
+    , unusedOffPathAwayFromLink
+    , setFallback
+    , twoRoomPoss
+    , isUnusedLinkType
+    ) where
 import Dodge.LevelGen.Data
 import Geometry
 
@@ -22,88 +43,61 @@ randDirPS ps = do
     a <- state $ randomR (0,pi*2)
     return $ setDirPS a ps
 
+roomPosBool :: (RoomPos -> Bool) -> PlacementSpot
+roomPosBool t = PSPos (useRoomPosCond t) (const id) Nothing
+
 anyUnusedSpot :: PlacementSpot
-anyUnusedSpot = PSPos f (const id) Nothing
+anyUnusedSpot = roomPosBool $ \rp -> _rpLinkStatus rp == NotLink && _rpPlacementUse rp == 0 
-  where
+
-    f rp _ 
+roomPosRoomBool :: (RoomPos -> Room -> Bool) -> PlacementSpot
-        | _rpLinkStatus rp == NotLink && _rpPlacementUse rp == 0 
+roomPosRoomBool t = PSPos (useRoomPosRoomCond t) (const id) Nothing
-                    = Just $ (PS (_rpPos rp) (_rpDir rp), rp & rpPlacementUse +~ 1)
+
-        | otherwise = Nothing
 unusedSpotAwayFromLink :: Float -> PlacementSpot
-unusedSpotAwayFromLink x = PSPos f (const id) Nothing
+unusedSpotAwayFromLink x = roomPosRoomBool $ \rp r -> _rpLinkStatus rp == NotLink 
-  where
+    && _rpPlacementUse rp == 0 
-    f rp r 
+    && all ( (>x) . dist (_rpPos rp) ) (usedRoomLinkPoss r)
-        | _rpLinkStatus rp == NotLink 
-            && _rpPlacementUse rp == 0 
-            && all ( (>x) . dist p ) (usedRoomLinkPoss r)
-                    = Just $ (PS p (_rpDir rp), rp & rpPlacementUse +~ 1)
-        | otherwise = Nothing
-      where
-        p = _rpPos rp
 
 setFallback :: Placement -> Placement -> Placement
-setFallback fallback plmnt = plmnt
+setFallback fallback = (plSpot . psFallback %~ maybe (Just fallback) Just)
-    & plSpot . psFallback %~ maybe (Just fallback) Just
+    . (plIDCont %~ fmap (fmap $ setFallback fallback))
-    & plIDCont %~ fmap (fmap $ setFallback fallback)
 
 unusedOffPathAwayFromLink :: Float -> PlacementSpot
-unusedOffPathAwayFromLink x = PSPos f (const id) Nothing
+unusedOffPathAwayFromLink x = roomPosRoomBool $ \rp r -> _rpLinkStatus rp == NotLink 
-  where
+    && _rpPlacementUse rp == 0 
-    f rp r 
+    && all ( (>x) . dist (_rpPos rp) ) (usedRoomLinkPoss r)
-        | _rpLinkStatus rp == NotLink 
+    && RoomPosOffPath `S.member` _rpType rp
-            && _rpPlacementUse rp == 0 
-            && all ( (>x) . dist p ) (usedRoomLinkPoss r)
-            && RoomPosOffPath `S.member` _rpType rp
-                    = Just $ (PS p (_rpDir rp), rp & rpPlacementUse +~ 1)
-        | otherwise = Nothing
-      where
-        p = _rpPos rp
 
 unusedSpotAwayFromInLink :: Float -> PlacementSpot
-unusedSpotAwayFromInLink x = PSPos f (const id) Nothing
+unusedSpotAwayFromInLink x = roomPosRoomBool $ \rp r -> _rpLinkStatus rp == NotLink 
-  where
+    && _rpPlacementUse rp == 0 
-    f rp r 
+    && all ( (>x) . dist (_rpPos rp) ) (usedRoomInLinkPoss r)
-        | _rpLinkStatus rp == NotLink 
-            && _rpPlacementUse rp == 0 
-            && all ( (>x) . dist p ) (usedRoomInLinkPoss r)
-                    = Just $ (PS p (_rpDir rp), rp & rpPlacementUse +~ 1)
-        | otherwise = Nothing
-      where
-        p = _rpPos rp
 
-twoUnusedLinks :: (PlacementSpot -> PlacementSpot -> Placement)
+--twoUnusedLinks :: (PlacementSpot -> PlacementSpot -> Placement) -> Placement
-    -> Placement
+--twoUnusedLinks = twoRoomPoss isUnusedLnk isUnusedLnk
-twoUnusedLinks f = Placement useUnusedLink PutNothing Nothing
-    $ \pl1 -> Just $ Placement useUnusedLink PutNothing Nothing
-    $ \pl2 -> Just $ f (_plSpot pl1) (_plSpot pl2)
 
 twoRoomPoss :: (RoomPos -> Bool)
     -> (RoomPos -> Bool)
     -> (PlacementSpot -> PlacementSpot -> Placement)
     -> Placement
-twoRoomPoss cond1 cond2 f = Placement (useRoomPos cond1) PutNothing Nothing
+twoRoomPoss cond1 cond2 f = Placement (roomPosBool cond1) PutNothing Nothing
-    $ \pl1 -> Just $ Placement (useRoomPos cond2) PutNothing Nothing
+    $ \pl1 -> Just $ Placement (roomPosBool cond2) PutNothing Nothing
     $ \pl2 -> Just $ f (_plSpot pl1) (_plSpot pl2)
 
-useUnusedLink :: PlacementSpot
-useUnusedLink = PSPos unusedLnkToPS (const id) Nothing
-
-useRoomPos :: (RoomPos -> Bool) -> PlacementSpot
-useRoomPos cond = PSPos (useRoomPosCond cond) (const id) Nothing
-
 isUnusedLnk :: RoomPos -> Bool
 isUnusedLnk rp = case _rpLinkStatus rp of
     UnusedLink {} -> _rpPlacementUse rp == 0
     _ -> False
 
+useUnusedLnk :: PlacementSpot
+useUnusedLnk = roomPosBool isUnusedLnk
+
 isUsedLnkUnplaced :: RoomPos -> Bool
 isUsedLnkUnplaced  rp = case _rpLinkStatus rp of
     UsedOutLink {} -> _rpPlacementUse rp == 0
-    UsedInLink {} -> _rpPlacementUse rp == 0
+    UsedInLink  {} -> _rpPlacementUse rp == 0
     _ -> False
 
-useRoomPosCond :: (RoomPos -> Bool)
+useRoomPosCond :: (RoomPos -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
-    -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
 useRoomPosCond t rp _
     | t rp = Just (PS p a, rp & rpPlacementUse +~ 1)
     | otherwise = Nothing
@@ -111,33 +105,33 @@ useRoomPosCond t rp _
     p = _rpPos rp
     a = _rpDir rp
 
+useRoomPosRoomCond :: (RoomPos -> Room -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
+useRoomPosRoomCond t rp r
+    | t rp r = Just (PS p a, rp & rpPlacementUse +~ 1)
+    | otherwise = Nothing
+  where
+    p = _rpPos rp
+    a = _rpDir rp
+
 unusedLnkToPS :: RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
 unusedLnkToPS = useRoomPosCond $ \rp -> case _rpLinkStatus rp of
     UnusedLink {} -> True
     _ -> False
 
-usedInLnkToPS :: RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
+--usedInLnkToPS :: RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
-usedInLnkToPS = useRoomPosCond $ \rp -> case _rpLinkStatus rp of
+--usedInLnkToPS = useRoomPosCond $ \rp -> case _rpLinkStatus rp of
-    UsedInLink {} -> True
+--    UsedInLink {} -> True
-    _ -> False
+--    _ -> False
 
 isUnusedLinkType :: RoomLinkType -> RoomPos -> Bool
 isUnusedLinkType rlt rp = case _rpLinkStatus rp of
     UnusedLink{_rplsType = rlts} -> rlt `S.member` rlts
     _ -> False
 
--- TODO unify this with other xSpotNear/FarLink
 unusedSpotNearInLink :: Float -> PlacementSpot
-unusedSpotNearInLink x = PSPos f (const id) Nothing
+unusedSpotNearInLink x = roomPosRoomBool $ \rp r -> _rpLinkStatus rp == NotLink
-  where
+    && _rpPlacementUse rp == 0 
-    f rp r 
+    && any ( (<x) . dist (_rpPos rp) ) (usedRoomInLinkPoss r)
-        | _rpLinkStatus rp == NotLink 
-            && _rpPlacementUse rp == 0 
-            && any ( (<x) . dist p ) (usedRoomInLinkPoss r)
-                    = Just $ (PS p (_rpDir rp), rp & rpPlacementUse +~ 1)
-        | otherwise = Nothing
-      where
-        p = _rpPos rp
 
 usedRoomInLinkPoss :: Room -> [Point2]
 usedRoomInLinkPoss r = mapMaybe f $ _rmPos r
@@ -154,21 +148,8 @@ usedRoomLinkPoss r = mapMaybe f $ _rmPos r
         UsedOutLink {} -> Just $ _rpPos rp
         _ -> Nothing
 
--- TODO rename to any unused link facing out
--- note this can REUSE unused links
-anyLnkOutPS :: PlacementSpot
-anyLnkOutPS = PSPos f (const id) Nothing
-  where
-    f rp _ = case _rpLinkStatus rp of
-        UnusedLink {} -> Just (PS (_rpPos rp) (_rpDir rp), rp & rpPlacementUse +~ 1)
-        _ -> Nothing
-    
 atFstLnkOut :: PlacementSpot
-atFstLnkOut = PSPos f (const id) Nothing
+atFstLnkOut = roomPosBool $ \rp -> rp ^? rpLinkStatus . rplsChildNum == Just 0
-  where
-    f rp _ = case _rpLinkStatus rp of
-        UsedOutLink {_rplsChildNum = 0} -> Just (PS (_rpPos rp) (_rpDir rp), rp & rpPlacementUse +~ 1)
-        _ -> Nothing
 
 atNthLnkOutShiftBy :: Int -> ((Point2,Float) -> (Point2,Float)) -> PlacementSpot
 atNthLnkOutShiftBy n theshift = PSPos f (const id) Nothing
@@ -186,30 +167,22 @@ atFstLnkOutShiftBy = atNthLnkOutShiftBy 0
 atFstLnkOutShiftInward :: Float -> PlacementSpot
 atFstLnkOutShiftInward = atNthLnkOutShiftInward 0
 
-atNthLnkOutShiftInward ::Int -> Float -> PlacementSpot
+atNthLnkOutShiftInward :: Int -> Float -> PlacementSpot
 atNthLnkOutShiftInward n x = atNthLnkOutShiftBy n f
   where
     f (p,a) = (p +.+ rotateV a (V2 0 (negate x)),a)
 
--- does not change the placement use count
+--anyLnkInPS :: Float -- ^ amount to shift inward
-overFstLnkOut :: PlacementSpot
+--    -> PlacementSpot
-overFstLnkOut = PSPos f (const id) Nothing
+--anyLnkInPS x = PSPos f (const id) Nothing
-  where
+--  where
-    f rp _ = case _rpLinkStatus rp of
+--    f rp _ = case _rpLinkStatus rp of
-        UsedOutLink {_rplsChildNum = 0} -> Just (PS (_rpPos rp) (_rpDir rp), rp)
+--        UnusedLink {} -> Just (PS v' a', rp & rpPlacementUse +~ 1)
-        _ -> Nothing
+--        _ -> Nothing
-
+--      where
-anyLnkInPS :: Float -- ^ amount to shift inward
+--        a = _rpDir rp
-    -> PlacementSpot
+--        v' = _rpPos rp -.- x *.* unitVectorAtAngle (a + 0.5 * pi)
-anyLnkInPS x = PSPos f (const id) Nothing
+--        a' = a + pi
-  where
-    f rp _ = case _rpLinkStatus rp of
-        UnusedLink {} -> Just (PS v' a', rp & rpPlacementUse +~ 1)
-        _ -> Nothing
-      where
-        a = _rpDir rp
-        v' = _rpPos rp -.- x *.* unitVectorAtAngle (a + 0.5 * pi)
-        a' = a + pi
 
 -- this should probably check the placement use, but so should others: should
 -- unify these

src/Dodge/Room/Door.hs

@@ -34,7 +34,7 @@ switchDoorRoom = defaultRoom
     , _rmLinks = init lnks++ [last lnks]
     , _rmPath  = [(V2 20 35,V2 20 5)]
     , _rmPartPmnt = Just f
--- door extends into side walls (for shadows as rendered 12/03)
+-- door extends into side walls (for shadows as rendered 12/03/21)
 -- note no bounds
     }
   where 

src/Dodge/Room/LasTurret.hs

@@ -59,11 +59,12 @@ lightSensByDoor rm = rm
     & rmPmnts .++~ 
         [ psPt atFstLnkOut $ PutShape $ colorSH yellow 
             $ barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80)
-        , heightWallPS (atNthLnkOutShiftInward 1 100) 30 (rectNSEW 10 (-10) 20 (-20))
+        , heightWallPS (atNthLnkOutShiftInward 1 100) 30 covershape
-        , heightWallPS (atFstLnkOutShiftInward 100)   30 (rectNSEW 10 (-10) 20 (-20))
+        , heightWallPS (atFstLnkOutShiftInward 100)   30 covershape
         ]
     & rmExtPmnt ?~ lasSensLightAboveDoor 20 (atFstLnkOutShiftBy sensorshift)
   where
+    covershape = rectNSEW 10 (-10) 20 (-20)
     sensorshift (p,a) = (p +.+ rotateV a (V2 60 (-20)), a)
 
 lasSensorTurretTest :: RandomGen g => Int -> State g (SubCompTree Room)

src/Dodge/Room/LongDoor.hs

@@ -75,9 +75,7 @@ twinSlowDoorRoom w h x = defaultRoom
 
 twinSlowDoorChasers :: RandomGen g => State g Room
 twinSlowDoorChasers = do
-    let lps = V2 (-65) <$> [20,40 .. 180]
+    ps <- takeN 4 $ [ V2 x y | x <- [-65,65], y <- [20,40 .. 180] ]
-        rps = V2 65 <$> [20,40 .. 180]
-    ps <- takeN 4 $ lps ++ rps
     let plmnts = map (\p -> sPS p 0 $ PutCrit chaseCrit) ps
     return $ twinSlowDoorRoom 80 200 40 & rmPmnts %~ (plmnts ++)
 
@@ -116,7 +114,7 @@ addButtonSlowDoor x h rm = do
         $ amountedlight dr1 (-50)
         $ amountedlight dr2   50
         $ amountedlight dr2 (-50)
-        $ Nothing
+         Nothing
     getdoorpos drid w = let Just (a,b) = w ^? doors . ix drid . drPos
         in (b, argV (a-.-b))
     butPosCond = useRoomPosCond $ \rp -> isUnusedLnk rp && yV2 (_rpPos rp) < 0.5 * h 

src/Dodge/Room/Procedural.hs

@@ -1,5 +1,4 @@
-{- | 
+{- | Procedural creation of rooms and subroom parts.  -}
- Procedural creation of rooms and subroom parts.  -}
 module Dodge.Room.Procedural
     ( roomRect
     , roomRectAutoLinks
@@ -74,24 +73,35 @@ roomRect x y xn yn = defaultRoom
     wlnks = 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 nlnks
+    lnks = m North FromWest FromEast nlnks
-        ++ m East FromSouth elnks
+        ++ m East FromSouth FromNorth elnks
-        ++ m West FromSouth wlnks
+        ++ m West FromSouth FromNorth wlnks
-        ++ m South FromWest slnks
+        ++ m South FromWest FromEast slnks
-    m edge edgefrom = zipWith (lnkBothAnd' (OnEdge edge) edgefrom) [0..]
+    m edge edgefrom1 edgefrom2 = zipWith (lnkBothAnd' (OnEdge edge) edgefrom1 edgefrom2) [0..]
+        . zipCountDown
     pth  = linksAndPath' lnks $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn)
     posps = map (+.+ V2 20 20) $ gridPoints xd (xn+1) yd (yn+1)
     interposps = map (+.+ V2 (20 + xd/2) (20 + yd/2)) $ gridPoints xd xn yd yn
+
+zipCountDown :: [a] -> [(Int,a)]
+zipCountDown xs = zip [length xs - 1, length xs - 2 ..] xs
+
+lnkBothAnd' :: RoomLinkType -> (Int -> RoomLinkType) 
+    -> (Int -> RoomLinkType)
+    -> Int -> (Int,(Point2,Float)) -> RoomLink
+lnkBothAnd' rlt ltcon ltcon2 i (j,(p,a)) = RoomLink 
+    {_rlType = S.fromList [OutLink,InLink,rlt,ltcon i,ltcon2 j]
+    ,_rlPos = p 
+    , _rlDir = 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 xn yn)
+roomRectAutoLinks x y = (roomRect x y (f x) (f y)) {_rmPmnts = plmnts}
-    {_rmPmnts = plmnts}
   where
-    xn = max 1 $ (ceiling x - 40) `div` 60
+    f z = max 1 $ (ceiling z - 40) `div` 60
-    yn = max 1 $ (ceiling y - 40) `div` 60
+    plmnts = replicate 3 . mntLightLnkCond $ useRoomPosCond isUsedLnkUnplaced
-    plmnts = replicate 3 (mntLightLnkCond $ useRoomPosCond isUsedLnkUnplaced)
 {- Combines two rooms into one room.
  - will have to work out exactly what to do with combining links
 Mostly involves concatenation.  -}
@@ -126,7 +136,7 @@ quarterRoomTri w = do
         [   [ mntLS vShape (V2 0 w) (V3 0 (w-20) 70)
             , blockLine (V2 (w/2) (w/2)) (V2 (w/2) w)
             ]
-        ,   [blockLine (V2 (w/2) (w/2)) (V2 (negate $ w/2) (w/2))]
+        ,   [ blockLine (V2 (w/2) (w/2)) (V2 (negate $ w/2) (w/2))]
         ,   [ blockLine (V2 (w/2) (w/2)) (V2 0 (w/2))
             , blockLine (V2 (-29) w) (V2 0 (w/2))
             ]
@@ -142,10 +152,7 @@ quarterRoomTri w = do
             ,(V2 0 (w-20),V2 0 0)
             ,(V2 (55-w) (w-20),V2 0 0)
             ]
-        , _rmPmnts  = b ++ [ mntLS iShape (V2 (w-20) w) (V3 (w-20) (w-20) 70)
+        , _rmPmnts  = b ++ [ mntLS iShape (V2 (w-20) w) (V3 (w-20) (w-20) 70) ]
-            , sPS (V2 (w-20) (w-20)) pi PutNothing 
-            , sPS (V2 (w-15) (w-25)) pi PutNothing 
-            ]
         , _rmPos = 
             [ RoomPos (V2 (w-20) (w-20)) pi S.empty NotLink 0
             , RoomPos (V2 (w-15) (w-25)) pi S.empty NotLink 0
@@ -167,9 +174,9 @@ quarterRoomSquare w = do
         ]
     pure $ defaultRoom
         { _rmPolys  = [ map toV2 [(0,0),(w,w),(0,2*w),(-w,w)] ]
-        , _rmLinks  = 
+        , _rmLinks  = map toBothLnk
-            [toBothLnk (V2 (w/2) (3*w/2), negate $ pi/4)
+            [ (V2 (w/2) (3*w/2), negate $ pi/4)
-            ,toBothLnk (V2 (negate $ w/2) (3*w/2), pi/4)
+            , (V2 (negate $ w/2) (3*w/2), pi/4)
             ]
         , _rmPath   = concatMap doublePair
             [(V2 (0.5*w) (1.5*w),V2 (0.5*w-20) (1.5*w-20))
@@ -183,15 +190,9 @@ quarterRoomSquare w = do
             ,(V2 0 0,V2 0 (w-40))
 --            ,(V2 (20-w) (w-20),V2 (40-w) (w))
             ]
-        , _rmPmnts = b ++
+        , _rmPmnts = b ++ [ blockLine (V2 (w/2) (w/2)) (V2 0 w) ]
-            [ blockLine (V2 (w/2) (w/2)) (V2 0 w)
+        , _rmPos = [ RoomPos p pi S.empty NotLink 0 
-            , sPS (V2 20 (2*w-40)) pi PutNothing
+                    | p <- [V2 20 (2*w-40),V2 25 (2*w-45)] ]
-            , sPS (V2 25 (2*w-45)) pi PutNothing
-            ]
-        , _rmPos = 
-                [ RoomPos (V2 20 (2*w-40)) pi S.empty NotLink 0
-                , RoomPos (V2 25 (2*w-45)) pi S.empty NotLink 0
-                ]
         , _rmBound = [map toV2 [(w,w),(0,2*w),(-w,w)]]
         }
 {- | Randomise the ordering of placements in a room.

src/Dodge/Room/RunPast.hs

@@ -57,7 +57,7 @@ runPastRoom i = do
     let linkcor = critRoom & rmPmnts .~ [ spanLS thels (V2 0 65) (V2 40 65) ]
         critroom = linkcor & rmPmnts .:~ plRRpt 0 randC1
         aswitchroom = corridorWallN
-            {_rmExtPmnt = Just $ putLitButOnPosExtTrig red useLnkRoomPos
+            {_rmExtPmnt = Just $ putLitButOnPosExtTrig red useUnusedLnk
             ,_rmLabel = Just i
             ,_rmPmnts = []
             }

src/Dodge/Room/Start.hs

@@ -5,6 +5,7 @@ import Dodge.LevelGen.Data
 import Dodge.Room.RunPast
 import Dodge.Room.Tanks
 import Dodge.Room.Containing
+import Dodge.Room.LongDoor
 --import Dodge.RoomLink
 --import Dodge.Data
 --import Dodge.Default
@@ -65,6 +66,7 @@ randomChallenges :: RandomGen g => State g (SubCompTree Room)
 randomChallenges = join $ takeOne
     [fmap (return . UseAll) doubleCorridorBarrels
     ,shootingRange
+    ,fmap (return . UseAll) twinSlowDoorChasers
     ]
 
 runPastStart :: RandomGen g => Int -> State g (SubCompTree Room)

src/Dodge/RoomLink.hs

@@ -1,4 +1,26 @@
-module Dodge.RoomLink where
+module Dodge.RoomLink 
+    ( muout
+    , muin
+    , outLink
+    , inLink
+    , restrictLinkType
+    , overLnkType
+    , lnkPosDir
+    , overLnkPosDir
+    , toBothLnk
+    , rmInLinks
+    , rmOutLinks
+    , setOutLinksPD
+    , setOutLinksByType
+    , setInLinksPD
+    , restrictOutLinks
+    , restrictInLinks
+    , setInLinks
+    , setInLinksByType
+    , setLinkType
+    , getLinksOfType
+    , swapInOutLinks
+    ) where
 import Dodge.LevelGen.Data
 import Geometry
 
@@ -21,12 +43,6 @@ restrictInLinks = over rmLinks . restrictLinkType InLink
 restrictOutLinks :: ((Point2,Float) -> Bool) -> Room -> Room
 restrictOutLinks f = rmLinks %~ restrictLinkType OutLink f
 
-addLabelLink :: Int -> (RoomLink -> Bool) -> [RoomLink] -> [RoomLink]
-addLabelLink i t = map f
-  where
-    f rl | t rl = rl & rlType %~ S.insert (LabLink i)
-         | otherwise = rl
-
 setOutLinks :: (RoomLink -> Bool) -> [RoomLink] -> [RoomLink]
 setOutLinks = setLinkType OutLink
 
@@ -93,24 +109,11 @@ inLink p a = RoomLink
     ,_rlPos = p 
     , _rlDir = a
     }
-lnkBothAnd :: RoomLinkType -> (Point2,Float) -> RoomLink
-lnkBothAnd rlt (p,a) = RoomLink 
-    {_rlType = S.fromList [OutLink,InLink,rlt]
-    ,_rlPos = p 
-    , _rlDir = a
-    }
-
-lnkBothAnd' :: RoomLinkType -> (Int -> RoomLinkType) -> Int -> (Point2,Float) -> RoomLink
-lnkBothAnd' rlt ltcon i (p,a) = RoomLink 
-    {_rlType = S.fromList [OutLink,InLink,rlt,ltcon i]
-    ,_rlPos = p 
-    , _rlDir = a
-    }
 
 toBothLnk :: (Point2,Float) -> RoomLink
 toBothLnk (p,a) = RoomLink 
-    {_rlType = S.fromList [OutLink,InLink]
+    { _rlType = S.fromList [OutLink,InLink]
-    ,_rlPos = p 
+    , _rlPos = p 
     , _rlDir = a
     }
 muout :: [(Point2,Float)] -> [RoomLink]