--{-# LANGUAGE TupleSections #-}
module Dodge.Room.Room (
    shootingRange,
    weaponRoom,
    roomMiniIntro,
    roomCCrits,
    doubleCorridorBarrels,
    pistolerRoom,
    spawnerRoom,
    corDoor,
    doorCor,
    weaponBehindPillar,
    critsRoom,
    distributerRoom,
    critDeadEnd,
) where

import Linear
import Color
import Dodge.Placement.Instance.Pipe
import ShapePicture
import Shape
import Dodge.Default
import Dodge.Data.AmmoType
import qualified Data.Set as S
import Dodge.Cleat
import Dodge.Creature
import Dodge.Data.GenWorld
import Dodge.Default.Room
import Dodge.Item.Display
import Dodge.LevelGen.PlacementHelper
import Dodge.Placement.Instance
import Dodge.Placement.Random
import Dodge.PlacementSpot
import Dodge.Room.Airlock
import Dodge.Room.Corridor
import Dodge.Room.Door
import Dodge.Room.Girder
import Dodge.Room.Link
import Dodge.Room.Modify.Girder
import Dodge.Room.Pillar
import Dodge.Room.Procedural
import Dodge.RoomLink
import Dodge.Tree
import Geometry
import LensHelp
import MonadHelp
import RandomHelp

roomC :: RandomGen g => Float -> Float -> State g Room
roomC w h = do
    wallf <- takeOne [crystalLine, windowLine]
    maybeaddgird <- takeOne [return, addRandomGirderFrom West 0, addRandomGirderFrom North 0]
    maybeaddgird
        =<< shuffleLinks
        =<< ( roomRectAutoLights w h
                <&> rmLinks
                    %~ ( setInLinks (\rl -> S.fromList [FromEdge East 0, OnEdge South] `S.isSubsetOf` _rlType rl)
                            . setOutLinks (\rl -> OnEdge West `S.member` _rlType rl)
                       )
                <&> rmPmnts .:~ wallf (V2 (w / 2) 0) (V2 (w / 2) (h -60))
                <&> rmRandPSs .~ [farside]
            )
  where
    farside = do
        x <- state $ randomR (5, w / 2 - 20)
        y <- state $ randomR (5, h - 70)
        a <- state $ randomR (0, 2 * pi)
        return (V2 x y, a)

roomPadCut :: [Point2] -> Point2 -> Room
roomPadCut ps p =
    defaultRoom
        { _rmPolys = [ps]
        , _rmLinks = muout [(p, 0)] ++ muin [(V2 0 0, pi)]
        , _rmPath = doublePairSet (V2 0 0, p)
        }

branchWith :: Room -> [Tree Room] -> Tree Room
branchWith r = Node r . (return (cleatOnward door) :)

glassSwitchBack :: RandomGen g => State g Room
glassSwitchBack = do
    wth <- state $ randomR (200, 400)
    hgt <- state $ randomR (400, 600)
    wllen <- state $ randomR (60, wth / 2 -40)
    l2 <-
        mntLightLnkCond $
            rprBool $ \rp _ ->
                rp ^. rpType . rplsType . at (OnEdge West) == Just ()
                    && null (rp ^. rpPlacementUse)
    let hf = hgt / 5
        awindow h xl xr = windowLine (V2 xl h) (V2 xr h)
        plmnts =
            [ awindow hf (wth -60) wllen
            , awindow (2 * hf) (wth - wllen) 60
            , awindow (3 * hf) (wth -60) wllen
            , awindow (4 * hf) (wth - wllen) 60
            , blockLine (V2 0 (1 * hf)) (V2 wllen (1 * hf))
            , blockLine (V2 (wth - wllen) (2 * hf)) (V2 wth (2 * hf))
            , blockLine (V2 0 (3 * hf)) (V2 wllen (3 * hf))
            , blockLine (V2 (wth - wllen) (4 * hf)) (V2 wth (4 * hf))
            ]
                <> replicate 5 l2
    let northPSs = do
            cry <- randomRanges [3 * hf + 10, 4 * hf -10, 4 * hf + 10, 5 * hf -10]
            crx <- state $ randomR (wllen, wth - (wllen + 40))
            return (V2 crx cry, 1.5 * pi)
        midPS = return (V2 (wth -20) (hgt / 2 + 40), pi)
    return $
        roomRect wth hgt 2 4
            & rmPmnts .~ plmnts
            & rmRandPSs .~ [northPSs, midPS]
            & rmName .~ "glassSwitchBack"

glassSwitchBackCrits :: RandomGen g => Int -> State g Room
glassSwitchBackCrits i = glassSwitchBack <&> rmPmnts <>~ fmap f [0 .. i -1]
  where
    f j = psPtPl (PSRoomRand j (uncurry PS)) randC1

-- note there used to be a creature with a minigun in glassSwitchBackCrits, has
-- been removed 25.10.01
miniTree2 :: RandomGen g => State g (Tree Room)
miniTree2 = do
    rm <- glassSwitchBackCrits 2 >>= shuffleLinks . restrictInLinks (\p -> (sndV2 . fst) p < 70)
    return $ branchWith rm (replicate 3 $ treePost [door, corridor, critInDeadEnd])

-- So, the idea is to attach outer children to the bottommost right nodes
-- inside an inner tree
-- no idea what was going on here...
roomMiniIntro :: RandomGen g => State g (MetaTree Room String)
roomMiniIntro = do
    midroom <- join $ takeOne [miniTree2] --,glassLesson]
    rToOnward "roomMiniIntro" midroom

