{- | 
 Procedural creation of rooms and subroom parts.  -}
module Dodge.Room.Procedural
    ( roomRect
    , roomRectAutoLinks
    , randomFourCornerRoom
    , centerVaultRoom
    , combineRooms
    , linksAndPath
    , makeGrid
    ) where
import Dodge.Data
import Dodge.Default.Wall
import Dodge.Room.Data
import Dodge.Placements
import Dodge.Room.Link
import Dodge.Room.Path
import Dodge.Default.Room
import Dodge.Item.Consumable
import Dodge.Item.Equipment
import Dodge.Room.Foreground
import Dodge.Item.Weapon
import Dodge.Item.Weapon.Launcher
import Dodge.RandomHelp
import Dodge.LevelGen
import Dodge.LevelGen.Data
import Dodge.LevelGen.Switch
import Dodge.Creature
import Geometry
import Geometry.Vector3D
import Picture
import Data.Tile

import qualified Data.IntMap.Strict as IM
import Control.Lens
import Control.Monad
import Control.Monad.State
import System.Random
{- A simple rectangular room with a light in the center.
Creates links and pathfinding graph.  -}
roomRect
    :: Float    -- ^ Width
    -> Float    -- ^ Height
    -> Int      -- ^ Number of links on vertical walls
    -> Int      -- ^ Number of links on horizontal walls
    -> Room
roomRect x y xn yn = defaultRoom
    { _rmPolys = [rectNSWE  y 0 0 x ]
    , _rmLinks = lnks
    , _rmPath  = concatMap doublePair pth
    , _rmPmnts    = []
    , _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
    , _rmFloor = [Tile 
            { _tilePoly = rectNSWE y 0 0 x
            , _tileZero = V2 0 0
            , _tileX    = V2 1 0
            , _tileZ    = 16
            } ]
    }
  where 
    yd = (y - 40) / fromIntegral yn
    xd = (x - 40) / fromIntegral xn
    elnks = zip (map (+.+ V2 0 20) $ gridPoints  0  1      yd (yn+1))  (repeat ( pi/2)) 
    wlnks = zip (map (+.+ V2 x 20) $ gridPoints  0  1      yd (yn+1))  (repeat (-pi/2)) 
    nlnks = zip (map (+.+ V2 20 y) $ gridPoints xd (xn+1)  0  1     )  (repeat      0 ) 
    slnks = zip (map (+.+ V2 20 0) $ gridPoints xd (xn+1)  0  1     )  (repeat     pi ) 
    lnks = nlnks ++ elnks ++ wlnks ++ slnks
    pth  = linksAndPath lnks $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn)
{- Creates a rectangular room, automatically creates links and pathfinding graph at a sensible size.  -}
roomRectAutoLinks :: Float -> Float -> Room
roomRectAutoLinks x y = (roomRect x y ((ceiling x - 40) `div` 60) ((ceiling y - 40) `div` 60))
    {_rmPmnts = plmnts}
  where
    plmnts = 
        [mntLightLnkCond (const True)
--        ,sps0 $ PutForeground $ thinHighBarChain 50 $ rectNSWE y 0 0 x
        ]
{- Combines two rooms into one room.
Mostly involves concatenation.  -}
combineRooms :: Room -> Room -> Room
combineRooms r r' = defaultRoom
    { _rmPolys = _rmPolys r ++ _rmPolys r'
    , _rmLinks = _rmLinks r ++ _rmLinks r'
    , _rmPath  = map clampPath $ _rmPath  r 
              ++ _rmPath  r'
    , _rmPmnts    = map (shiftPlacement $ _rmShift r)  (_rmPmnts r) 
              ++ map (shiftPlacement $ _rmShift r') (_rmPmnts r')
    , _rmBound = _rmBound r ++ _rmBound r'
    , _rmFloor = _rmFloor r ++ _rmFloor r'
    , _rmShift  = (V2 0 0 , 0)
    }
