78 lines
2.6 KiB
Haskell
78 lines
2.6 KiB
Haskell
{-
|
|
Connecting rooms designed with a pass-through technique in mind.
|
|
-}
|
|
module Dodge.Room.RoadBlock
|
|
where
|
|
import Geometry
|
|
import Dodge.Room.Data
|
|
import Dodge.Room.Link
|
|
import Dodge.Room.Placement
|
|
import Dodge.Room.Corridor
|
|
import Dodge.LevelGen.Data
|
|
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 $ Room
|
|
{ _rmPolys = [poly,poly2]
|
|
, _rmLinks = [ ((40,h - 80), -pi/2)
|
|
, ((20, 0), pi)
|
|
]
|
|
, _rmPath = concatMap doublePair
|
|
[((20,0),(20,h-40))
|
|
,(( 0,h-40),(20,h-40))
|
|
,((40,h-40),(20,h-40))
|
|
]
|
|
, _rmPS =
|
|
[ PS (20,h-5) 0 putLamp
|
|
, windowLine (0,h-20) (40,h-20)
|
|
, PS (-50,h-85) 0 putLamp
|
|
, windowLine (-40,h-60) (-40,h-100)
|
|
, PS ( 20,h-40) 0 $ PutID 0
|
|
, PS (-20,h-80) 0 $ PutID 2
|
|
]
|
|
, _rmBound = [poly]
|
|
}
|
|
|
|
noWeaponTest :: RandomGen g => State g (Tree (Either Room Room))
|
|
noWeaponTest = do
|
|
undefined
|
|
|
|
-- | A random length corridor with a descrutible 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 = [PS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256)
|
|
$ reverse $ rectNSWE 10 (-10) (-10) 10
|
|
,PS (20,15) 0 putLamp
|
|
]
|
|
sequence $ treeFromPost (replicate n $ Left <$> randomiseOutLinks corridor)
|
|
$ return $ Right $ set rmPS plmnts corridor
|
|
|
|
-- | A single corridor with a descrutible block blocking it.
|
|
blockedCorridor :: RandomGen g => State g (Tree (Either Room Room))
|
|
blockedCorridor = do
|
|
r <- state $ randomR (0,pi)
|
|
let plmnts = [PS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256)
|
|
$ reverse $ rectNSWE 10 (-10) (-10) 10
|
|
,PS (20,15) 0 putLamp
|
|
]
|
|
sequence $ treeFromPost [] $ return $ Right $ set rmPS plmnts corridor
|