Allow for more complex placement positioning

src/Dodge/RoomLink.hs

@@ -9,8 +9,11 @@ import Control.Lens
 restrictLinkType :: RoomLinkType -> ((Point2,Float) -> Bool) -> [RoomLink] -> [RoomLink]
 restrictLinkType rlt f = map g
   where
-    g rl | f $ rlPosDir rl  = rl & rlType %~ S.delete rlt
-         | otherwise        = rl
+    g rl | f $ rlPosDir rl  = rl
+         | otherwise        = rl & rlType %~ S.delete rlt
+
+getLinksOfType :: RoomLinkType -> [RoomLink] -> [RoomLink]
+getLinksOfType lt = filter (S.member lt . _rlType)
 
 restrictInLinks :: ((Point2,Float) -> Bool) -> Room -> Room
 restrictInLinks f = rmLinks %~ restrictLinkType InLink f
@@ -18,17 +21,26 @@ restrictInLinks f = rmLinks %~ restrictLinkType InLink f
 restrictOutLinks :: ((Point2,Float) -> Bool) -> Room -> Room
 restrictOutLinks f = rmLinks %~ restrictLinkType OutLink f
 
-setLinkType :: RoomLinkType -> ((Point2,Float) -> Bool) -> [RoomLink] -> [RoomLink]
+setInLinks :: (RoomLink -> Bool) -> [RoomLink] -> [RoomLink]
+setInLinks = setLinkType InLink
+
+setLinkType :: RoomLinkType -> (RoomLink -> Bool) -> [RoomLink] -> [RoomLink]
 setLinkType rlt f = map g
   where
-    g rl | f $ rlPosDir rl  = rl & rlType %~ S.delete rlt
-         | otherwise        = rl & rlType %~ S.insert rlt
-setInLinks :: ((Point2,Float) -> Bool) -> Room -> Room
-setInLinks f = rmLinks %~ setLinkType InLink f
+    g rl | f rl  = rl & rlType %~ S.insert rlt
+         | otherwise        = rl & rlType %~ S.delete rlt
 
-setOutLinks :: ((Point2,Float) -> Bool) -> Room -> Room
-setOutLinks f = rmLinks %~ setLinkType OutLink f
+setLinkTypePD :: RoomLinkType -> ((Point2,Float) -> Bool) -> [RoomLink] -> [RoomLink]
+setLinkTypePD rlt f = map g
+  where
+    g rl | f $ rlPosDir rl  = rl & rlType %~ S.insert rlt
+         | otherwise        = rl & rlType %~ S.delete rlt
 
+setInLinksPD :: ((Point2,Float) -> Bool) -> Room -> Room
+setInLinksPD f = rmLinks %~ setLinkTypePD InLink f
+
+setOutLinksPD :: ((Point2,Float) -> Bool) -> Room -> Room
+setOutLinksPD f = rmLinks %~ setLinkTypePD OutLink f
 
 swapInOutLinks :: Room -> Room
 swapInOutLinks = rmLinks %~ map (rlType %~ S.map f)
@@ -66,6 +78,12 @@ 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
+    }
 
 toBothLnk :: (Point2,Float) -> RoomLink
 toBothLnk (p,a) = RoomLink