--{-# LANGUAGE TupleSections #-}
{- | Rooms containing long doors, probably with a big reveal behind them.
 -}
module Dodge.Room.LongDoor
    where
import Dodge.Data
import Dodge.Default.Room
import Dodge.Room.Data
import Dodge.Room.Placement
import Dodge.Room.Link
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.LightSources
import Picture
import Geometry

import System.Random
import Control.Lens
import Control.Monad.State
import Data.Tree
import qualified Data.Map as M

twinSlowDoorRoom 
    :: Int      -- ^ Door id
    -> Float    -- ^ Half width
    -> Float    -- ^ Half height
    -> Float    -- ^ Inner width
    -> Room
twinSlowDoorRoom drid w h x = defaultRoom
    { _rmPolys  = ps
    , _rmLinks  =
        [ (V2 w (h/2) , negate $ pi/2)
        , (V2 (-w) (h/2) , pi/2)
        , (V2 0 (-h), pi)
        ]
    , _rmPath   = []
    , _rmPS     = 
        [ sPS (V2 0 (h/2)) 0 putLamp
        , sPS (V2 25 5) 0 putLamp
        , sPS (V2 (negate 25) 5) 0 putLamp
        , sPS (V2 0 0) 0 $ PutSingleDoor col cond (V2   x  1) (V2   x  h) 1
        , sPS (V2 0 0) 0 $ PutSingleDoor col cond (V2 (-x) 1) (V2 (-x) h) 1
        , sPS (V2 0 (h-5)) pi $ PutButton $ makeSwitch col red
            (worldState %~ M.insert (DoorNumOpen drid) True )
            (worldState %~ M.insert (DoorNumOpen drid) False)
        , sPS (V2 0 (h-1)) 0 $ PutLS (colorLightAt (V3 0.75 0 0) (V3 0 0 lampHeight) 0) (lampPic lampHeight)
        , sPS (V2 0 (h-1)) 0 $ PutProp $ lampCover lampHeight
        ]
    , _rmBound  = ps
    , _rmName   = "twinSlowDoorRoom"
    }
  where
    lampHeight = 41
    ps = 
        [rectNSWE h    0 (-w) w
        ,rectNSWE 20 (-h) (negate x) x
        ]
    cond w' = or $ M.lookup (DoorNumOpen drid) (_worldState w')
    col = dim $ dim $ bright red

twinSlowDoorChasers 
    :: RandomGen g 
    => Int  -- ^ Door id
    -> State g Room
twinSlowDoorChasers drid = 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 drid 80 200 40 & rmPS %~ (plmnts ++)

slowDoorRoom :: RandomGen g => State g (Tree (Either Room Room))
slowDoorRoom = do
     x <- state $ randomR (400,800)
     y <- state $ randomR (400,800)
     h <- state $ randomR (200,min (y-100) 500)
     (butPos,butRot) <- takeOne 
        [( V2 (x/2-50) 5,0)
        ,( V2 (x/2+50) 5,0)
        ]
     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'
         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]
     let cond x'  = (sndV2 . fst) x' > h + 40
         cond2 x' = (sndV2 . fst) x' < h - 40
     but <- takeOne [PutBtDoor (dim $ light red) butPos butRot (V2 0 h) (V2 x h) 2
                    ]
     fmap connectRoom 
        (filterLinks cond =<< 
            changeLinkTo cond2 
                (set rmPS ([sPS (V2 0 0) 0 but] ++ crits ++ pillars ++ barrels ++ lsources) 
                $ roomRectAutoLinks x y
                )
        )

randC1 :: PSType
randC1 = RandPS $ takeOne $ map PutCrit $ armourChaseCrit : replicate 50 chaseCrit