loop/src/Dodge/Room/LongDoor.hs

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

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 DoorObstacle 1 (V2 x 1) (V2 x h)) $
                    ps0 (PutSlideDr (thedoor btid) thewall DoorObstacle 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 (WdBlDoorMoving 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 prUpdate $
            PropUpdateAnd $
                PropUpdateIf
                    (WdBlDoorMoving drid)
                    (PropUpdateLS lsid (PrWdLsSetColor (V3 8 0 0)))
                    (PropUpdateLS lsid (PrWdLsSetColor 0.7))
    lampheight = 41
    ps =
        [ rectNSWE h 0 (- w) w
        , rectNSWE 20 (- h) (negate x) x
        ]
    thedoor btid =
        defaultDoor
            & drSpeed .~ wlSpeed
            & drTrigger .~ WdBlBtNotOff 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 aboveH $
            setInLinksPD belowH $
                rm
                    & rmPmnts .++~ [butDoor, theterminal]
                    & rmBound .:~ openDoorBound
  where
    theterminal =
        putMessageTerminal 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
            (WdP2fDoorPosition (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 =
        cWorld . lWorld . 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
                DoorObstacle
                thewall
                (WdBlBtNotOff $ 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
    col = dim $ light red

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