--{-# LANGUAGE TupleSections #-}
{- | Rooms containing long doors, probably with a big reveal behind them.
 -}
module Dodge.Room.LongDoor where
import Dodge.Data
import Dodge.RoomLink
import Dodge.Base
import Dodge.Tree
import Dodge.Default.Room
import Dodge.LevelGen.Data
import Dodge.Placement.Instance
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 Dodge.RandomHelp
import Dodge.Creature.Inanimate
import Dodge.Creature
import Dodge.LightSource
import Picture
import Geometry

import qualified Data.Set as S
import Data.Tree
import System.Random
import Control.Lens
import Control.Monad.State
--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 False col (cond' btid) (V2 x 1) (V2 x h) wlSpeed)
            $ ps0 (PutSlideDr False col (cond' btid) (V2 (-x) 1) (V2 (-x) h) wlSpeed)
            $ \did -> jps0 (PutLS (colorLightAt (V3 0.75 0 0) (V3 0 (h-1) lampHeight) 0))
            $ \lsid -> jsps0 $ PutProp $ addColorChange lsid did $ lampCoverWhen (drmoving did) (V2 0 (h-1)) lampHeight
        ]
    , _rmBound  = ps
    , _rmName   = "twinSlowDoorRoom"
    , _rmViewpoints = [V2 0 h]
    }
  where
    wlSpeed = 0.5
    addColorChange lsid drid' = over pjUpdate $ dbArgChain $ const f
      where
        f w' | _drStatus (_doors w' IM.! drid') == DoorHalfway 
                = w' & lightSources . ix lsid . lsIntensity .~ V3 8 0 0
             | otherwise = w' & lightSources . ix lsid . lsIntensity .~ 0.7
    drmoving i w' = DoorHalfway == _drStatus (_doors w' IM.! i)
    lampHeight = 41
    ps = 
        [rectNSWE h    0 (-w) w
        ,rectNSWE 20 (-h) (negate x) x
        ]
    cond' btid w' = _btState (_buttons w' IM.! btid) /= BtOff
    col = dim $ dim $ bright red

twinSlowDoorChasers 
    :: RandomGen g 
    => State g Room
twinSlowDoorChasers = do
    let lps = V2 (-65) <$> [20,40 .. 180]
        rps = V2 65 <$> [20,40 .. 180]
    ps <- takeN 4 $ lps ++ rps
    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 = do
    let pillarsa = []
        pillarsb = putBlockRect (x/5-20) (x/5+20) (h/2-20) (h/2+20)
           ++ putBlockRect (2*x/5-20) (2*x/5+20) (h/2-20) (h/2+20)
           ++ putBlockRect (3*x/5-20) (3*x/5+20) (h/2-20) (h/2+20)
           ++ putBlockRect (4*x/5-20) (4*x/5+20) (h/2-20) (h/2+20)
        pillarsc = putBlockRect (x/3-20) (x/3+20) (h/2-20) (h/2+20)
           ++ putBlockRect (2*x/3-20) (2*x/3+20) (h/2-20) (h/2+20)
    pillars <- takeOne [pillarsa, pillarsb, pillarsc]
    return $ roomRectAutoLinks x y & rmPmnts .~ pillars

addSouthPillars :: RandomGen g => Float -> Float -> Room -> State g Room
addSouthPillars x h r = do
    let pillarsa = []
        pillarsb = putBlockRect (x/5-20) (x/5+20) (h/2-20) (h/2+20)
           ++ putBlockRect (2*x/5-20) (2*x/5+20) (h/2-20) (h/2+20)
           ++ putBlockRect (3*x/5-20) (3*x/5+20) (h/2-20) (h/2+20)
           ++ putBlockRect (4*x/5-20) (4*x/5+20) (h/2-20) (h/2+20)
        pillarsc = putBlockRect (x/3-20) (x/3+20) (h/2-20) (h/2+20)
           ++ putBlockRect (2*x/3-20) (2*x/3+20) (h/2-20) (h/2+20)
    pillars <- takeOne [pillarsa, pillarsb, pillarsc]
    return $ r & rmPmnts %~ (++ pillars)

addButtonSlowDoor :: RandomGen g => Float -> Float -> Room -> State g Room
addButtonSlowDoor x h rm = do
    (butPos,butRot) <- takeOne 
       [( V2 (x/2-50) 5,0::Float)
       ,( V2 (x/2+50) 5,0::Float)
       ]
    thePlacement <- takeOne [butDoor butPos butRot ]
    shuffleLinks $ setOutLinksPD aboveH $ setInLinksPD belowH (rm 
        & rmPmnts %~ (thePlacement :)
        & rmBound %~ (openDoorBound :)
        )
  where
    openDoorBound = rectNSEW (h + 5) (h - 5) (-x/2) (3*x/2)
    belowH y = (sndV2 . fst) y < h - 40
    aboveH y = (sndV2 . fst) y > h + 40
    butDoor _ _ = putLitButOnPos col butPosCond
        $  \btid -> Just $ putDoubleDoor False col (cond' btid) (V2 0 h) (V2 x h) 2
    butPosCond (UnusedLink (V2 x' y') a') _ | y' < 0.5 * h 
                = Just (PS (V2 x' y') a' , UsedSpot (V2 x' y') a')
    butPosCond _ _ = Nothing
    --butPosCond _ = True -- y < h
    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
        lsources = [sPS (V2 (x/2) 30) 0 putLamp, sPS (V2 (x/2) (y-30)) 0 putLamp]
        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 ++ lsources)))

slowDoorRoomRunPast :: RandomGen g => State g (SubCompTree Room)
slowDoorRoomRunPast = do
    r <- slowDoorRoom
    return $ treeFromTrunk [PassDown door]
        (Node (PassDown r)
            [ singleUseAll door
            , return (UseLabel 0 $ door & rmConnectsTo .~ S.singleton InLink)
            ]
        )
