Generalise link effects

src/Dodge/Data.hs

@@ -1409,10 +1409,14 @@ assigning no bounds will allow rooms to overlap.  -}
 data Room = Room
     { _rmPolys      :: [ [Point2] ]
     , _rmLinks      :: [RoomLink]
-    --, _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    :: [RoomLink -> Room -> Room]
+    --  the Int is the number of previous outlinks that have been assigned
+    , _rmLinkEff    
+        :: RoomLink -- ^ child link
+        -> Room     -- ^ child room
+        -> Int      -- ^ child number
+        -> RoomLink -- ^ parent link
+        -> Room     -- ^ parent room
+        -> Room
     , _rmPos        :: [RoomPos]
     , _rmPath       :: [(Point2, Point2)]
     , _rmPmnts      :: [Placement]

src/Dodge/Default/Room.hs

@@ -10,7 +10,7 @@ defaultRoom :: Room
 defaultRoom = Room
     { _rmPolys  = []
     , _rmLinks  = []
-    , _rmLinkEff = []
+    , _rmLinkEff = const . const . const . const id
     , _rmPos    = []
     , _rmPath   = []
     , _rmPmnts  = []

src/Dodge/Room/SensorDoor.hs

@@ -42,9 +42,10 @@ 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 & rmLinkEff .~ [f,f],PassDown doorroom] (UseAll door)
+    return $ treeFromPost [PassDown door,PassDown $ cenroom & rmLinkEff .~ f,PassDown doorroom] (UseAll door)
   where
-    f rl rm = rm & rmLinks %~ map (g (_rlPos rl) (_rlDir rl))
+    f _ _ 0 rl rm = rm & rmLinks %~ map (g (_rlPos rl) (_rlDir rl))
+    f _ _ _ _ rm = rm
     g p d rl
         | isclose = rl & rlType . at BlockedLink ?~ ()
         | otherwise = rl

src/Dodge/Tree/Shift.hs

@@ -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 outlnk $ rm 
+            updateparent rm = _rmLinkEff rm il child numChild 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 :: RoomLink -> Room -> Room
-doLnkEff x rm = case _rmLinkEff rm of
-    (eff:effs) -> eff x $ rm & rmLinkEff .~ effs
-    _ -> rm
+--doLnkEff :: RoomLink -> Room -> Room
+--doLnkEff x rm = case _rmLinkEff rm of
+--    (eff:effs) -> eff x $ rm & rmLinkEff .~ effs
+--    _ -> rm