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

--import Data.List
--import Data.Function (on)
--import qualified Data.Tuple.Extra as Tup
import qualified Data.Map as M
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
    , _rmPS    = [sPS (V2 (x/2) (y/2)) 0 putLamp]
    , _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 (translateS (V2 0 20) $ gridPoints  0  1      yd (yn+1))  (repeat ( pi/2)) 
    wlnks = zip (translateS (V2 x 20) $ gridPoints  0  1      yd (yn+1))  (repeat (-pi/2)) 
    nlnks = zip (translateS (V2 20 y) $ gridPoints xd (xn+1)  0  1     )  (repeat      0 ) 
    slnks = zip (translateS (V2 20 0) $ gridPoints xd (xn+1)  0  1     )  (repeat     pi ) 
    lnks = nlnks ++ elnks ++ wlnks ++ slnks
    pth  = linksAndPath lnks $ translateS (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)


{- Combines two rooms into one room.
Combines into one big bound, concatenates the rest.  -}
combineRooms :: Room -> Room -> Room
combineRooms r r' = defaultRoom
    { _rmPolys = _rmPolys r ++ _rmPolys r'
    , _rmLinks = _rmLinks r ++ _rmLinks r'
    , _rmPath  = _rmPath  r ++ _rmPath  r'
    , _rmPS    = _rmPS    r ++ _rmPS    r'
    , _rmBound = _rmBound r ++ _rmBound r'
    , _rmFloor = _rmFloor r ++ _rmFloor r'
    }
