Commit before generalising FromWest/South etc

src/Dodge/Room/Modify/Girder.hs

@@ -1,8 +1,11 @@
 module Dodge.Room.Modify.Girder 
     ( addGirderLights
+    , addGirderFrom
     , addHighGirder
     , addGirderEW
     , addGirderNS
+    , addGirderNS'
+    , addGirderFromWest
     ) where
 --import Dodge.Data
 import Dodge.LevelGen.Data
@@ -36,6 +39,43 @@ addGirderNS shapef col room = do
             $ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) 
        | i <- girderPosOrder]
         )
+-- this can be cleaned up
+addGirderFromWest :: RandomGen g => Int -> (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room
+addGirderFromWest fromwesti shapef col room = do
+    let nwestlnks = length $ filter ((OnEdge North `S.member`) . _rlType) $ _rmLinks room
+    girderPosOrder <- shuffle [0 .. nwestlnks - 1]
+    return $ room & rmPmnts .:~ foldr1 setFallback 
+        (sps0 PutNothing : [ twoRoomPoss 
+            (isUnusedLnkType (FromWest i)) 
+            (isUnusedLnkType (FromWest i)) 
+            $ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) 
+       | i <- [fromwesti]]
+        )
+
+addGirderFrom :: RandomGen g => CardinalPoint -> Int 
+    -> (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room
+addGirderFrom cp fromwesti shapef col room = do
+    let nwestlnks = length $ filter ((OnEdge North `S.member`) . _rlType) $ _rmLinks room
+    girderPosOrder <- shuffle [0 .. nwestlnks - 1]
+    return $ room & rmPmnts .:~ foldr1 setFallback 
+        (sps0 PutNothing : [ twoRoomPoss 
+            (isUnusedLnkType (FromWest i)) 
+            (isUnusedLnkType (FromWest i)) 
+            $ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) 
+       | i <- [fromwesti]]
+        )
+-- | Allows girder to be on edge
+addGirderNS' :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room
+addGirderNS' shapef col room = do
+    let nwestlnks = length $ filter ((OnEdge North `S.member`) . _rlType) $ _rmLinks room
+    girderPosOrder <- shuffle [0 .. nwestlnks - 1]
+    return $ room & rmPmnts .:~ foldr1 setFallback 
+        (sps0 PutNothing : [ twoRoomPoss 
+            (isUnusedLnkType (FromWest i)) 
+            (isUnusedLnkType (FromWest i)) 
+            $ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) 
+       | i <- girderPosOrder]
+        )
 addGirderEW :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room
 addGirderEW shapef col room = do
     let nwestlnks = length $ filter ((OnEdge West `S.member`) . _rlType) $ _rmLinks room