118 lines
4.1 KiB
Haskell
118 lines
4.1 KiB
Haskell
--{-# LANGUAGE TupleSections #-}
|
|
{- | Rooms containing long doors, probably with a big reveal behind them.
|
|
-}
|
|
module Dodge.Room.LongDoor
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Default.Room
|
|
import Dodge.Room.Data
|
|
import Dodge.Room.Placement
|
|
import Dodge.Room.Link
|
|
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.LightSources
|
|
import Picture
|
|
import Geometry
|
|
|
|
import System.Random
|
|
import Control.Lens
|
|
import Control.Monad.State
|
|
import Data.Tree
|
|
import qualified Data.Map as M
|
|
|
|
twinSlowDoorRoom
|
|
:: Int -- ^ Door id
|
|
-> Float -- ^ Half width
|
|
-> Float -- ^ Half height
|
|
-> Float -- ^ Inner width
|
|
-> Room
|
|
twinSlowDoorRoom drid w h x = defaultRoom
|
|
{ _rmPolys = ps
|
|
, _rmLinks =
|
|
[ (V2 w (h/2) , negate $ pi/2)
|
|
, (V2 (-w) (h/2) , pi/2)
|
|
, (V2 0 (-h), pi)
|
|
]
|
|
, _rmPath = []
|
|
, _rmPS =
|
|
[ sPS (V2 0 (h/2)) 0 putLamp
|
|
, sPS (V2 25 5) 0 putLamp
|
|
, sPS (V2 (negate 25) 5) 0 putLamp
|
|
, sPS (V2 0 0) 0 $ PutSingleDoor col cond (V2 x 1) (V2 x h) 1
|
|
, sPS (V2 0 0) 0 $ PutSingleDoor col cond (V2 (-x) 1) (V2 (-x) h) 1
|
|
, sPS (V2 0 (h-5)) pi $ PutButton $ makeSwitch col red
|
|
(worldState %~ M.insert (DoorNumOpen drid) True )
|
|
(worldState %~ M.insert (DoorNumOpen drid) False)
|
|
, sPS (V2 0 (h-1)) 0 $ PutLS (colorLightAt (V3 0.75 0 0) (V3 0 0 lampHeight) 0) (lampPic lampHeight)
|
|
, sPS (V2 0 (h-1)) 0 $ PutProp $ lampCover lampHeight
|
|
]
|
|
, _rmBound = ps
|
|
, _rmName = "twinSlowDoorRoom"
|
|
}
|
|
where
|
|
lampHeight = 41
|
|
ps =
|
|
[rectNSWE h 0 (-w) w
|
|
,rectNSWE 20 (-h) (negate x) x
|
|
]
|
|
cond w' = or $ M.lookup (DoorNumOpen drid) (_worldState w')
|
|
col = dim $ dim $ bright red
|
|
|
|
twinSlowDoorChasers
|
|
:: RandomGen g
|
|
=> Int -- ^ Door id
|
|
-> State g Room
|
|
twinSlowDoorChasers drid = do
|
|
let lps = V2 (-65) <$> [20,40 .. 180]
|
|
rps = V2 65 <$> [20,40 .. 180]
|
|
ps <- takeN 4 $ lps ++ rps
|
|
let plmnts = map (\p -> sPS p 0 $ PutCrit chaseCrit) ps
|
|
return $ twinSlowDoorRoom drid 80 200 40 & rmPS %~ (plmnts ++)
|
|
|
|
slowDoorRoom :: RandomGen g => State g (Tree (Either Room Room))
|
|
slowDoorRoom = do
|
|
x <- state $ randomR (400,800)
|
|
y <- state $ randomR (400,800)
|
|
h <- state $ randomR (200,min (y-100) 500)
|
|
(butPos,butRot) <- takeOne
|
|
[( V2 (x/2-50) 5,0)
|
|
,( V2 (x/2+50) 5,0)
|
|
]
|
|
let n = 25
|
|
xs <- replicateM n $ state $ randomR (10,x-10)
|
|
ys <- replicateM n $ state $ randomR (h+20,y)
|
|
rs <- replicateM n $ state $ randomR (0,2*pi)
|
|
let ps = zipWith V2 xs ys
|
|
xs' <- replicateM 5 $ state $ randomR (10,x-10)
|
|
ys' <- replicateM 5 $ state $ randomR (h+20,y)
|
|
let crits = zipWith (\p r -> sPS p r randC1) ps rs
|
|
lsources = [sPS (V2 (x/2) 30) 0 putLamp, sPS (V2 (x/2) (y-30)) 0 putLamp]
|
|
barrels = zipWith (\x' y' -> sPS (V2 x' y') 0 $ PutCrit explosiveBarrel) xs' ys'
|
|
pillarsa = []
|
|
pillarsb = putBlockRect (x/5-20) (x/5+20) (h/2-20) (h/2+20)
|
|
++ putBlockRect (2*x/5-20) (2*x/5+20) (h/2-20) (h/2+20)
|
|
++ putBlockRect (3*x/5-20) (3*x/5+20) (h/2-20) (h/2+20)
|
|
++ putBlockRect (4*x/5-20) (4*x/5+20) (h/2-20) (h/2+20)
|
|
pillarsc = putBlockRect (x/3-20) (x/3+20) (h/2-20) (h/2+20)
|
|
++ putBlockRect (2*x/3-20) (2*x/3+20) (h/2-20) (h/2+20)
|
|
pillars <- takeOne [pillarsa, pillarsb, pillarsc]
|
|
let cond x' = (sndV2 . fst) x' > h + 40
|
|
cond2 x' = (sndV2 . fst) x' < h - 40
|
|
but <- takeOne [PutBtDoor (dim $ light red) butPos butRot (V2 0 h) (V2 x h) 2
|
|
]
|
|
fmap connectRoom
|
|
(filterLinks cond =<<
|
|
changeLinkTo cond2
|
|
(set rmPS ([sPS (V2 0 0) 0 but] ++ crits ++ pillars ++ barrels ++ lsources)
|
|
$ roomRectAutoLinks x y
|
|
)
|
|
)
|
|
|
|
randC1 :: PSType
|
|
randC1 = RandPS $ takeOne $ map PutCrit $ armourChaseCrit : replicate 50 chaseCrit
|