roomCenterPillar :: RandomGen g => State g Room
roomCenterPillar = do
    l1 <- mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isInLnk rp)
    l2 <-
        mntLightLnkCond $
            resetPLUse (rprBool $ \rp _ -> isOutLnk rp)
                & psFallback ?~ mntLightLnkCond' (resetPLUse useUnusedLnk)
    let plmnts =
            [ blockLine (V2 115 115) (V2 115 125)
            , blockLine (V2 125 115) (V2 125 125)
            , l1
            , l2
            ]
    addHighGirder'
        =<< ( shuffleLinks . restrictInLinks ((\p -> dist p (V2 120 0) < 10) . fst) $
                cleatSide $
                    set rmPmnts plmnts $
                        set rmName "roomCenterPillar" $
                            roomRect 240 240 2 2
            )

weaponEmptyRoom :: State StdGen (Tree Room)
weaponEmptyRoom = do
    w <- state $ randomR (220, 300)
    h <- state $ randomR (220, 300)
    wp <- randFirstWeapon
    thelight <- mntLightLnkCond useUnusedLnk
    let plmnts =
            [ sPS (V2 (w / 2) (h -40)) 0 $ PutFlIt wp
            , sPS (V2 20 20) (pi / 2) randC1
            , sPS (V2 (w -20) 20) (pi / 2) randC1
            , thelight
            ]
        f (V2 x y, a) = (a == pi && x > 25 && x < w - 25) || (a /= 0 && y > w - 30)
    rm <-
        addHighGirder >=> shuffleLinks $
            restrictRMInLinksPD f (roomRect w h 2 2 & rmPmnts .~ plmnts)
    return $ treePost [corridor, cleatSide $ cleatOnward rm]

