{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}

-- | Rooms containing long doors, probably with a big reveal behind them.
module Dodge.Room.LongDoor where

import Dodge.Placement.Instance.Block
import Dodge.Base.CardinalPoint
import Dodge.Room.Modify
import qualified Data.IntMap.Strict as IM
import Dodge.Default
import Control.Monad
import Data.Maybe
import qualified Data.Set as S
import Dodge.Cleat
import Dodge.Creature
import Dodge.Data.GenWorld
import Dodge.Default.Door
import Dodge.Default.Room
import Dodge.Door.PutSlideDoor
import Dodge.LevelGen.PlacementHelper
import Dodge.LevelGen.Switch
import Dodge.LightSource
import Dodge.Placement.Instance
import Dodge.PlacementSpot
import Dodge.Room.Door
import Dodge.Room.Link
import Dodge.Room.Procedural
import Dodge.RoomLink
import Dodge.Terminal
import Dodge.Tree
import Geometry
import LensHelp
import Linear
import Picture
import RandomHelp
import ShapePicture

twinSlowDoorRoom ::
    -- | Half width
    Float ->
    -- | Half height
    Float ->
    -- | Inner width
    Float ->
    Room
twinSlowDoorRoom w h x =
    defaultRoom
        { _rmPolys = ps
        , _rmLinks =
            map
                (uncurry outLink)
                [ (V2 w (h / 2), negate $ pi / 2)
                , (V2 (- w) (h / 2), pi / 2)
                ]
                ++ [inLink (V2 0 (- h)) pi]
        , _rmPath = mempty
        , _rmPmnts =
            [ pContID (PS (V2 0 (h -5)) pi) (PutButton $ makeButton col NoWorldEffect) $
                \btid -> jsps0J (putSlideDr (thedoor btid) thewall 1 (V2 x 1) (V2 x h)) $
                    ps0 (putSlideDr (thedoor btid) thewall 1 (V2 (- x) 1) (V2 (- x) h)) $
                        \_ -> jps0' (PutLS (lsColPos (V3 0.75 0 0) (V3 0 (h -1) lampheight))) $
                            const Nothing -- jsps0 $ PutProp $ addColorChange (fromJust $ _plMID lspl) did $ lampCoverWhen (WdBlDoorMoving did) (V2 0 (h -1)) lampheight
            ]
        , _rmBound = ps
        , _rmName = "twinSlowDoorRoom"
        , _rmViewpoints = [V2 0 h]
        }
  where
    --thewall = switchWallCol red
    thewall = defaultDoorWall
    lampheight = 41
    ps =
        [ rectNSWE h 0 (- w) w
        , rectNSWE 20 (- h) (negate x) x
        ]
    thedoor btid =
        defaultDoor
            & drUpdate . drLerpSpeed .~ 0.5
            & drTrigger .~ WdBlBtOn btid
    col = dim $ dim $ bright red

twinSlowDoorChasers :: RandomGen g => State g Room
twinSlowDoorChasers = do
    ps <- takeN 4 $ [V2 x y | x <- [-65, 65], y <- [20, 40 .. 180]]
    let plmnts = map (\p -> sPS p 0 $ PutCrit chaseCrit) ps
    return $ twinSlowDoorRoom 80 200 40 & rmPmnts %~ (plmnts ++)

southPillarsRoom :: RandomGen g => Float -> Float -> Float -> State g Room
southPillarsRoom x y h = addSouthPillars x h =<< roomRectAutoLights x y

addSouthPillars :: RandomGen g => Float -> Float -> Room -> State g Room
addSouthPillars x h r = do
    let pillarsa = []
        pillarsb = concat [putBlockRect (i * x / 5 -20) (i * x / 5 + 20) (h / 2 -20) (h / 2 + 20) | i <- [1 .. 4]]
        pillarsc = concat [putBlockRect (i * x / 3 -20) (i * x / 3 + 20) (h / 2 -20) (h / 2 + 20) | i <- [1, 2]]
    pillars <- takeOne [pillarsa, pillarsb, pillarsc]
    return $ r & rmPmnts .++~ pillars

