Tweak room modification when creating link

src/Dodge/Data.hs

@@ -1393,7 +1393,6 @@ data Placement
         { _plSpot   :: PlacementSpot
         , _plType   :: PSType
         , _plMID    :: Maybe Int
---        , _plGenUpdate :: Maybe (GenParams -> Placement -> (GenParams, Placement) )
         , _plIDCont :: World -> Placement -> Maybe Placement 
         }
     | PlacementUsingPos Point3 (Point3 -> Placement)  -- allows a placement to use a shifted position
@@ -1413,7 +1412,7 @@ data Room = Room
     --, _rmOutLinks      :: [RoomLink]
     --, _rmInLinks      :: [RoomLink]
         -- update the room when assigning the next link to an adjacent room with the head of of this list, return the tail
-    , _rmLinkEff    :: [(Point2,Float) -> Room -> Room]
+    , _rmLinkEff    :: [RoomLink -> Room -> Room]
     , _rmPos        :: [RoomPos]
     , _rmPath       :: [(Point2, Point2)]
     , _rmPmnts      :: [Placement]
@@ -1457,6 +1456,7 @@ data RoomLinkType
     | FromNorth Int
     | FromWest Int
     | FromEast Int
+    | BlockedLink
     deriving (Eq,Ord,Show)
 data CardinalPoint
     = North

src/Dodge/Room/SensorDoor.hs

@@ -35,19 +35,32 @@ import Data.Char
 import Control.Monad.State
 import System.Random
 
+-- TODO fix case where the sensor created by sensInsideDoor blocks another door
+-- for roomRectAutoLinks-- make the locked door a center door?
 sensorRoom :: RandomGen g => DamageType -> Int -> State g (SubCompTree Room)
 sensorRoom senseType n = do
     rm <- takeOne [roomNgon 8 200, roomRectAutoLinks 200 200]
     cenroom <- shuffleLinks $ sensInsideDoor senseType n rm
     let doorroom = triggerDoorRoom n
-    return $ treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door)
+    return $ treeFromPost [PassDown door,PassDown $ cenroom & rmLinkEff .~ [f,f],PassDown doorroom] (UseAll door)
+  where
+    f rl rm = rm & rmLinks %~ map (g (_rlPos rl) (_rlDir rl))
+    g p d rl
+        | isclose = rl & rlType . at BlockedLink ?~ ()
+        | otherwise = rl
+      where
+        p' = p +.+ rotateV d (V2 0 (negate 100))
+        isclose = dist (_rlPos rl) p' < 30
 
 sensorRoomRunPast :: RandomGen g => DamageType -> Int -> State g (LabSubCompTree Room)
 sensorRoomRunPast dt n = do
     t <- sensorRoom dt n
     return (applyToSubforest [0] (++
-        [treeFromPost [PassDown $ door & rmConnectsTo .~ S.member InLink
-        ] (UseLabel 0 corridor)]
+        [treeFromPost 
+            [PassDown $ door & rmConnectsTo 
+                .~ (\s -> S.member InLink s && not (S.member BlockedLink s))
+            ] (UseLabel 0 corridor)
+        ]
         ) t 
         ,TreeSubLabelling "sensorRoomRunPast" Nothing)
         --[return $ UseLabel 0 $ door & rmConnectsTo .~ S.member InLink]

src/Dodge/Tree/Shift.hs

@@ -13,7 +13,7 @@ import Dodge.Room.Link
 import Dodge.Tree.Polymorphic
 import Dodge.RoomLink
 import Geometry.ConvexPoly
-import Geometry.Data
+--import Geometry.Data
 import Padding
 import LensHelp hiding (Empty, (<|) , (|>))
 --import Control.Lens hiding (Empty, (<|) , (|>))
@@ -78,7 +78,7 @@ posRms prs parenti@(parent,_) ( (numChild,t@(Node childi _) ):its) tseq = do
           where
             newBounds = map pointsToPoly . _rmBound . doRoomShift . fst $ rootLabel shiftedt
             clipping = or (convexPolysOverlap <$> newBounds <*> _prBounds prs)
-            updateparent rm = doLnkEff (lnkPosDir outlnk) $ rm 
+            updateparent rm = doLnkEff outlnk $ rm 
                 & rmLinks    %~ delete outlnk 
                 & rmPos      .:~ RoomPos
                     { _rpPos = fst (lnkPosDir outlnk)
@@ -151,7 +151,7 @@ printInfoCheckNum (parentrm,parenti) childn (childrm,childi) = printPartialColum
         0 -> _rmName parentrm ++ "-" ++ show parenti
         _ -> ""
 
-doLnkEff :: (Point2,Float) -> Room -> Room
+doLnkEff :: RoomLink -> Room -> Room
 doLnkEff x rm = case _rmLinkEff rm of
     (eff:effs) -> eff x $ rm & rmLinkEff .~ effs
     _ -> rm