weaponUnderCrits :: RandomGen g => State g (MetaTree Room String)
weaponUnderCrits = do
    let addwpat p = rmPmnts .:~ sPS p 0 (RandPS $ fmap PutFlIt randFirstWeapon)
        continuationRoom =
            treePost
                [ addwpat (V2 20 0) corridorN
                , addwpat (V2 20 0) corridorN
                , cleatOnward $
                    corridorN & rmPmnts
                        .~ [ sPS (V2 20 0) (negate $ pi / 2) randC1
                           , sPS (V2 20 20) (pi / 2) randC1
                           ]
                ]
    rcp <- roomCenterPillar
    rmpils <- roomPillars 30 240 240 2 2
    deadEndRoom' <- takeOne [addwpat (V2 120 20) rmpils, addwpat (V2 120 20) $ cleatSide rcp]
    junctionRoom <- takeOne [tEast, tWest]
    rToOnward "weaponUnderCrits" $
        treeFromTrunk [corridorN, corridorN] $
            Node junctionRoom [continuationRoom, pure deadEndRoom']

weaponBehindPillar :: RandomGen g => State g (Tree Room)
weaponBehindPillar = do
    wpa <- state $ randomR (0, pi)
    wpos <- takeOne [V2 120 160, V2 80 40, V2 160 40, V2 220 200, V2 40 200, V2 120 35]
    cpos <- takeOne $ [V2 x y | x <- [20, 220], y <- [20, 40]] ++ [V2 120 160, V2 120 200]
    rcp <- roomCenterPillar
    return $
        treePost
            [ corridor
            , rcp & rmPmnts
                ++.~ [ sPS wpos wpa $ RandPS $ fmap PutFlIt randFirstWeapon
                     , sPS cpos (argV $ V2 120 80 -.- cpos) randC1
                     ]
            , cleatOnward $ set rmPmnts [sPS (V2 20 60) (negate $ pi / 2) randC1] corridorN
            ]

weaponBetweenPillars :: State StdGen (MetaTree Room String)
weaponBetweenPillars = do
    (w, wn) <- takeOne [(240, 2), (340, 3)]
    (h, hn) <- takeOne [(240, 2), (340, 3)]
    let wpPos = rprBool $ \rp r ->
            and
                [ rpIsOnGrid rp
                , null $ _rpPlacementUse rp
                , notLink (_rpType rp)
                , any ((< 100) . dist (_rpPos rp)) (usedRoomInLinkPoss r)
                ]
    ncrits <- state $ randomR (1, 3)
    wp <- randFirstWeapon
    critPlacementSpots <- replicateM ncrits $
        randDirPS $
            rprBool $ \rp r ->
                rpIsOnGrid rp
                    && null (_rpPlacementUse rp)
                    && all ((> 100) . dist (_rpPos rp)) (usedRoomLinkPoss r)
    ( roomPillars 30 w h wn hn
            <&> rmPmnts .++~ map (`sps` randC1) critPlacementSpots ++ [sps wpPos (PutFlIt wp)]
            <&> cleatOnward
        )
        >>= rToOnward ("weaponBetweenPillars_" ++ itemString wp) . pure

weaponLongCorridor :: RandomGen g => State g (Tree Room)
weaponLongCorridor = do
    rt <- takeOne [tEast, tWest]
    connectingRoom <- takeOne [tEast & rmPmnts .~ [spanLightI (V2 (-30) 40) (V2 (-30) 80)]]
    i1 <- state $ randomR (2, 5)
    i2 <- state $ randomR (2, 5)
    let branch1 =
            treeFromTrunk
                (replicate i1 corridorN)
                (pure . cleatSide . cleatOnward $ putCrs connectingRoom)
    let branch2 = treeFromTrunk (replicate i2 corridorN) (pure . cleatSide $ putWp corridor)
    return $ Node rt [branch1, branch2]
  where
    putCrs = rmPmnts .++~ [sPS (V2 10 40) (- pi / 2) randC1, sPS (V2 (-10) 40) (- pi / 2) randC1]
    putWp = rmPmnts .~ [sPS (V2 20 60) 0 $ RandPS $ fmap PutFlIt randFirstWeapon, spanLightI (V2 0 40) (V2 40 40)]

critInDeadEnd :: Room
critInDeadEnd = deadEndRoom & rmPmnts .~ [sPS (V2 0 0) 0 randC1]

-- this one should face the inlink door
critDeadEnd :: Room
critDeadEnd = deadEndRoom & rmPmnts .~ [sPS (V2 0 0) (pi/2) randC1]

deadEndRoom :: Room
deadEndRoom =
    defaultRoom
        { _rmPolys = [rectNSWE 40 (-20) (-20) 20]
        , _rmLinks = muout (init lnks) ++ muin [last lnks]
        , _rmPath = mempty
        , _rmPmnts = [sPS (V2 0 (-10)) 0 putLamp]
        , _rmBound = [rectNSWE 20 (-20) (-30) 30]
        , _rmName = "deadEndRoom"
        }
  where
    lnks = [(V2 0 30, 0)]

{- A random Either tree with a weapon and melee monster challenge.  -}
weaponRoom :: State StdGen (MetaTree Room String)
weaponRoom =
    join $
        takeOne
            [ weaponEmptyRoom >>= rToOnward "weaponEmptyRoom"
            , weaponUnderCrits
            , weaponBehindPillar >>= rToOnward "weaponBehindPillar"
            , weaponBetweenPillars --  >>= rToOnward "weaponBetweenPillars"
            , weaponLongCorridor >>= rToOnward "weaponLongCorridor"
            ]

roomCCrits :: RandomGen g => Int -> State g Room
roomCCrits i =
    roomC 200 200
        <&> rmPmnts .++~ replicate i (psPtPl (PSRoomRand 0 (uncurry PS)) randC1)

doubleCorridorBarrels :: RandomGen g => State g Room
doubleCorridorBarrels = do
    h <- state $ randomR (200, 300)
    let cond x = (sndV2 . fst) x < h - 40
    return $
        restrictInLinks cond $
            roomRect 100 h 1 1 & rmPmnts
                .~ [ blockLine (V2 50 50) (V2 50 h)
                   , sPS (V2 25 (h -25)) (negate pi / 2) $ PutCrit $ addArmour autoCrit
                   , sPS (V2 75 (h -80)) 0 putLamp
                   ]
                ++ [ sPS p 0 $ PutCrit explosiveBarrel
                   | p <- [V2 75 (h -30), V2 75 (h -60), V2 85 (h -10), V2 85 (h -45)]
                   ]

shootersRoom' :: RandomGen g => State g Room
shootersRoom' = do
    w <- state $ randomR (200, 300)
    x1 <- state $ randomR (20, w / 3 -20)
    x2 <- state $ randomR (w / 3 + 20, 2 * w / 3 -20)
    x3 <- state $ randomR (2 * w / 3 + 20, w -20)
    y1 <- state $ randomR (280, 550)
    y2 <- state $ randomR (280, 550)
    y3 <- iterateWhile (\y' -> abs (y1 - y2) < 60 && abs (y2 - y') < 60) $ state $ randomR (280, 560)
    x4 <- state $ randomR (60, w -60)
    y4 <- state $ randomR (40, 150)
    let bln x y = putBlockN (x + 25) (x -25) (y + 20) (y + 10)
        blv x y = putBlockV (x + 25) (x -25) (y + 20) (y + 10)
        plmnts =
            bln x1 y1 ++ bln x2 y2 ++ bln x3 y3 ++ blv x4 y4
                ++ [ spanLightI (V2 (-10) 200) (V2 (w / 2) 200)
                   , spanLightI (V2 (w / 2) 200) (V2 (w + 10) 200)
                   ]
        toPS x y = return (V2 x y, -0.5 * pi)
    roomRectAutoLights w 600
        <&> rmPmnts .~ plmnts
        <&> rmRandPSs .~ [toPS x1 y1, toPS x2 y2, toPS x3 y3]