--{- The top fourth of a room of a given height.  -}
--fourth 
--    :: Float -- ^ Distance from center of room to top edge
--    -> Room
--fourth w = Room
--    { _rmPolys  = [ [(0,0),(w,w),(-w,w)] ]
--    , _rmLinks  = [((0,w), 0)]
--    , _rmPath   = [((0,w),(0,0)),((0,0),(0,w))]
--    , _rmPS     = 
--        [sPS (0,w/2) 0 putLamp
--        ]
--    , _rmBound  = [[(0,0),(w,w),(-w,w)]]
--    }
{- Randomly generate a top fourth of a room possibly with a wall.
Add a light and a 'PutNothing' placement.  -}
fourthWall :: RandomGen g => Float -> State g Room
fourthWall w = do
    b <- takeOne 
        [   [ sPS (V2 (20-w) (w-40)) 0  putLamp
            , sPS (V2 0 40)      0  putLamp
            , sPS (V2 (w-20) (w-20)) pi PutNothing
            , blockLine (V2 (w/2) (w/2)) (V2 (w/2) w)
            ]
        ,   [ sPS (V2 (20-w) (w-40)) 0  putLamp
            , sPS (V2 0 40)      0  putLamp
            , sPS (V2 (w-20) (w-20)) pi PutNothing
            , blockLine (V2 (w/2) (w/2)) (V2 (negate $ w/2) (w/2))
            ]
        ,   [ sPS (V2 (20-w) (w-40)) 0  putLamp
            , sPS (V2 0 20)      0  putLamp
            , 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  = [ map toV2 [(0,0),(w,w),(-w,w)] ]
        , _rmLinks  = [(V2 0 w, 0)]
        , _rmPath   = [(V2 0 w,V2 0 0),(V2 0 0,V2 0 w)]
        , _rmPS     = b
        , _rmBound  = [[V2 0 0,V2 w w,V2 (-w) w]]
        }
--fourthCorner :: Float -> Room
--fourthCorner w = Room
--    { _rmPolys  = [ [(0,0),(w,w),(0,2*w),(-w,w)] ]
--    , _rmLinks  = 
--        [((w/2,3*w/2), negate $ pi/4)
--        ,((negate $ w/2,3*w/2), pi/4)
--        ]
--    , _rmPath   = [((0,w),(0,0)),((0,0),(0,w))]
--    , _rmPS     = [sPS (0,w) 0 putLamp]
--    , _rmBound  = [[(w,w),(0,2*w),(-w,w)]]
--    }

fourthCornerWall :: RandomGen g => Float -> State g Room
fourthCornerWall w = do
    b <- takeOne 
        [   [ sPS (V2 (10-w) w)  0 putLamp
            , sPS (V2 (w-10) w) 0 putLamp
            , sPS (V2 0 10)    0 putLamp
            , sPS (V2 0 (2*w-20)) pi PutNothing
            , blockLine (V2 (w/2) (w/2)) (V2 0 w)
            , blockLine (V2 (negate $ w/2) (w/2)) (V2 0 w)
            ]
        ,   [ sPS (V2 0 (3*w/2))  0 putLamp
            , sPS (V2 (w-10) w) 0 putLamp
            , sPS (V2 (10-w) (w-20)  ) 0  putLamp
            , sPS (V2 0       10     ) 0  putLamp
            , sPS (V2 0      (2*w-20)) pi PutNothing
            , blockLine (V2 (w/2)      (w/2)) (V2 0 w)
            , blockLine (V2 (negate w)  w   ) (V2 0 w)
            ]
        ,   [ sPS (V2 (10-w)  w      ) 0 putLamp
            , sPS (V2 (w-10)  w      ) 0 putLamp
            , sPS (V2 0      10      ) 0 putLamp
            , sPS (V2 20     (2*w-40)) pi PutNothing
            , blockLine (V2 (w/2) (w/2)) (V2 0 w)
            , blockLine (V2 0 w) (V2 0 (w*2))
            ]
        ]
    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   = [(V2 0 w,V2 0 0),(V2 0 0,V2 0 w)]
        , _rmPS     = 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 & rmPS %~ replaceNothingWith pst
  where
    replaceNothingWith x (SinglePlacement (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 $ _rmPS r
    return $ r & rmPS .~ 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 [fourthWall 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
        . 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
    :: Int      -- ^ Door id
    -> Float    -- ^ Width
    -> Float    -- ^ Height
    -> Float    -- ^ Vault dimensions
    -> State g Room
centerVaultRoom n w h d = do
    let northPoly = rectNSWE h d (-w) w
        nsDoors = rectNSWE (d + 20) (negate (d +20)) (-20) 20
        weDoors = rectNSWE 20 (-20) (d + 20) (negate (d +20)) 
        centerPoly = rectWdthHght (d - 20) (d - 20)
        polys = centerPoly : nsDoors : weDoors : take 4 (iterate (map vNormal) northPoly)
    return $ defaultRoom
        { _rmPolys  = polys
        , _rmLinks  = 
            [(V2 0    h  , 0   )
            ,(V2 w    0  ,-pi/2)
            ,(V2 (-w) 0  , pi/2)
            ,(V2 0   (-h), pi  )
            ]
        , _rmPath   = []
        , _rmPS     = 
            [sPS (V2 (d-25) (d-25)) 0 putLamp
            ,sPS (V2 (w-5) (h-5)) 0 putLamp
            ,sPS (V2 (w-5) (5-h)) 0 putLamp
            ,sPS (V2 (5-w) (h-5)) 0 putLamp
            ,sPS (V2 (5-w) (5-h)) 0 putLamp
            ]
            ++ concat (zipWith (\i r -> map (shiftPSBy (V2 0 0,r)) $ theDoor i) 
                        [n, n+1, n+2, n+3] [0,pi/2,pi,3*pi/2])
        , _rmBound  = [rectNSWE h (-h) (-w) w]
        }
  where
    col = dim $ dim $ bright red
    theDoor i = 
        [ sPS (V2 0  (d-10)) 0 $ PutDoubleDoor col (cond i) (V2 (-19) 0) (V2 19 0) 2
        , sPS (V2 35 (d+4)) 0 $ PutButton $ makeSwitch col 
                           (over worldState (M.insert (DoorNumOpen i) True))
                           (over worldState (M.insert (DoorNumOpen i) False))
        ]
    cond i w' = or $ M.lookup (DoorNumOpen i) (_worldState w')

