61 lines
2.1 KiB
Haskell
61 lines
2.1 KiB
Haskell
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)
|
|
]
|
|
)
|