shootersRoom1 :: RandomGen g => State g Room
shootersRoom1 = do
    pl <-
        takeOne $
            map
                (\i -> psPtPl (PSRoomRand i (uncurry PS)) (PutCrit autoCrit))
                [0, 1, 2]
    shootersRoom' <&> rmPmnts
        .:~ pl

shootersRoom :: RandomGen g => State g Room
shootersRoom =
    shootersRoom' <&> rmPmnts
        .++~ map (\i -> psPtPl (PSRoomRand i (uncurry PS)) (PutCrit autoCrit)) [0, 1, 2]

-- TODO stop from spawning on inlinks fromedge
pistolerRoom :: RandomGen g => State g Room
pistolerRoom = do
    (w, wn) <- takeOne [(200, 3), (255, 4)]
    roomPillars 10 w 200 wn 3 <&> rmPmnts
        .++~ replicate
            3
            ( psPtPl
                (rprBool $ \rp _ -> null (_rpPlacementUse rp) && rpIsOnGrid rp)
                (PutCrit chaseCrit)
            )

shootingRange :: RandomGen g => State g (MetaTree Room String)
shootingRange = do
    rm1 <-
        shootersRoom1
            >>= shuffleLinks . restrictInLinks (\(V2 _ y, _) -> y < 40)
                . restrictOutLinks (\(V2 _ y, r) -> y > 200 && r /= 0)
    rm2 <-
        shootersRoom
            >>= shuffleLinks
                . restrictInLinks (\(V2 x y, _) -> y < 10 && x > 20 && x < 180)
                . restrictOutLinks (\(V2 _ y, r) -> y > 200 && r /= 0)
    rm3 <-
        shootersRoom
            >>= shuffleLinks
                . restrictInLinks (\(V2 x y, _) -> y < 10 && x > 20 && x < 180)
                . restrictOutLinks (\(_, r) -> r == 0)
    let padcutroom =
            roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
                & rmPmnts .:~ spanLightI (V2 (-80) 10) (V2 80 10)
    rToOnward "shootingRange" $
        treePost
            [ rm1
            , padcutroom
            , rm2
            , padcutroom
            , cleatOnward rm3
            ]

