--{-# LANGUAGE TupleSections #-}
module Dodge.Room.Room 
    ( shootingRange
    , weaponRoom
    , roomMiniIntro
    , roomCCrits
    , doubleCorridorBarrels
    , pistolerRoom
    , spawnerRoom
    , corDoor
    ) where
import Dodge.Cleat
import Dodge.Item.Display
import Dodge.Data
import Dodge.PlacementSpot
import Dodge.RoomLink
import Dodge.Default.Room
import Dodge.Item.Weapon
import Dodge.Creature
import Dodge.Room.Pillar
import Dodge.Room.Girder
import Dodge.Room.Modify.Girder
import Dodge.LevelGen.Data
import RandomHelp
import Dodge.Tree
import Dodge.Placement.Instance
--import Dodge.LevelGen.Data
import Dodge.Room.Procedural
import Dodge.Room.Corridor
--import Dodge.Room.Tanks
import Dodge.Room.Link
import Dodge.Room.Door
import Dodge.Room.Airlock
import Geometry
import MonadHelp
import LensHelp

import qualified Data.Set as S

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 (roomRectAutoLinks 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  = [(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)
    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))
            , sPS (V2 (wth/2) (hgt/2)) 0 putLamp
            ]
    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 => State g Room
glassSwitchBackCrits = glassSwitchBack <&> rmPmnts .++~ 
    [ spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit miniGunCrit)
    , spNoID (PSRoomRand 1 (uncurry PS)) randC1
    ]

miniTree2 :: RandomGen g => State g (Tree Room)
miniTree2 = do
    rm <- glassSwitchBackCrits >>= 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
    addHighGirder' =<< (shuffleLinks . restrictInLinks ((\p -> dist p (V2 120 0) < 10) . fst) 
        $ cleatSide
        $ set rmPmnts plmnts 
        $ set rmName "roomCenterPillar"
        $ roomRect 240 240 2 2
        )
  where 
    plmnts = 
        [ blockLine (V2 115 115) (V2 115 125)
        , blockLine (V2 125 115) (V2 125 125)
--        , mntLightLnkCond useUnusedLnk
        , mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isInLnk rp)       
        , mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isOutLnk rp)       
        ]

{- Probabilites of the type of the first floor weapon.  -}
randFirstWeapon :: State StdGen Item
randFirstWeapon = takeOne $
    replicate 10 pistol
    ++ replicate 5 (bangStick 4)
    ++ replicate 5 (bangCaneX 3)
    ++ replicate 5 bangCone
    ++ [lasGun]

weaponEmptyRoom :: RandomGen g => State g (Tree Room)
weaponEmptyRoom = do
    w <- state $ randomR (220,300)
    h <- state $ randomR (220,300)
    let plmnts = 
            [sPS (V2 (w/2)  (h-40)) 0      $ RandPS $ fmap PutFlIt randFirstWeapon
            ,sPS (V2 20     20)     (pi/2) randC1
            ,sPS (V2 (w-20) 20)     (pi/2) randC1
            ,mntLightLnkCond useUnusedLnk
            ]
        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 => Int -> State g (MetaTree Room String)
weaponUnderCrits i = do
    let addwpat p = rmPmnts .:~ PickOnePlacement i (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 
            [ rpIsOnPath rp
            , _rpPlacementUse rp == 0
            , _rpLinkStatus rp == NotLink
            , any ((<100) . dist (_rpPos rp)) (usedRoomInLinkPoss r)
            ]
    ncrits <- state $ randomR (1,3)
    wp <- randFirstWeapon
    critPlacementSpots <- replicateM ncrits $ randDirPS $ rprBool $ \rp r -> 
        rpIsOnPath rp
        && _rpPlacementUse rp == 0
        && 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]

deadEndRoom :: Room
deadEndRoom = defaultRoom
    { _rmPolys = [rectNSWE 40 (-20) (-20) 20 ]
    , _rmLinks = muout (init lnks) ++ muin [last lnks]
    , _rmPath  = []
    , _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 :: Int -> State StdGen (MetaTree Room String)
weaponRoom i = join $ takeOne 
    [ weaponEmptyRoom       >>= rToOnward "weaponEmptyRoom"
    , weaponUnderCrits i  -- this int is used for PickOnePlacement
    , weaponBehindPillar    >>= rToOnward "weaponBehindPillar"
    , weaponBetweenPillars--  >>= rToOnward "weaponBetweenPillars"
    , weaponLongCorridor    >>= rToOnward "weaponLongCorridor"
    ]

roomCCrits :: RandomGen g => Int -> State g Room
roomCCrits i = roomC 200 200
    <&> rmPmnts .++~ replicate i (spNoID (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)
    return $ set rmPmnts plmnts $ roomRectAutoLinks w 600
        & rmPmnts .~ plmnts
        & rmRandPSs .~ [toPS x1 y1,toPS x2 y2,toPS x3 y3]

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

shootersRoom :: RandomGen g => State g Room
shootersRoom = shootersRoom' <&> rmPmnts .++~
    map (\i -> spNoID (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 
        (spNoID (rprBool $ \rp _ -> _rpPlacementUse rp == 0 && rpIsOnPath rp) 
        (PutCrit pistolCrit))

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 .:~ spNoID 
        (rprBool $ \rp _ -> _rpPlacementUse rp == 0 && rpIsOnPath rp
                        && xV2 (_rpPos rp) < x/2 && yV2 (_rpPos rp) < y/2 ) 
        (PutCrit spawnerCrit)
    aRoom <- airlock
    return $ treeFromTrunk [ aRoom, corridor] $ pure $ cleatOnward roomWithSpawner

corDoor :: State StdGen (MetaTree Room String)
corDoor = do
    cor <- shuffleLinks $ cleatOnward corridor
    return $ tToBTree "corDoor" $ treePost [door,cor]