187 lines
7.1 KiB
Haskell
187 lines
7.1 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
-- | Rooms containing long doors, probably with a big reveal behind them.
|
|
module Dodge.Room.LongDoor where
|
|
|
|
import ShapePicture
|
|
import Linear
|
|
import Dodge.Door.PutSlideDoor
|
|
import Dodge.Default.Wall
|
|
import Control.Monad
|
|
import Dodge.LevelGen.Switch
|
|
import Data.Maybe
|
|
import qualified Data.Set as S
|
|
import Dodge.Cleat
|
|
import Dodge.Creature
|
|
import Dodge.Data.GenWorld
|
|
import Dodge.Default.Door
|
|
import Dodge.Default.Room
|
|
import Dodge.LevelGen.PlacementHelper
|
|
import Dodge.LightSource
|
|
import Dodge.Placement.Instance
|
|
import Dodge.PlacementSpot
|
|
import Dodge.Room.Door
|
|
import Dodge.Room.Link
|
|
import Dodge.Room.Procedural
|
|
import Dodge.RoomLink
|
|
import Dodge.Terminal
|
|
import Dodge.Tree
|
|
import Geometry
|
|
import LensHelp
|
|
import Picture
|
|
import RandomHelp
|
|
|
|
twinSlowDoorRoom ::
|
|
-- | Half width
|
|
Float ->
|
|
-- | Half height
|
|
Float ->
|
|
-- | Inner width
|
|
Float ->
|
|
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 = mempty
|
|
, _rmPmnts =
|
|
[ pContID (PS (V2 0 (h -5)) pi) (PutButton $ makeButton col NoWorldEffect) $
|
|
\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)) $
|
|
\_ -> jps0' (PutLS (lsColPos (V3 0.75 0 0) (V3 0 (h -1) lampheight))) $
|
|
\_ -> Nothing -- jsps0 $ PutProp $ addColorChange (fromJust $ _plMID lspl) did $ lampCoverWhen (WdBlDoorMoving did) (V2 0 (h -1)) lampheight
|
|
]
|
|
, _rmBound = ps
|
|
, _rmName = "twinSlowDoorRoom"
|
|
, _rmViewpoints = [V2 0 h]
|
|
}
|
|
where
|
|
--thewall = switchWallCol red
|
|
thewall = defaultDoorWall
|
|
wlSpeed = 0.5
|
|
lampheight = 41
|
|
ps =
|
|
[ rectNSWE h 0 (- w) w
|
|
, rectNSWE 20 (- h) (negate x) x
|
|
]
|
|
thedoor btid =
|
|
defaultDoor
|
|
& drUpdate . drLerpSpeed .~ wlSpeed
|
|
& drTrigger .~ WdBlBtOn btid
|
|
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 (f (> h + 40)) $
|
|
setInLinksPD (f (< h - 40)) $
|
|
rm
|
|
& rmPmnts <>~ [butDoor, theterminal]
|
|
& rmBound .:~ openDoorBound
|
|
where
|
|
f g y = g $ y ^. _1 . _y
|
|
theterminal =
|
|
putMessageTerminal terminalColor (simpleTermMessage themessage)
|
|
& plSpot .~ rprBoolShift (isUnusedLnkType InLink)
|
|
(shiftByV2 (V2 0 (-10)) <&> (,S.singleton UsedPosLow))
|
|
themessage = [ "WARNING:" , "LARGE BIOMASS DETECTED" ]
|
|
openDoorBound = reverse $ rectNSWE (h + 5) (h - 5) (3 * x / 2) (- x / 2)
|
|
-- amountedlight dr xoff mpl = Just
|
|
-- . moveLSThen
|
|
-- (WdP2fDoorPosition (fromJust $ _plMID dr))
|
|
-- (V3 15 xoff 89)
|
|
-- (aShape (V2 15 0) (V3 15 xoff 90))
|
|
-- $ \plls plpr ->
|
|
-- Just $
|
|
-- ptCont (PutWorldUpdate (const $ const $ over gwWorld $ setmount dr plls plpr)) $
|
|
-- const mpl
|
|
-- setmount pldr plls plpr =
|
|
-- cWorld . lWorld . doors . ix (fromJust $ _plMID pldr) . drMounts
|
|
-- <>~ [MountedLS (fromJust $ _plMID plls), MountedProp (fromJust $ _plMID plpr)]
|
|
butDoor = putLitButOnPos
|
|
(dim $ light red)
|
|
(rprBool (isUnusedLnkType InLink))
|
|
$ \btplmnt -> Just $
|
|
putDoubleDoorThen
|
|
defaultDoorWall
|
|
(WdBlBtOn $ fromJust $ _plMID btplmnt)
|
|
30
|
|
(V2 0 h)
|
|
(V2 x h)
|
|
0.5
|
|
$ \dr1 dr2 ->
|
|
Just
|
|
$ sps0 $ PutWorldUpdate $ const $ const
|
|
$ (gwWorld . cWorld . lWorld . doors . ix (dr1 ^?! plMID . _Just)
|
|
. drMounts .~
|
|
[MountedSPic (noPic $ aShape (V2 25 0) (V3 25 50 50))
|
|
, MountedSPic (noPic $ aShape (V2 25 0) (V3 25 (-50) 50))
|
|
, MountedLight (V3 25 (-50) 50) 200 0.5
|
|
, MountedLight (V3 25 50 50) 200 0.5
|
|
])
|
|
|
|
. (gwWorld . cWorld . lWorld . doors . ix (dr2 ^?! plMID . _Just)
|
|
. drMounts .~
|
|
[MountedSPic (noPic $ aShape (V2 (-25) 0) (V3 (-25) 50 50))
|
|
, MountedSPic (noPic $ aShape (V2 (-25) 0) (V3 (-25) (-50) 50))
|
|
, MountedLight (V3 (-25) (-50) 50) 200 0.5
|
|
, MountedLight (V3 (-25) 50 50) 200 0.5
|
|
])
|
|
-- amountedlight dr1 50 $
|
|
-- amountedlight dr1 (-50) $
|
|
-- amountedlight dr2 50 $
|
|
-- amountedlight
|
|
-- dr2
|
|
-- (-50)
|
|
-- Nothing
|
|
|
|
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)
|
|
]
|