-- not that this assumes that any link paths are integral
clampPath :: (Point2,Point2) -> (Point2, Point2)
clampPath = bimap f f
  where
    f (V2 x y) = V2 (g x) (g y)
    g = (fromIntegral :: Int -> Float) . floor
{- Randomly generate a top fourth of a room possibly with a wall.
Add a light and a 'PutNothing' placement.  -}
quarterRoomFlat :: RandomGen g => Float -> State g Room
quarterRoomFlat w = do
    b <- takeOne 
        [   [ mountLightV (V2 0 w) (V3 0 (w-20) 70)
            , mountLight (V2 (w-20) w) (V3 (w-20) (w-20) 70)
            , sPS (V2 (w-20) (w-20)) pi PutNothing
            , blockLine (V2 (w/2) (w/2)) (V2 (w/2) w)
            ]
        ,   [ mountLight (V2 (w-20) w) (V3 (w-20) (w-20) 70)
            , sPS (V2 (w-20) (w-20)) pi PutNothing
            , blockLine (V2 (w/2) (w/2)) (V2 (negate $ w/2) (w/2))
            ]
        ,   [ mountLight (V2 (w-20) w) (V3 (w-20) (w-20) 70)
            , sPS (V2 (w-20) (w-20)) pi PutNothing
            , blockLine (V2 (w/2) (w/2)) (V2 0 (w/2))
            , blockLine (V2 (-29) w) (V2 0 (w/2))
            ]
        ]
    pure $ defaultRoom
        { _rmPolys  = [ [V2 0 0,V2 w w,V2 (-w) w] ]
        , _rmLinks  = [(V2 0 w, 0)]
        , _rmPath   = concatMap doublePair
            [(V2 0 w,V2 0 (w-20))
            ,(V2 0 (w-20),V2 (w-20) (w-20))
            ,(V2 0 (w-20),V2 (55-w) (w-20))
            ,(V2 (55-w) (w-20),V2 (20-w) (w-20))
            ,(V2 0 (w-20),V2 0 0)
            ,(V2 (55-w) (w-20),V2 0 0)
            ]
        , _rmPmnts     = b
        , _rmBound  = [[V2 0 0,V2 w w,V2 (-w) w]]
        }

fourthCornerWall :: RandomGen g => Float -> State g Room
fourthCornerWall w = do
    b <- takeOne 
        [   [ mountLightV (V2 0 (2*w-20)) (V3 0 (2*w-40) 70)
            , blockLine (V2 (w/2) (w/2)) (V2 0 w)
            , blockLine (V2 (negate $ w/2) (w/2)) (V2 0 w)
            , sPS (V2 20     (2*w-40)) pi PutNothing
            ]
        ,   [ mountLightV (V2 0 (2*w-20)) (V3 0 (2*w-40) 70)
            , blockLine (V2 (w/2)      (w/2)) (V2 0 w)
            , blockLine (V2 (negate w)  w   ) (V2 0 w)
            , sPS (V2 20     (2*w-40)) pi PutNothing
            ]
        ,   [ mountLight (V2 (0.7*w) (1.3*w)) (V3 (0.7*w-20)  (1.3*w-20) 70)
            , blockLine (V2 (w/2) (w/2)) (V2 0 w)
            , blockLine (V2 0 w) (V2 0 (w*2))
            , sPS (V2 20     (2*w-40)) pi PutNothing
            ]
        ]
    pure $ defaultRoom
        { _rmPolys  = [ map toV2 [(0,0),(w,w),(0,2*w),(-w,w)] ]
        , _rmLinks  = 
            [(V2 (w/2) (3*w/2), negate $ pi/4)
            ,(V2 (negate $ w/2) (3*w/2), pi/4)
            ]
        , _rmPath   = concatMap doublePair
            [(V2 (0.5*w) (1.5*w),V2 (0.5*w-20) (1.5*w-20))
            ,(V2 (-0.5*w) (1.5*w),V2 (-0.5*w+20) (1.5*w-20))
            ,(V2 0 (2*w-40),V2 (-0.5*w+20) (1.5*w-20))
            ,(V2 0 (2*w-40),V2 (0.5*w-20) (1.5*w-20))
            ,(V2 (w-20) (w-20),V2 (0.5*w-20) (1.5*w-20))
            ,(V2 (20-w) (w-20),V2 (-0.5*w+20) (1.5*w-20))
            --,(V2 (40-w) (w),V2 0 (w-40))
            ,(V2 (20-w) (w-20),V2 0 (w-40))
            ,(V2 0 0,V2 0 (w-40))
--            ,(V2 (20-w) (w-20),V2 (40-w) (w))
            ]
        , _rmPmnts     = b
        , _rmBound  = [map toV2 [(w,w),(0,2*w),(-w,w)]]
        }
{- | Replace the first 'PutNothing' with a given 'PSType'. -}
fillNothingPlacement :: PSType -> Room -> Room
fillNothingPlacement pst r =
    r & rmPmnts %~ replaceNothingWith pst
  where
    replaceNothingWith x (Placement (PS p rot) PutNothing _: pss) = sPS p rot x : pss
    replaceNothingWith x (ps:pss) = ps : replaceNothingWith x pss
    replaceNothingWith _ [] = []
{- | Successively fill 'PutNothing' placements with a list of given 'PSType's.
-}
fillNothingPlacements :: [PSType] -> Room -> Room
fillNothingPlacements pst r = foldr fillNothingPlacement r pst
{- | Randomise the ordering of placements in a room.
Useful for randomising the position of generic placements such as 'PutNothing'. -}
shufflePlacements :: RandomGen g => Room -> State g Room
shufflePlacements r = do
    newPSs <- shuffle $ _rmPmnts r
    return $ r & rmPmnts .~ newPSs
{- | A randomly generate room based on four randomly generated corners. 
Tight corridors, random placements. -}
randomFourCornerRoom :: RandomGen g => State g Room
randomFourCornerRoom = do
    corners <- replicateM 4 . join $ takeOne [quarterRoomFlat 100, fourthCornerWall 100]
    nItms <- state $ randomR (1,2)
    itms <- takeN nItms $ fmap PutFlIt $ [autoRadar,autoSonar,remoteLauncher,jetPack,blinkGun]
        ++ replicate 5 (medkit 500)
    nCrits <- state $ randomR (1,3)
    crits <- takeN nCrits $ fmap PutCrit $ [spreadGunCrit,pistolCrit,autoCrit,armourChaseCrit]
        ++ replicate 20 chaseCrit
    randomiseAllLinks . fillNothingPlacements (crits ++ itms) =<< 
        ( shufflePlacements
        . over rmPmnts ( sps0 putLamp :)
        . foldr1 combineRooms 
        $ zipWith (\r a -> shiftRoomBy (V2 0 0,a) r) corners [0,pi/2,pi,3*pi/2]
        )
{- | Creates room with a central vault with doors around it.  -}
centerVaultRoom
    :: Float    -- ^ Width
    -> Float    -- ^ Height
    -> Float    -- ^ Vault dimensions
    -> State g Room
