Improvements to rooms and view distances

src/Dodge/Room/LongRoom.hs

@@ -0,0 +1,60 @@
+module Dodge.Room.LongRoom where
+import Dodge.RoomLink
+import Dodge.Tree
+--import Dodge.Default.Room
+import Dodge.Default.Wall
+import Dodge.LevelGen.Data
+import Dodge.Placement.Instance
+--import Dodge.Room.Link
+import Dodge.Room.Door
+import Dodge.Room.Corridor
+import Dodge.Room.Procedural
+--import Dodge.Layout.Tree.Either
+--import Dodge.LevelGen.Data
+--import Dodge.LevelGen.Switch
+import Dodge.RandomHelp
+import Dodge.Creature.Inanimate
+import Dodge.Creature
+--import Dodge.LightSource
+--import Picture
+import Geometry
+import LensHelp
+import Data.Tile
+
+import qualified Data.Set as S
+import Data.Tree
+import System.Random
+import Control.Monad.State
+--import Data.Tree
+--import qualified Data.IntMap as IM
+
+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)]
+    let wsDefense = wlsNSEWs 95 70 [(0,25) , (50,75) ]
+    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)]
+            & rmFloor .~ InheritFloor
+    return $ restrictInLinks cond $ 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] ]
+
+longRoomRunPast :: RandomGen g => State g (SubCompTree Room)
+longRoomRunPast = do
+    r <- longRoom
+    return $ treeFromTrunk [PassDown door]
+        (Node (PassDown r)
+            [ singleUseAll door
+            --, return (UseLabel 0 $ door & rmConnectsTo .~ S.singleton InLink)
+            , treeFromPost [PassDown $ corridor & rmConnectsTo .~ S.singleton InLink, PassDown corridor] 
+                (UseLabel 0 $ door)
+            ]
+        )