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