From 28a002eb0865e079dafad0f012d00bf877435da1 Mon Sep 17 00:00:00 2001
From: justin <justin.g.kruger@gmail.com>
Date: Thu, 2 Jun 2022 22:50:42 +0100
Subject: [PATCH] Generalise link effects

---
 src/Dodge/Data.hs            | 12 ++++++++----
 src/Dodge/Default/Room.hs    |  2 +-
 src/Dodge/Room/SensorDoor.hs |  5 +++--
 src/Dodge/Tree/Shift.hs      | 10 +++++-----
 4 files changed, 17 insertions(+), 12 deletions(-)

diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs
index 69c39069f..614b2f5c8 100644
--- a/src/Dodge/Data.hs
+++ b/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]
diff --git a/src/Dodge/Default/Room.hs b/src/Dodge/Default/Room.hs
index 7178e4235..13c5363cb 100644
--- a/src/Dodge/Default/Room.hs
+++ b/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  = []
diff --git a/src/Dodge/Room/SensorDoor.hs b/src/Dodge/Room/SensorDoor.hs
index 5c006e5a2..03c126a06 100644
--- a/src/Dodge/Room/SensorDoor.hs
+++ b/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
diff --git a/src/Dodge/Tree/Shift.hs b/src/Dodge/Tree/Shift.hs
index 01b018669..4ef378c33 100644
--- a/src/Dodge/Tree/Shift.hs
+++ b/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