{- | 
 Procedural creation of rooms and subroom parts.  -}
module Dodge.Room.Procedural
    ( roomRect
    , roomRectAutoLinks
    , randomFourCornerRoom
    , centerVaultRoom
    , combineRooms
    , linksAndPath
    , makeGrid
    ) where
import Dodge.Data
import Dodge.Placement.Shift
import Dodge.Default.Wall
import Dodge.PlacementSpot
import Dodge.Placement.Instance
import Dodge.RoomLink
import Dodge.Item.Weapon.Utility
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.RandomHelp
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
    , _rmPos   = map (`UnusedSpot` 0) posps
    , _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
            } ]
    , _rmRandPSs = [psRandRanges (10,x-10) (10,y-10) (0,2*pi)]
    }
  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 = m North nlnks ++ m East elnks ++ m West wlnks ++ m South slnks
    m edge = map (lnkBothAnd (OnEdge edge))
    pth  = linksAndPath' lnks $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn)
    posps = map (+.+ V2 20 20) $ gridPoints xd (xn+1) yd (yn+1)
{- Creates a rectangular room, automatically creates links and pathfinding graph at a sensible size.  -}
-- it is not clear to me that this works for very small rooms (but it does seem
-- to do so)
roomRectAutoLinks :: Float -> Float -> Room
roomRectAutoLinks x y = (roomRect x y xn yn)
    {_rmPmnts = plmnts}
  where
    xn = max 1 $ (ceiling x - 40) `div` 60
    yn = max 1 $ (ceiling y - 40) `div` 60
    plmnts = [mntLightLnkCond unusedLnkToPS ]
{- Combines two rooms into one room.
 - will have to work out exactly what to do with combining links
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 
        [   [ mntLS vShape (V2 0 w) (V3 0 (w-20) 70)
            , mntLS iShape (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)
            ]
        ,   [ mntLS iShape (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))
            ]
        ,   [ mntLS iShape (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  = [toBothLnk (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 
        [   [ mntLS vShape (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
            ]
        ,   [ mntLS vShape (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
            ]
        ,   [ mntLS iShape (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  = 
            [toBothLnk (V2 (w/2) (3*w/2), negate $ pi/4)
            ,toBothLnk (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  = 
            [outLink (V2 0    h) 0   
            ,outLink (V2 w    0) (-pi/2)
            ,outLink (V2 (-w) 0) (pi/2) 
            , inLink (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 $ PutShape $ girder 70 10 10 (V2 (d-11) (-d)) (V2 (d-11) (-h))
            ]
            ++ map (\a -> mntLS vShape (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 = 
        [ pContID (PS (V2 35 (d+4)) 0) (PutButton $ makeSwitch col red id id)
            $ \btid -> jspsJ (V2 0 (d-10)) 0 (PutSlideDr False col (cond' btid) (V2 (-21) 0) (V2 0 0) 2)
            $          sPS   (V2 0 (d-10)) 0 (PutSlideDr False col (cond' btid) (V2   21  0) (V2 0 0) 2)
        ]
    cond' btid w' = _btState (_buttons w' IM.! btid) == BtOn