centerVaultRoom w h d = do
    return $ defaultRoom
        { _rmPolys  = [rectNSWE h (-h) (-w) w]
        , _rmLinks  = 
            [(V2 0    h  , 0   )
            ,(V2 w    0  ,-pi/2)
            ,(V2 (-w) 0  , pi/2)
            ,(V2 0   (-h), pi  )
            ]
        , _rmPath   = []
        , _rmPmnts     = 
            [sps0 $ PutWall (rectNSEW   d  (d - 30)   d  (d - 30)) defaultWall
            ,sps0 $ PutWall (rectNSEW   d  (d - 30) (-d) (30 - d)) defaultWall
            ,sps0 $ PutWall (rectNSEW (-d) (30 - d)   d  (d - 30)) defaultWall
            ,sps0 $ PutWall (rectNSEW (-d) (30 - d) (-d) (30 - d)) defaultWall
            ,sps0 $ PutForeground $ girder 70 10 10 (V2 (d-11) (-d)) (V2 (d-11) (-h))
            ]
            ++ map (\a -> mountLightV (rotateV a $ V2 0  d) (rotate3z a $ V3 0 (d+30) 70))
                [0,0.5*pi,pi,1.5*pi]
            ++ concatMap (\r -> map (shiftPlacement (V2 0 0,r)) theDoor) 
                        [0,pi/2,pi,3*pi/2]
        , _rmBound  = [rectNSWE h (-h) (-w) w]
        }
  where
    col = dim $ dim $ bright red
    theDoor = 
        [ Placement (PS (V2 35 (d+4)) 0) (PutButton $ makeSwitch col red id id)
            $ \btid -> jspsJ (V2 0 (d-10)) 0 (PutSlideDoor False col (cond' btid) (V2 (-21) 0) (V2 0 0) 2)
            $          sPS   (V2 0 (d-10)) 0 (PutSlideDoor False col (cond' btid) (V2   21  0) (V2 0 0) 2)
        ]
    cond' btid w' = _btState (_buttons w' IM.! btid) == BtOn