{- | Procedural creation of rooms and subroom parts.  -}
module Dodge.Room.Procedural
    ( roomRect
    , roomRectAutoLinks
    , randomFourCornerRoom
    , randomFourCornerRoomCrsIts
    , centerVaultRoom
    , combineRooms
    , linksAndPath
    , makeGrid
    ) where
import Dodge.Data
import Dodge.Placement.Shift
import Dodge.Default.Wall
--import Shape.Data
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.Item.Weapon
import RandomHelp
import Dodge.LevelGen.Data
import Dodge.LevelGen.Switch
import Dodge.Creature
import Geometry
import Picture
import Data.Tile
import LensHelp

import qualified Data.Set as S
import qualified Data.IntMap.Strict as IM
--import Control.Lens
-- This will need a cleanup, but it might change a bit first
{- 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
    , _rmName  = "rect"
    , _rmPath  = concatMap doublePair pth
    --, _rmPos   = map (roomposat (RoomPosOnPath S.empty)) posps
    --    ++ map (roomposat (RoomPosOffPath S.empty)) interposps
    , _rmPos   = map makeonpos posps'
        ++ map makeoffpos interposps'
    , _rmPmnts    = []
    , _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
    , _rmFloor = Tiled [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)]
    , _rmType = RectRoomType
        { _numLinkEW = xn
        , _numLinkNS = yn
        , _linkGapEW = xd
        , _linkGapNS = yd
        , _rmWidth = x
        , _rmHeight = y
        }
    }
  where 
    yd = (y - 40) / fromIntegral yn
    xd = (x - 40) / fromIntegral xn
    somelnks poffset ps a = zip (map (+.+ poffset) ps) (repeat a)
    wlnks = somelnks (V2 0 20) (gridPoints  0  1      yd (yn+1))  ( pi/2) 
    elnks = somelnks (V2 x 20) (gridPoints  0  1      yd (yn+1))  (-pi/2) 
    nlnks = somelnks (V2 20 y) (gridPoints xd (xn+1)  0  1     )       0  
    slnks = somelnks (V2 20 0) (gridPoints xd (xn+1)  0  1     )      pi  
    lnks = m North (FromEdge West) (FromEdge East) nlnks
        ++ m East (FromEdge South) (FromEdge North) elnks
        ++ m West (FromEdge South) (FromEdge North) wlnks
        ++ m South (FromEdge West) (FromEdge East) slnks
    m edge edgefrom1 edgefrom2 = zipWith (lnkBothAnd (OnEdge edge) edgefrom1 edgefrom2) [0..]
        . zipCountDown
    pth  = linksAndPath' lnks $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn)
    makeonpos (p,a) = RoomPos p 0 (S.singleton $ RoomPosOnPath $ makerpedges a) NotLink 0
    makerpedges (a,b) = S.fromList 
        [PathFromEdge South b
        ,PathFromEdge North (yn-b)
        ,PathFromEdge East (xn-a)
        ,PathFromEdge West a
        ]
    posps' = map (over _1 (+.+ V2 20 20)) $ gridPoints'' xd (xn+1) yd (xn+1)
    interposps' = map (over _1 (+.+ V2 (20 + xd/2) (20 + yd/2))) $ gridPoints'' xd xn yd yn
    makeoffpos (p,a) = RoomPos p 0 (S.singleton $ RoomPosOffPath $ makerpedges' a) NotLink 0
    makerpedges' (a,b) = S.fromList 
        [PathFromEdge South b
        ,PathFromEdge North (yn-(b+1))
        ,PathFromEdge East (xn-(a+1))
        ,PathFromEdge West a
        ]

zipCountDown :: [a] -> [(Int,a)]
zipCountDown xs = zip [length xs - 1, length xs - 2 ..] xs

lnkBothAnd :: RoomLinkType -> (Int -> RoomLinkType) -> (Int -> RoomLinkType)
    -> Int -> (Int,(Point2,Float)) -> RoomLink
lnkBothAnd rlt ltcon ltcon2 i (j,(p,a)) = RoomLink 
    { _rlType = S.fromList [OutLink,InLink,rlt,ltcon i,ltcon2 j]
    , _rlPos = p 
    , _rlDir = a
    }
{- 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 (f x) (f y) 
    & rmName .~ "autoRect"
    & rmPmnts .~ [mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isInLnk rp]
  where
    f z = max 1 $ (ceiling z - 40) `div` 60
{- 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  = _rmPmnts r ++ _rmPmnts r'
    , _rmBound  = _rmBound r ++ _rmBound r'
    , _rmPos    = _rmPos r ++ _rmPos r'
    , _rmFloor  = combineFloors (_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

combineFloors :: Floor -> Floor -> Floor
combineFloors = const
{- Randomly generate a top fourth of a room possibly with a wall.
Add a light and a 'PutNothing' placement.  -}
quarterRoomTri :: RandomGen g => Float -> State g Room
quarterRoomTri w = do
    b <- takeOne 
        [   [ mntLS vShape (V2 0 w) (V3 0 (w-20) 70)
            , blockLine (V2 (w/2) (w/2)) (V2 (w/2) w)
            ]
        ,   [ blockLine (V2 (w/2) (w/2)) (V2 (negate $ w/2) (w/2))]
        ,   [ blockLine (V2 (w/2) (w/2)) (V2 0 (w/2))
            , blockLine (V2 (-29) w) (V2 0 (w/2)) & plType . putWall . wlRotateTo .~ False
            ]
        ]
    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 ++ [ mntLS iShape (V2 (w-20) w) (V3 (w-20) (w-20) 70) ]
        , _rmPos = 
            [ RoomPos (V2 (w-20) (w-20)) pi S.empty NotLink 0
            , RoomPos (V2 (w-15) (w-25)) pi S.empty NotLink 0
            ]
        , _rmBound  = [[V2 0 0,V2 w w,V2 (-w) w]]
        }

quarterRoomSquare :: RandomGen g => Float -> State g Room
quarterRoomSquare w = do
    b <- takeOne 
        [   [ mntLS vShape (V2 0 (2*w-20)) (V3 0 (2*w-40) 70)
            , blockLine (V2 (negate $ w/2) (w/2)) (V2 0 w)
            ]
        ,   [ mntLS vShape (V2 0 (2*w-20)) (V3 0 (2*w-40) 70)
            , blockLine (V2 (negate w)  w   ) (V2 0 w)
            ]
        ,   [ mntLS iShape (V2 (0.7*w) (1.3*w)) (V3 (0.7*w-20)  (1.3*w-20) 70)
            , blockLine (V2 0 w) (V2 0 (w*2))
            ]
        ]
    let thepoly = [ map toV2 [(0,0),(w,w),(0,2*w),(-w,w)] ]
    pure $ defaultRoom
        { _rmPolys  = thepoly
        , _rmLinks  = map toBothLnk
            [ (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 ++ [ blockLine (V2 (w/2) (w/2)) (V2 0 w) ]
        , _rmPos = [ RoomPos p pi S.empty NotLink 0 
                    | p <- [V2 20 (2*w-40),V2 25 (2*w-45)] ]
        --, _rmBound = [map toV2 [(w,w),(0,2*w),(-w,w)]]
        , _rmBound = [ map toV2 [(0,0),(w,w),(0,2*w),(-w,w)] ]
        }
{- | A randomly generate room based on four randomly generated corners. 
Tight corridors, random placements. -}
randomFourCornerRoom :: RandomGen g => [Item] -> State g Room
randomFourCornerRoom its = do
    nCrits  <- state $ randomR (1,3)
    crits   <- takeN nCrits <=< shuffle $ [spreadGunCrit,pistolCrit,autoCrit,armourChaseCrit]
        ++ replicate 20 chaseCrit
    randomFourCornerRoomCrsIts crits its
{- | A randomly generate room based on four randomly generated corners. 
Tight corridors. -}
randomFourCornerRoomCrsIts :: RandomGen g => [Creature] -> [Item] -> State g Room
randomFourCornerRoomCrsIts crits its = do
    corners <- replicateM 4 . join $ takeOne [quarterRoomTri 100, quarterRoomSquare 100]
    let putitms  = map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) its
        putcrits = map (\cr -> sps0 (PutCrit cr) & plSpot .~ unusedSpotAwayFromLink 50) crits
    shuffleLinks 
        . (rmPmnts .++~ (sps0 putLamp : putitms ++ putcrits)) 
        . foldr1 combineRooms
        $ zipWith (\r a -> moveRoomBy (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 = 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
        ]
        ++ 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]
    , _rmName = "cenVault"
    }
  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) 1 (V2 (-21) 0) (V2 0 0) 2)
            $          sPS   (V2 0 (d-10)) 0 (PutSlideDr False col (cond' btid) 1 (V2   21  0) (V2 0 0) 2)
        ]
    cond' btid w' = _btState (_buttons w' IM.! btid) == BtOn