spawnerRoom :: RandomGen g => State g (Tree Room)
spawnerRoom = do
    x <- state $ randomR (250, 300)
    y <- state $ randomR (300, 400)
    roomWithSpawner <-
        roomC x y <&> rmPmnts
            .:~ psPtPl
                ( rprBool $ \rp _ ->
                    null (_rpPlacementUse rp) && rpIsOnGrid rp
                        && xV2 (_rpPos rp) < x / 2
                        && yV2 (_rpPos rp) < y / 2
                )
                (PutCrit spawnerCrit)
    aRoom <- airlock
    return $ treeFromTrunk [aRoom, corridor] $ pure $ cleatOnward roomWithSpawner

doorCor :: RandomGen g => State g (MetaTree Room String)
doorCor = do
    cor <- shuffleLinks (cleatOnward corridor) <&> rmPmnts .~ []
    return $ tToBTree "doorCor" $ treePost [door, cor]

corDoor :: RandomGen g => State g (MetaTree Room String)
corDoor = do
    cor <- shuffleLinks corridor <&> rmPmnts .~ []
    return $ tToBTree "corDoor" $ treePost [cor,cor, cleatOnward door]

critsPillarRoom :: Int -> State LayoutVars Room
critsPillarRoom i = do
    xs <- takeN i $ [V2 x y | x <- [20, 220], y <- [20, 40]] ++ [V2 120 160, V2 120 200]
    rcp <- roomCenterPillar
    return $ rcp & rmPmnts <>~ fmap f xs
  where
    f x = sPS x (argV $ V2 120 80 -.- x) randC1

critsRoom :: Int -> State LayoutVars (Tree Room)
critsRoom i =
    join $
        takeOne
            [ return <$> roomCCrits i
            , return <$> critsPillarRoom i
            , return <$> glassSwitchBackCrits i
            ]

distributerRoom :: AmmoType -> Int -> State LayoutVars Room
distributerRoom atype aamount = do
    i <- nextLayoutInt
    i1 <- nextLayoutInt
    w <- state $ randomR (100, 400)
    h <- state $ randomR (200, 400)
    r <- roomRectAutoLights w h
    let mcstore = defaultMachine
            & mcMaterial .~ Metal
            & mcType .~ McStorage atype aamount
        mcdist mj = defaultMachine
            & mcMaterial .~ Metal
            & mcType .~ McDistributer mj
        store = sps (unusedOffPathAwayFromLink 50) 
            (PutMachine (reverse $ polyCirc 4 20) mcstore Nothing) & plExternalID ?~ i
        dst gw = let mj = gw ^? genPmnt . ix i . plMID . _Just
            in  putTerminal (mcdist mj) (defaultTerminal & tmBootLines .~ tmDistributeLines
                        & tmRebootOnAccess .~ True
                        )
                    & plSpot .~ unusedOffPathAwayFromLink 50
                    & plExternalID ?~ i1
        thepipe gw = 
            let p1 = gw ^?! genPmnt . ix i . plSpot . psPos
                p2 = gw ^?! genPmnt . ix i1 . plSpot . psPos
            in sps (PS p1 0) 
                (PutForeground 
                    (ForegroundShape 0 0 
                        (noPic . colorSH orange $ horPipe 70 0 (p2 - p1)
                            <> translateSH (V3 0 0 30) (verticalPipe (70 - 30))
                            <> translateSH (0 & _xy .~p2 - p1) (verticalPipe 70)
                        )
                    )
                )
    return $ r & rmPmnts .:~ store
        & rmInPmnt <>~ [(0,dst),(1,thepipe)]
        & rmLinks %~ setInLinksByType (OnEdge South)
        & rmLinks %~ setOutLinks (not . S.member (OnEdge South) . _rlType)

tmDistributeLines :: [TerminalLine]
tmDistributeLines = [TLine 1 [TerminalLineConst "ATTEMPTING TO DISTRIBUTE MATERIAL..." white] TmDistributeAmmo]