93 lines
3.2 KiB
Haskell
93 lines
3.2 KiB
Haskell
{- Connecting rooms designed with a pass-through technique in mind. -}
|
|
module Dodge.Room.RoadBlock
|
|
where
|
|
import Geometry
|
|
--import Dodge.Data
|
|
import Dodge.Default.Room
|
|
import Dodge.Room.Data
|
|
import Dodge.Room.Link
|
|
import Dodge.Placements
|
|
import Dodge.Room.Corridor
|
|
import Dodge.Room.Furniture
|
|
import Dodge.LevelGen.Data
|
|
--import Dodge.Default.Wall
|
|
--import Dodge.RandomHelp
|
|
import Dodge.Creature
|
|
import Dodge.Layout.Tree.Polymorphic
|
|
|
|
import Data.Tree
|
|
import Control.Monad.State
|
|
import Control.Lens
|
|
import System.Random
|
|
|
|
armouredCorridor :: RandomGen g => State g Room
|
|
armouredCorridor = fmap (replacePutID 0 [PutCrit $ addArmour autoCrit]) litCorridor90
|
|
|
|
{-
|
|
A corridor of random length with a 90 degree link at the end.
|
|
-}
|
|
litCorridor90 :: RandomGen g => State g Room
|
|
litCorridor90 = do
|
|
h <- state $ randomR (500,800)
|
|
let poly = rectNSWE h 0 0 40
|
|
poly2 = rectNSWE (h-60) (h-100) (-60) 5
|
|
pure $ defaultRoom
|
|
{ _rmPolys = [poly,poly2]
|
|
, _rmLinks = [ (V2 40 (h - 80), -pi/2)
|
|
, (V2 20 0 , pi )
|
|
]
|
|
, _rmPath = concatMap doublePair
|
|
[( V2 20 0 , V2 20 (h-40) )
|
|
,( V2 0 (h-40) , V2 20 (h-40) )
|
|
,( V2 40 (h-40) , V2 20 (h-40) )
|
|
]
|
|
, _rmPmnts =
|
|
[ sPS (V2 20 (h-5)) 0 putLamp
|
|
, spanLightI (V2 0 (0.4*h)) (V2 40 (0.4*h))
|
|
, windowLine (V2 0 (h-20)) (V2 40 (h-20))
|
|
, sPS (V2 (-50) (h-85)) 0 putLamp
|
|
, windowLine (V2 (-40) (h-60)) (V2 (-40) (h-100))
|
|
, sPS (V2 20 (h-40)) 0 $ PutID 0
|
|
, sPS (V2 (-20) (h-80)) 0 $ PutID 2
|
|
]
|
|
, _rmBound = [poly]
|
|
}
|
|
|
|
-- | A random length corridor with a destructible block blocking it.
|
|
longBlockedCorridor :: RandomGen g => State g (Tree (Either Room Room))
|
|
longBlockedCorridor = do
|
|
r <- state $ randomR (0,pi)
|
|
n <- state $ randomR (0,3)
|
|
let plmnts = [sPS (V2 20 40) r $ PutBlock [5,5,5] (V4 (150/256) (75/256) 0 (250/256))
|
|
$ reverse $ rectNSWE 10 (-10) (-10) 10
|
|
,sPS (V2 20 15) 0 putLamp
|
|
]
|
|
sequence $ treeFromPost (replicate n $ Left <$> randomiseOutLinks corridor)
|
|
$ return $ Right $ set rmPmnts plmnts corridor
|
|
|
|
-- | A single corridor with a destructible block blocking it.
|
|
blockedCorridor :: RandomGen g => State g (Tree (Either Room Room))
|
|
blockedCorridor = do
|
|
r <- state $ randomR (0,pi)
|
|
let plmnts =
|
|
[sPS (V2 20 40) r $ PutBlock [5,5,5] (V4 (150/256) ( 75/256) 0 ( 250/256))
|
|
$ reverse $ rectNSWE 10 (-10) (-10) 10
|
|
,spanLightI (V2 0 15) (V2 40 15)
|
|
]
|
|
sequence $ treeFromPost [] $ return $ Right $ set rmPmnts plmnts corridor
|
|
|
|
lasTunnel :: Room
|
|
lasTunnel = defaultRoom
|
|
{ _rmPolys = polys
|
|
, _rmBound = polys
|
|
, _rmLinks = [(V2 20 190,1.5* pi),(V2 0 20,0.5* pi)]
|
|
, _rmPmnts = [putLasTurret & plSpot .~ PS (V2 10 240) (1.5*pi)
|
|
, lowWall (rectNSEW 65 40 0 25)
|
|
, mntLS vShape (V2 50 10) (V3 40 20 50)
|
|
]
|
|
}
|
|
where
|
|
polys = [rectNSWE 250 0 0 20
|
|
, rectNSWE 80 0 0 60
|
|
]
|