-- should just be able to attach the mounts to the door directly
addButtonSlowDoor :: RandomGen g => Float -> Float -> Room -> State g Room
addButtonSlowDoor x h =
    shuffleLinks
        . setOutLinksPD (f (> h + 40))
        . setInLinksPD (f (< h - 40))
        . (rmPmnts <>~ [butDoor, theterminal])
        . (rmBound .:~ openDoorBound)
  where
    f g y = g $ y ^. _1 . _y
    theterminal =
        putMessageTerminal (simpleTermMessage themessage)
            & plSpot
                .~ rprBoolShift
                    (isUnusedLnkType InLink)
                    (shiftByV2 (V2 0 (-10)) <&> (,S.singleton UsedPosLow))
    themessage = ["WARNING:", "LARGE BIOMASS DETECTED"]
    openDoorBound = reverse $ rectNSWE (h + 5) (h - 5) (3 * x / 2) (- x / 2)
    butDoor = putLitButOnPos
        (dim $ light red)
        (rprBool (isUnusedLnkType InLink))
        $ \btplmnt -> Just
            . putDoubleDoorThen
                defaultDoorWall
                30
                (V2 0 h)
                (V2 x h)
                (defaultDoor & drTrigger .~ WdBlBtOn (fromJust $ _plMID btplmnt)
                    & drUpdate . drLerpSpeed .~ 0.5)
            $ \dr1 dr2 ->
                Just
                    . sps0
                    . PutWorldUpdate
                    . const
                    . const
                    $ domount dr1 id . domount dr2 negate
    domount drx g =
        gwWorld . cWorld . lWorld . doors . ix (drx ^?! plMID . _Just)
            . drMounts
            .~ [ MountedSPic (noPic $ aBar 50 $ g <$> [V2 lsx 9, V2 lsx ly, lp])
               , MountedLight (V3 (lx - 1) ly 50 & _xy %~ g) 200 0.5
               ]
    lsx = 30
    lp@(V2 lx ly) = V2 100 (-20)

makeDumbSwitch :: Int -> Button
makeDumbSwitch i = defaultButton & btEvent .~ ButtonDumbSwitch i

slowCrushRoom :: RandomGen g => State g Room
slowCrushRoom = do
    rm <- shuffleLinks =<< roomRectAutoLights 220 100
    let rm' = removeLights rm
            & rmPmnts .~ [spanLightI (V2 0 60) (V2 35 100)
                , spanLightI (V2 220 60) (V2 185 100)
                ]
    crs <- takeOne [[]
        , [sPS (V2 200 10) (0.8* pi) randC1]
        , [sPS (V2 200 10) (0.8* pi) randC1 , sPS (V2 210 20) (0.8* pi) randC1]
        , [sPS (V2 200 80) pi randC1]
        , [sPS (V2 200 80) pi randC1 , sPS (V2 210 90) pi randC1]
        ]
    return $ rm'
        & rmBound .:~ rectNSWE 0 (-50) 0 220
        & rmLinks %~ setOutLinks (\rl -> onside East $ rl ^. rlType)
        & rmLinks %~ setInLinks (\rl -> onside West $ rl ^. rlType)
        & rmPmnts <>~
         [ps0 (PutTrigger False) $ \i -> Just $
            pContID (apos West) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
            pContID (apos East) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
        sps0 (PutDoor (dr & drTrigger .~ WdTrig i) defaultDoorWall) & plIDCont . mapped . mapped ?~
        sps0 (PutDoor (dr1 & drTrigger .~ WdTrig i) defaultDoorWall)
        ] <> crs
  where
    onside x s = (OnEdge x `S.member` s)
        || (OnEdge South `S.member` s && FromEdge x 0 `S.member` s)
        || (OnEdge North `S.member` s && FromEdge x 0 `S.member` s)
    dr = defaultDoor
        & drUpdate .~ DoorLerp 0.01
        & drZeroPos .~ (V2 75 (-40), 0)
        & drOnePos .~ (V2 75 50, 0)
        & drFootPrint .~ IM.fromDistinctAscList (zip [0..] (loopPairs . reverse $ rectWH 34 50))
    dr1 = dr
        & drOnePos .~ (V2 145 (-40), 0)
        & drZeroPos .~ (V2 145 50, 0)
    apos edge = rprBool (t edge) & psSelect . mapped . mapped . _Just . _1 %~ f
    f ps = case ps of
        PS _ r -> ps & psRot +~ pi & psPos +~ rotateV r (V2 0 (-5))
        _ -> ps
    t edge rp _ = case _rpType rp of
        UnusedLink s -> onside edge s
        _ -> False

