loop/src/Dodge/Room/LongDoor.hs

{-# LANGUAGE TupleSections #-}

-- | Rooms containing long doors, probably with a big reveal behind them.
module Dodge.Room.LongDoor where

import Control.Monad
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.Default.Wall
import Dodge.Door.PutSlideDoor
import Dodge.LevelGen.PlacementHelper
import Dodge.LevelGen.Switch
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 Linear
import Picture
import RandomHelp
import ShapePicture

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)
                ]
                ++ [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))) $
                            const 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
    lampheight = 41
    ps =
        [ rectNSWE h 0 (- w) w
        , rectNSWE 20 (- h) (negate x) x
        ]
    thedoor btid =
        defaultDoor
            & drUpdate . drLerpSpeed .~ 0.5
            & 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 =<< roomRectAutoLights 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 =
    shuffleLinks
        . setOutLinksPD (f (> h + 40))
        . setInLinksPD (f (< h - 40))
        . (rmPmnts <>~ [butDoor, theterminal])
        . (rmBound .:~ openDoorBound)
  where
    f g y = g $ y ^. _1 . _y
    theterminal =
        putMessageTerminal (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)
    butDoor = putLitButOnPos
        (dim $ light red)
        (rprBool (isUnusedLnkType InLink))
        $ \btplmnt -> Just
            . putDoubleDoorThen
                defaultDoorWall
                30
                (V2 0 h)
                (V2 x h)
                (defaultDoor & drTrigger .~ (WdBlBtOn $ fromJust $ _plMID btplmnt)
                    & drUpdate . drLerpSpeed .~ 0.5)
            $ \dr1 dr2 ->
                Just
                    . sps0
                    . PutWorldUpdate
                    . const
                    . const
                    $ domount dr1 id . domount dr2 negate
    domount drx g =
        gwWorld . cWorld . lWorld . doors . ix (drx ^?! plMID . _Just)
            . drMounts
            .~ [ MountedSPic (noPic $ aBar 50 $ g <$> [V2 lsx 9, V2 lsx ly, lp])
               , MountedLight (V3 (lx - 1) ly 50 & _xy %~ g) 200 0.5
               ]
    lsx = 30
    lp@(V2 lx ly) = V2 100 (-20)

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)
                ]