Cleanup

src/Dodge/Room/Modify/Girder.hs

@@ -2,6 +2,7 @@ module Dodge.Room.Modify.Girder
     ( addGirderLights
     , addGirderFrom
     , addHighGirder
+    , addHighGirder'
     , addGirderEW
     , addGirderNS
     , addGirderNS'
@@ -88,6 +89,22 @@ addGirder shapef col room = do
             $ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) 
             | i <- [1 .. numlnks - 2] ]
 
+addGirder' :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room
+addGirder' shapef col room = do
+    let nslnks = length $ filter ((OnEdge North `S.member`) . _rlType) $ _rmLinks room
+        ewlnks = length $ filter ((OnEdge East `S.member`) . _rlType) $ _rmLinks room
+        nsgirds = girdson (FromEdge East) nslnks
+        ewgirds = girdson (FromEdge North) ewlnks
+    girders <- shuffle $ nsgirds ++ ewgirds
+    return $ room & rmPmnts .:~ foldr1 setFallback 
+        (sps0 PutNothing : girders)
+  where
+    girdson f numlnks = [ twoRoomPoss
+            (isUnusedLnkType (f i))
+            (isUnusedLnkType (f i))
+            $ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) 
+            | i <- [0 .. numlnks - 1] ]
+
 addHighGirder :: RandomGen g => Room -> State g Room
 addHighGirder r = do
     gsize <- takeOne [(20,10),(30,10),(40,10),(30,15)]
@@ -95,6 +112,13 @@ addHighGirder r = do
             [girder, girderZ, girderV]
     addGirder hgshape black r
 
+addHighGirder' :: RandomGen g => Room -> State g Room
+addHighGirder' r = do
+    gsize <- takeOne [(20,10),(30,10),(40,10),(30,15)]
+    hgshape <- takeOne $ map (\f -> uncurry (f 96) gsize)
+            [girder, girderZ, girderV]
+    addGirder' hgshape black r
+
 randomLightPositions :: RandomGen g => Room -> State g [(Int,Int)]
 randomLightPositions rm = do
     let rmtype = _rmType rm