--{-# 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 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 $ PutDoor col (not . cond) drL
        , sPS (V2 0 0) 0 $ PutDoor col (not . cond) drR
        , sPS (V2 0 (h-5)) pi $ PutButton $ makeButton col 
            (over worldState (M.insert (DoorNumOpen drID) True))
        ]
    , _rmBound  = ps
    }
  where
    ps = 
        [rectNSWE h (-2) (-w) w
        ,rectNSWE 20 (-h) (negate x) x
        ]
    drL = fmap ((\h' -> (V2 x (-h'),V2 x (h-h'))) . (* h) . (/ fromIntegral nDrp) . fromIntegral) 
        [0..nDrp]
    drR = fmap ((\h' -> (V2 (-x) (-h'),V2 (-x) (h-h'))) . (* h) . (/ fromIntegral nDrp) . fromIntegral) 
        [0..nDrp]
    nDrp = ceiling h :: Int
    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)
                  --  ,PutSwitchDoor (dim $ light red) butPos butRot (0,h) (x,h)
                    ]
     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