pushCaverns :: RandomGen g => State g Room
pushCaverns = do
    rm <- shuffleLinks . removeLights =<< roomRectAutoLights 250 100
    iside <- takeOne [North,South]
    oside <- takeOne [North,South]
    crs <- takeOne [[] ]
    l <- takeOne 
            [ [MountedLight (V3 55 0 50) 200 0.5 , MountedSPic (noPic $ aBar 55 [V2 10 0,V2 60 0])]
            , [MountedLight (V3 20 0 50) 200 0.5 , MountedSPic (noPic $ aBar 55 [V2 10 0,V2 22 0])]
            , [MountedLight (V3 30 45 50) 200 0.5 , MountedSPic (noPic $ aBar 55 [V2 10 45,V2 32 45])]
            , [MountedLight (V3 20 45 50) 200 0.5 
                , MountedSPic (noPic $ aBar 55 [V2 10 45,V2 60 45])
                , MountedSPic (noPic $ aBar 55 [V2 10 (-45),V2 60 (-45)])]
            ]
    let lts = [spanColLightI (V3 0.5 0 0) 40 (V2 5 (g iside)) (V2 10 (g iside - dorot' iside 10))
                & plType . putLS . lsParam . lsRad .~ 30
            ,spanColLightI (V3 0.5 0 0) 40 (V2 245 (g oside)) (V2 240 (g oside - dorot' oside 10))
                & plType . putLS . lsParam . lsRad .~ 30]
    return $ rm
        & rmPolys <>~ [dorot iside (trapTBH 20 10 10) & each +~ V2 20 (g iside) 
            ,dorot oside (trapTBH 20 10 10) & each +~ V2 230 (g oside)]
        & rmBound .~ 
            rectNSWE 100 0 (-10) 260:
            [dorot iside (trapTBH 20 10 10) & each +~ V2 20 (g iside) 
            ,dorot oside (trapTBH 20 10 10) & each +~ V2 230 (g oside)]
        & rmLinks %~ setInLinks (\rl -> slinks West iside $ rl ^. rlType)
        & rmLinks %~ setOutLinks (\rl -> slinks East oside $ rl ^. rlType)
        & rmPmnts <>~
         [ps0 (PutTrigger False) $ \i -> Just $
            pContID (spos (slinks West $ cardReverse iside) f) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
            pContID (spos (slinks East $ cardReverse oside) f) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
        sps0 (PutDoor (dr & drTrigger .~ WdTrig i
                        & drMounts .~ l) defaultDoorWall) & plIDCont . mapped . mapped ?~
        sps0 (PutDoor (dr1 & drTrigger .~ WdTrig i
                    & drMounts .~ (l & each . moPos . _xy %~ rotateV pi)) defaultDoorWall)
        , psPtPl (spos (slinks West $ cardReverse iside) f') (lowBlock Stone (greyN 0.5) 10 $ rectWH 20 10)
        , psPtPl (spos (slinks East $ cardReverse oside) f') (lowBlock Stone (greyN 0.5) 10 $ rectWH 20 10)
        ] 
        <> lts
        <> crs
  where
    dorot = \case
        North -> id
        _ -> fmap negate
    dorot' = \case
        North -> id
        _ -> negate
    slinks x y s = (FromEdge x 0 `S.member` s) && OnEdge y `S.member` s
    dr = defaultDoor
        & drUpdate .~ DoorLerp 0.005
        & drZeroPos .~ (V2 (-5) 50, 0)
        & drOnePos .~ (V2 145 50, 0)
        & drFootPrint .~ IM.fromDistinctAscList (zip [0..] (loopPairs . reverse $ rectWH 10 47))
    dr1 = dr
        & drOnePos .~ (V2 255 50, 0)
        & drZeroPos .~ (V2 105 50, 0)
    f ps = case ps of
        PS _ r -> ps & psRot +~ pi & psPos +~ rotateV r (V2 0 5)
        _ -> ps
    f' ps = case ps of
        PS _ r -> ps & psRot +~ pi & psPos +~ rotateV r (V2 0 10)
        _ -> ps
    spos h f'' = rprBool (t' h) & psSelect . mapped . mapped . _Just . _1 %~ f''
    t' h rp _ = case _rpType rp of
        UnusedLink s -> h s
        _ -> False
    g = \case
        North -> 0
        _ -> 100


slowCrush90 :: RandomGen g => State g Room
slowCrush90 = do
    rm <- shuffleLinks =<< roomRectAutoLights 170 100
    (ilinks, olinks) <- shufflePair (cornlinks,onside West)
    let rm' = removeLights rm
            & rmPmnts .~ [spanLightI (V2 0 60) (V2 35 100)
                , spanLightL (V2 120 39) (V2 170 39) (V2 120 0)
                ]
    crs <- takeOne [[] ]
    return $ rm'
        & rmBound <>~ [rectNSWE 0 (-55) 0 110
            , rectNSWE 100 40 170 220
            ]
        & rmLinks %~ setOutLinks (\rl -> olinks $ rl ^. rlType)
        & rmLinks %~ setInLinks (\rl -> ilinks $ rl ^. rlType)
        & rmPmnts <>~
         [ps0 (PutTrigger False) $ \i -> Just $
            pContID (spos ilinks) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
            pContID (spos olinks) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
        sps0 (PutDoor (dr & drTrigger .~ WdTrig i) defaultDoorWall) & plIDCont . mapped . mapped ?~
        sps0 (PutDoor (dr1 & drTrigger .~ WdTrig i) defaultDoorWall)
        ] <> crs
  where
    onside x s = (OnEdge x `S.member` s)
        || (OnEdge South `S.member` s && FromEdge x 0 `S.member` s)
        || (OnEdge North `S.member` s && FromEdge x 0 `S.member` s)
    cornlinks s = 
        (OnEdge South `S.member` s && FromEdge East 0 `S.member` s)
        || (OnEdge East `S.member` s && FromEdge South 0 `S.member` s)
    dr = defaultDoor
        & drUpdate .~ DoorLerp 0.01
        & drZeroPos .~ (V2 75 (-5), 0)
        & drOnePos .~ (V2 75 50, 0)
        & drFootPrint .~ IM.fromDistinctAscList (zip [0..] (loopPairs . reverse $ rectWH 34 50))
    dr1 = dr
        & drOnePos .~ (V2 190 70, 0)
        & drZeroPos .~ (V2 140 70, 0)
        & drFootPrint .~ IM.fromDistinctAscList (zip [0..] (loopPairs . reverse $ rectWH 30 29))
    f ps = case ps of
        PS _ r -> ps & psRot +~ pi & psPos +~ rotateV r (V2 0 (-5))
        _ -> ps
    spos h = rprBool (t' h) & psSelect . mapped . mapped . _Just . _1 %~ f
    t' h rp _ = case _rpType rp of
        UnusedLink s -> h s
        _ -> False

slowDoorRoom :: RandomGen g => State g Room
slowDoorRoom = do
    x <- state $ randomR (400, 800)
    y <- state $ randomR (400, 800)
    h <- state $ randomR (200, min (y -100) 500)
    let n = 25
    xs <- replicateM n $ state $ randomR (10, x -10)
    ys <- replicateM n $ state $ randomR (h + 20, y)
    rs <- replicateM n $ state $ randomR (0, 2 * pi)
    let ps = zipWith V2 xs ys
    xs' <- replicateM 5 $ state $ randomR (10, x -10)
    ys' <- replicateM 5 $ state $ randomR (h + 20, y)
    let crits = zipWith (\p r -> sPS p r randC1) ps rs
        barrels = zipWith (\x' y' -> sPS (V2 x' y') 0 $ PutCrit explosiveBarrel) xs' ys'
    proom <- southPillarsRoom x y h
    addButtonSlowDoor x h (proom & rmPmnts <>~ (crits <> barrels))

slowDoorRoomRunPast :: RandomGen g => State g (MetaTree Room String)
slowDoorRoomRunPast = do
    r <- slowDoorRoom
    rToOnward "slowDoorRoomRunPast" $
        treeFromTrunk [door] $
            Node
                r
                [ pure $ cleatOnward door
                , return (cleatLabel 0 $ door & rmConnectsTo .~ S.member InLink)
                ]