58 lines
1.9 KiB
Haskell
58 lines
1.9 KiB
Haskell
module Dodge.Room.LongRoom where
|
|
|
|
import Control.Monad
|
|
import qualified Data.Set as S
|
|
import Data.Tile
|
|
import Dodge.Cleat
|
|
import Dodge.Creature
|
|
import Dodge.Data.GenWorld
|
|
import Dodge.Default.Wall
|
|
import Dodge.LevelGen.PlacementHelper
|
|
import Dodge.Placement.Instance
|
|
import Dodge.Room.Corridor
|
|
import Dodge.Room.Door
|
|
import Dodge.Room.Link
|
|
import Dodge.Room.Procedural
|
|
import Dodge.RoomLink
|
|
import Dodge.Tree
|
|
import Geometry
|
|
import LensHelp
|
|
import RandomHelp
|
|
|
|
longRoom :: RandomGen g => State g Room
|
|
longRoom = do
|
|
h <- state $ randomR (1500, 1500)
|
|
let w = 75
|
|
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]
|
|
rm <-
|
|
shuffleLinks $
|
|
roomRect w (h + 70) 1 1 & rmPolys .++~ [rectNSWE h (h -165) (-45) (w + 45)]
|
|
& rmFloor .~ InheritFloor
|
|
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]]
|
|
|
|
longRoomRunPast :: RandomGen g => State g (MetaTree Room String)
|
|
longRoomRunPast = do
|
|
r <- longRoom
|
|
rToOnward "longRoomRunPast" $
|
|
treeFromTrunk [door] $
|
|
Node
|
|
r
|
|
[ pure $ cleatOnward door
|
|
, treePost [corridor & rmConnectsTo .~ S.member InLink, cleatLabel 0 door]
|
|
]
|