Work towards allowing for children to attach to arbitrary link types

src/Dodge/Room/Link.hs

@@ -4,22 +4,18 @@ of a position and a rotation.
 The last link in the list is considered the incoming link, the other links are
 the outgoing links.  -}
 module Dodge.Room.Link
-    ( --shiftRoomToLink
-    --, shiftRoomShiftToLink
-     shiftRoomShiftToLink
+    ( shiftRoomShiftToLink
     , shiftRoomBy
     , shiftLinkBy
     , doRoomShift
     , sortOutLinksOn
     , filterSortOutLinksOn
     , randomiseAllLinks
+    , shuffleLinks
     , filterLinks
     , changeLinkTo
     , changeLinkFrom
     , randomiseOutLinks
---    , randomiseLinksBy
-    , invShiftLinkBy
-    --, finalLinksUpdate
     ) where
 import Dodge.Placement.PlaceSpot
 import Dodge.LevelGen.Data
@@ -33,6 +29,7 @@ import Control.Monad.State
 import Control.Lens
 import Data.List
 import qualified Data.Set as S
+
 {- Shuffle the initial links of a room randomly. -}
 randomiseOutLinks :: RandomGen g => Room -> State g Room
 randomiseOutLinks r = do
@@ -56,6 +53,12 @@ randomiseAllLinks :: RandomGen g => Room -> State g Room
 randomiseAllLinks r = do
     newLinks <- shuffle $ _rmLinks r
     return $ r {_rmLinks = newLinks }
+{- Shuffle the order of all links of a room randomly. 
+ - Note this does not change their types. -}
+shuffleLinks :: RandomGen g => Room -> State g Room
+shuffleLinks r = do
+    newLinks <- shuffle $ _rmLinks r
+    return $ r {_rmLinks = newLinks }
 
 --randomiseLinksBy 
 --    :: ( [(Point2,Float)] -> State g [(Point2,Float)] )
@@ -120,14 +123,6 @@ shiftRoomBy shift r = r
         . (tileX    %~ shiftPointBy shift         )
         )
     & rmViewpoints %~ map (shiftPointBy shift)
---shiftRoomShiftToLink :: (Point2,Float) -> Room -> Room
---shiftRoomShiftToLink l r 
---    = shiftRoomShiftBy l 
---    . shiftRoomShiftBy (V2 0 0       , pi-a)  
---    $ shiftRoomShiftBy (V2 0 0 -.- p , 0) 
---    r
---  where 
---    (p,a) = head $ _rmInLinks r
 
 shiftRoomShiftToLink :: (Point2,Float) -> (Point2,Float) -> Room -> Room
 shiftRoomShiftToLink l inlink r 
@@ -150,22 +145,5 @@ shiftLinkBy (pos,rot) = overLnkPosDir f
   where
     f (p,r) = (shiftPointBy (pos,rot) p, r + rot)
 
-invShiftLinkBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float)
-invShiftLinkBy (pos,rot) (p,r) = (invShiftPointBy (pos,rot) p, r - rot)
-
-shiftPathBy  
-    :: (Point2,Float) 
-    -> (Point2,Point2) 
-    -> (Point2,Point2) 
+shiftPathBy  :: (Point2,Float) -> (Point2,Point2) -> (Point2,Point2) 
 shiftPathBy s (p1,p2) = (shiftPointBy s p1, shiftPointBy s p2)
-
---finalLinksUpdate :: Room -> Room
---finalLinksUpdate rm = case _rmInLinks rm of
---    (_:_) -> rm
---        & rmInLinks %~ tail
---        & rmPos %~ ( (uncurry (UsedInLink 0) (lnkPosDir $ head inlnks) :) 
---                    . (map (uncurry UnusedLink . lnkPosDir) (outlnks ++ tail inlnks) ++) )
---    _ -> rm
---  where
---    inlnks = _rmInLinks rm
---    outlnks = _rmOutLinks rm

src/Dodge/Room/LongDoor.hs

@@ -106,7 +106,7 @@ addButtonSlowDoor x h rm = do
        ,( V2 (x/2+50) 5,0::Float)
        ]
     thePlacement <- takeOne [butDoor butPos butRot ]
-    changeLinkFrom aboveH =<< changeLinkTo belowH (rm 
+    shuffleLinks $ setOutLinks aboveH $ setInLinks belowH (rm 
         & rmPmnts %~ (thePlacement :)
         & rmBound %~ (openDoorBound :)
         )