-- | Procedural creation of rooms and subroom parts.
module Dodge.Room.Procedural (
    roomRect,
    roomRectAutoLights,
    randomFourCornerRoom,
    randomFourCornerRoomCrsIts,
    centerVaultRoom,
    combineRooms,
--    linksAndPath,
--    makeGrid,
) where

import Linear
import Grid
import Dodge.Door.PutSlideDoor
import Dodge.Default.Wall
import Control.Monad
import Tile
import qualified Data.Set as S
import Data.Tile
import Dodge.Creature
import Dodge.Data.GenWorld
import Dodge.Default.Door
import Dodge.Default.Room
import Dodge.LevelGen.PlacementHelper
import Dodge.LevelGen.Switch
import Dodge.Placement.Instance
import Dodge.Placement.Shift
import Dodge.PlacementSpot
import Dodge.Room.Link
import Dodge.Room.Path
import Dodge.RoomLink
import Geometry
import LensHelp
import Picture
import RandomHelp

--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 -> Float -> Int -> Int -> Room
roomRect x y xn yn =
    defaultRoom
        { _rmPolys = [rectNSWE y 0 0 x]
        , _rmLinks = lnks
        , _rmName = "rect"
        , _rmPath = linksDAGToPath lnks $ latticeXsYs xs ys
        , _rmPos = gridRoomPos xs ys
        , _rmPmnts = []
        , _rmBound = [rectNSWE (y + 5) (-5) (-5) (x + 5)]
        , _rmFloor =
            Tiled
                [ Tile
                    { _tilePoly = rectNSWE y 0 0 x
                    , _tileZero = 0
                    , _tileTangentPos = V2 baseFloorTileSize 0
                    , _tileArrayZ = 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
    xs = take (xn + 1) [0,xd..] & each +~ 20
    ys = take (yn + 1) [0,yd..] & each +~ 20
    yd = (y - 40) / fromIntegral yn
    xd = (x - 40) / fromIntegral xn
    horilnks y' a e = xs <&> \x' -> RoomLink (rlt e) (V2 x' y') a
    vertlnks x' a e = ys <&> \y' -> RoomLink (rlt e) (V2 x' y') a
    rlt e = S.fromList [OnEdge e, InLink, OutLink]
    wlnks = vertlnks 0 (pi/2) West
    elnks = vertlnks x (-pi/2) East
    nlnks = horilnks y 0 North
    slnks = horilnks 0 pi South
    lnks = imap (g West) nlnks
        <> imap (g West) slnks
        <> imap (g South) elnks
        <> imap (g South) wlnks
    g c xi = rlType <>~ S.fromList [FromEdge c xi,FromEdge (revCard c) (xn - xi)]

gridRoomPos :: [Float] -> [Float] -> [RoomPos]
gridRoomPos xs ys = map makeonpos (grid xs ys) <> map makeoffpos (grid (mids xs) (mids ys))
  where
    yn = length ys - 1
    xn = length xs - 1
    grid as bs = [(V2 x' y', (xi,yi)) | (x',xi) <- zip as [0..], (y',yi) <- zip bs [0..]]
    makeonpos (p, a) = RoomPos p 0 (S.singleton $ RoomPosOnGrid $ makerpedges a) 
        (NotLink True) mempty
    makerpedges (a, b) =
        S.fromList
            [ PathFromEdge South b
            , PathFromEdge North (yn - b)
            , PathFromEdge East (xn - a)
            , PathFromEdge West a
            ]
    mids zs = zipWith (\a b -> 0.5 * (a + b)) zs $ tail zs
    makeoffpos (p, a) = RoomPos 
        p 0 (S.singleton $ RoomPosOffGrid $ makerpedges' a) (NotLink False) mempty
    makerpedges' (a, b) =
        S.fromList
            [ PathFromEdge South b
            , PathFromEdge North (yn - (b + 1))
            , PathFromEdge East (xn - (a + 1))
            , PathFromEdge West 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)
roomRectAutoLights :: RandomGen g => Float -> Float -> State g Room
roomRectAutoLights x y = do
    shp <- takeOne [vShape, lShape, jShape, liShape]
    let l1 = mntLightLnkShape shp $ resetPLUse $ rprBool $ \rp _ -> isInLnk rp   
        l2 = mntLightLnkShape shp $ resetPLUse $ rprBool $ \rp _ -> isOutLnk rp
    return $ roomRect x y (f x) (f y)
        & rmName .~ "autoRect"
        & rmPmnts .~ [ l1 , l2 ]
  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 = S.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 =
                foldMap
                    doublePairSet
                    [ (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 False) mempty
                , RoomPos (V2 (w -15) (w -25)) pi S.empty (NotLink False) mempty
                ]
            , _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 =
                foldMap
                    doublePairSet
                    [ (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 False) mempty
                | 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, 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 ::
    -- | Width
    Float ->
    -- | Height
    Float ->
    -- | Vault dimensions
    Float ->
    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 = mempty
            , _rmPmnts =
                [ sps0 $ PutWall (reverse $ rectNSWE d (d - 30) (d - 30) d) defaultWall
                , sps0 $ PutWall (reverse $ rectNSWE d (d - 30) (30 - d) (- d)) defaultWall
                , sps0 $ PutWall (reverse $ rectNSWE (- d) (30 - d) (d - 30) d) defaultWall
                , sps0 $ PutWall (reverse $ rectNSWE (- d) (30 - d) (30 - d) (- 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 NoWorldEffect NoWorldEffect) $
            \btid ->
                jspsJ (V2 0 (d -10)) 0 (putSlideDr (thedoor btid) thewall 1 (V2 (-21) 0) (V2 0 0)) $
                    sPS (V2 0 (d -10)) 0 (putSlideDr (thedoor btid) thewall 1 (V2 21 0) (V2 0 0))
        ]
    thewall = defaultDoorWall
    thedoor btid =
        defaultDoor
            & drTrigger .~ WdBlBtOn btid
            & drUpdate . drLerpSpeed .~ 2