158 lines
6.0 KiB
Haskell
158 lines
6.0 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.Door
|
|
import Dodge.Cleat
|
|
import Dodge.RoomLink
|
|
import Dodge.Base
|
|
import Dodge.Tree
|
|
import Dodge.Default.Room
|
|
import Dodge.LevelGen.Data
|
|
import Dodge.Placement.Instance
|
|
import Dodge.PlacementSpot
|
|
import Dodge.Room.Link
|
|
import Dodge.Room.Door
|
|
import Dodge.Room.Procedural
|
|
--import Dodge.Layout.Tree.Either
|
|
--import Dodge.LevelGen.Data
|
|
import Dodge.LevelGen.Switch
|
|
import RandomHelp
|
|
import Dodge.Creature.Inanimate
|
|
import Dodge.Creature
|
|
import Dodge.LightSource
|
|
import Picture
|
|
import Geometry
|
|
import LensHelp
|
|
--import Shape
|
|
|
|
import qualified Data.Set as S
|
|
import Data.Maybe
|
|
--import Data.Tree
|
|
import qualified Data.IntMap as IM
|
|
|
|
twinSlowDoorRoom
|
|
:: Float -- ^ Half width
|
|
-> Float -- ^ Half height
|
|
-> Float -- ^ Inner width
|
|
-> Room
|
|
twinSlowDoorRoom w h x = defaultRoom
|
|
{ _rmPolys = ps
|
|
, _rmLinks = map (uncurry outLink)
|
|
[ (V2 w (h/2) , negate $ pi/2)
|
|
, (V2 (-w) (h/2) , pi/2) ]
|
|
++ [uncurry inLink (V2 0 (-h), pi) ]
|
|
, _rmPath = []
|
|
, _rmPmnts =
|
|
[ pContID (PS (V2 0 (h-5)) pi) ( PutButton $ makeButton col id)
|
|
$ \btid -> jsps0J (PutSlideDr (thedoor btid) thewall 1 (V2 x 1) (V2 x h))
|
|
$ ps0 (PutSlideDr (thedoor btid) thewall 1 (V2 (-x) 1) (V2 (-x) h))
|
|
$ \did -> jps0' (PutLS (lsColPos (V3 0.75 0 0) (V3 0 (h-1) lampHeight)))
|
|
$ \lspl -> jsps0 $ PutProp $ addColorChange (fromJust $ _plMID lspl) did $ lampCoverWhen (drmoving did) (V2 0 (h-1)) lampHeight
|
|
]
|
|
, _rmBound = ps
|
|
, _rmName = "twinSlowDoorRoom"
|
|
, _rmViewpoints = [V2 0 h]
|
|
}
|
|
where
|
|
thewall = switchWallCol red
|
|
wlSpeed = 0.5
|
|
addColorChange lsid drid = over pjUpdate $ dbArgChain $ const f
|
|
where
|
|
f u | _drStatus (_doors u IM.! drid) == DoorHalfway
|
|
= u & updatelscol (V3 8 0 0)
|
|
| otherwise = u & updatelscol 0.7
|
|
updatelscol c = lightSources . ix lsid . lsParam . lsCol .~ c
|
|
drmoving i w' = DoorHalfway == _drStatus (_doors w' IM.! i)
|
|
lampHeight = 41
|
|
ps =
|
|
[rectNSWE h 0 (-w) w
|
|
,rectNSWE 20 (-h) (negate x) x
|
|
]
|
|
thedoor btid = defaultDoor
|
|
& drSpeed .~ wlSpeed
|
|
& drTrigger .~ (\w' -> _btState (_buttons w' IM.! btid) /= BtOff)
|
|
col = dim $ dim $ bright red
|
|
|
|
twinSlowDoorChasers :: RandomGen g => State g Room
|
|
twinSlowDoorChasers = do
|
|
ps <- takeN 4 $ [ V2 x y | x <- [-65,65], y <- [20,40 .. 180] ]
|
|
let plmnts = map (\p -> sPS p 0 $ PutCrit chaseCrit) ps
|
|
return $ twinSlowDoorRoom 80 200 40 & rmPmnts %~ (plmnts ++)
|
|
|
|
southPillarsRoom :: RandomGen g => Float -> Float -> Float -> State g Room
|
|
southPillarsRoom x y h = addSouthPillars x h (roomRectAutoLinks x y)
|
|
|
|
addSouthPillars :: RandomGen g => Float -> Float -> Room -> State g Room
|
|
addSouthPillars x h r = do
|
|
let pillarsa = []
|
|
pillarsb = concat [putBlockRect (i*x/5-20) (i*x/5+20) (h/2-20) (h/2+20) | i <- [1..4] ]
|
|
pillarsc = concat [putBlockRect (i*x/3-20) (i*x/3+20) (h/2-20) (h/2+20) | i <- [1,2] ]
|
|
pillars <- takeOne [pillarsa, pillarsb, pillarsc]
|
|
return $ r & rmPmnts .++~ pillars
|
|
|
|
addButtonSlowDoor :: RandomGen g => Float -> Float -> Room -> State g Room
|
|
addButtonSlowDoor x h rm = do
|
|
shuffleLinks $ setOutLinksPD aboveH $ setInLinksPD belowH $ rm
|
|
& rmPmnts .++~ [butDoor , theterminal]
|
|
& rmBound .:~ openDoorBound
|
|
where
|
|
theterminal = putTerminal terminalColor (simpleTermMessage themessage)
|
|
& plSpot .~ rprBoolShift (isUnusedLnkType InLink) (shiftByV2 (V2 0 (-10)))
|
|
themessage =
|
|
["WARNING:"
|
|
,"LARGE BIOMASS DETECTED"
|
|
]
|
|
openDoorBound = reverse $ rectNSWE (h + 5) (h - 5) (3*x/2) (-x/2)
|
|
belowH y = (sndV2 . fst) y < h - 40
|
|
aboveH y = (sndV2 . fst) y > h + 40
|
|
amountedlight dr xoff mpl = Just . moveLSThen (getdoorpos (fromJust $ _plMID dr))
|
|
(V3 15 xoff 89) (aShape (V2 15 0) (V3 15 xoff 90))
|
|
$ \plls plpr -> Just $ ptCont (PutWorldUpdate (const $ setmount dr plls plpr))
|
|
$ const mpl
|
|
setmount pldr plls plpr = doors . ix (fromJust $ _plMID pldr) . drMounts .++~
|
|
[MountedLS (fromJust $ _plMID plls), MountedProp (fromJust $ _plMID plpr)]
|
|
-- TODO make the height of this light source and of other mounted lights
|
|
-- be taken from a single consistent source
|
|
thewall = switchWallCol red
|
|
butDoor = putLitButOnPos col
|
|
(rprBool (isUnusedLnkType InLink))
|
|
$ \btplmnt -> Just $ putDoubleDoorThen thewall (cond' $ fromJust $ _plMID btplmnt)
|
|
30 (V2 0 h) (V2 x h) 2
|
|
$ \dr1 dr2 ->
|
|
amountedlight dr1 50
|
|
$ amountedlight dr1 (-50)
|
|
$ amountedlight dr2 50
|
|
$ amountedlight dr2 (-50)
|
|
Nothing
|
|
getdoorpos drid w = let Just (a,b) = w ^? doors . ix drid . drPos
|
|
in (b, argV (a-.-b))
|
|
col = dim $ light red
|
|
cond' btid w = w ^? buttons . ix btid . btState /= Just BtOff
|
|
|
|
slowDoorRoom :: RandomGen g => State g Room
|
|
slowDoorRoom = do
|
|
x <- state $ randomR (400,800)
|
|
y <- state $ randomR (400,800)
|
|
h <- state $ randomR (200,min (y-100) 500)
|
|
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
|
|
barrels = zipWith (\x' y' -> sPS (V2 x' y') 0 $ PutCrit explosiveBarrel) xs' ys'
|
|
proom <- southPillarsRoom x y h
|
|
addButtonSlowDoor x h (proom & rmPmnts %~ (++ (crits ++ barrels)))
|
|
|
|
slowDoorRoomRunPast :: RandomGen g => State g (MetaTree Room String)
|
|
slowDoorRoomRunPast = do
|
|
r <- slowDoorRoom
|
|
rToOnward "slowDoorRoomRunPast" $ treeFromTrunk [ door] $ Node r
|
|
[ pure $ cleatOnward door
|
|
, return (cleatLabel 0 $ door & rmConnectsTo .~ S.member InLink)
|
|
]
|