Tweak longRoom

src/Dodge/Room/LongRoom.hs

@@ -5,7 +5,7 @@ import Dodge.Tree
 import Dodge.Default.Wall
 import Dodge.LevelGen.Data
 import Dodge.Placement.Instance
---import Dodge.Room.Link
+import Dodge.Room.Link
 import Dodge.Room.Door
 import Dodge.Room.Corridor
 import Dodge.Room.Procedural
@@ -32,7 +32,6 @@ longRoom :: RandomGen g => State g Room
 longRoom = do
     h <- state $ randomR (1500,1500)
     let w = 75
-    let cond x = (sndV2 . fst) x < h - 40
     let wlsNSEWs wln wls listew = [sps0 $ PutWall (rectNSWE wln wls wallw walle) defaultCrystalWall
             | (wallw,walle) <- listew ]
     let ws = wlsNSEWs (h-35) (h-135) [(-10,10) , (15,35) , (40,60) , (65,85)]
@@ -40,9 +39,11 @@ longRoom = do
     brlN <- state $ randomR (0,5)
     brlOffsets <- replicateM brlN $ randInRect (w-20) 900
     let brls = [ sPS (p +.+ V2 10 200) 0 $ PutCrit explosiveBarrel | p <- brlOffsets ]
-    let rm = roomRect w (h+70) 1 1 & rmPolys .++~ [rectNSWE h (h-165) (-45) (w+45)]
+    rm <- shuffleLinks $ roomRect w (h+70) 1 1 & rmPolys .++~ [rectNSWE h (h-165) (-45) (w+45)]
             & rmFloor .~ InheritFloor
-    return $ restrictInLinks cond $ rm & rmPmnts .~ ws ++ brls ++ wsDefense ++
+    return $ restrictInLinks (\x -> (sndV2 . fst) x < 40) 
+        $ restrictOutLinks (\x -> (sndV2 . fst) x > h * 0.75)
+        $ rm & rmPmnts .~ ws ++ brls ++ wsDefense ++
         [sPS (V2 crx (h-25)) 0 $ PutCrit longCrit
                 | crx <- [12.5,37.5,62.5] ] ++
         [sPS (V2 25 lampy ) 0 putLamp | lampy <- [20,h-10] ]