{-# LANGUAGE TupleSections #-}

module Dodge.Room.LasTurret (
    analyserByNthLink,
    analyserByDoor,
    lasCenSensEdge,
    lasTunnelRunPast,
    keyCardRoomRunPast,
    lasSensorTurretTest,
    healthTest,
    lasRunYinYangCenter,
    lasRunYinYang,
    lasCenRunClose',
    lasCenRunClose1,
    lasCenRunCloseLongCor,
    lasRunRand,
    storeRoomID,
) where

import Dodge.Room.Warning
import Dodge.Room.Modify
import Color
import Control.Monad
import Data.Foldable
import Data.Maybe
-- import Data.Foldable (fold)

import qualified Data.Set as S
import Dodge.Cleat
import Dodge.Data.GenWorld
import Dodge.Default.Room
import Dodge.LevelGen.PlacementHelper
import Dodge.Placement.Instance
import Dodge.Placement.Instance.Analyser
import Dodge.PlacementSpot
import Dodge.Room.Corridor
import Dodge.Room.Door
import Dodge.Room.Link
import Dodge.Room.Ngon
import Dodge.Room.Path
import Dodge.Room.Procedural
import Dodge.Room.SensorDoor
import Dodge.RoomLink
import Dodge.Tree
import Dodge.Wire
import Geometry
import LensHelp
import RandomHelp
import Shape

-- no lights!
cenLasTur :: (RandomGen g) => State g Room
cenLasTur =
    roomNgon 8 200
        <&> rmPmnts
        .~ [ putLasTurret 0.02
           , heightWallPS
                (resetPLUse $ rprBoolShift (const . isInLnk) (shiftInBy 120 <&> (,S.singleton UsedPosLow)))
                30
                (rectWH 20 10)
           ]
        <&> rmPath
        %~ addNodesCrossingCirc 0 30

lightSensInsideDoor :: Int -> Room -> Room
lightSensInsideDoor i =
    rmPmnts
        .++~ [ psPt atFstLnkOut (PutForeground $ floorWire (V2 20 0) (V2 20 (-x)))
             , psPt atFstLnkOut (PutForeground $ floorWire (V2 0 (-x)) (V2 20 (-x)))
             , psPt atFstLnkOut (PutForeground $ verticalWire (V2 20 0) 0 80)
             , sensAboveDoor LaserSensor 10 (atFstLnkOutShiftInward x) & plExternalID ?~ i
             ]
  where
    x = 120

--        & rmOutPmnt . at i ?~ sensAboveDoor LaserSensor 10 (atFstLnkOutShiftInward 100)

lightSensByDoor :: Int -> Room -> State LayoutVars Room
lightSensByDoor i rm = do
    x <- takeOne [100, 120, 140]
    y <- takeOne [100, 110, 120]
    sh1 <- takeOne [rectWH 20 10, square 20]
    return $
        rm
            & rmPmnts
            .++~ [ psPt atFstLnkOut $ PutForeground $ verticalWire (V2 20 0) 0 80
                 , heightWallPS (atNthLnkOutShiftInward 1 x) 30 sh1
                 , heightWallPS (atFstLnkOutShiftInward y) 30 (rectWH 20 10)
                 , sensAboveDoor LaserSensor 20 (atFstLnkOutShiftBy sensorshift) & plExternalID ?~ i
                 ]
  where
    sensorshift (p, a) = ((p +.+ rotateV a (V2 60 (-20)), a), S.singleton UsedPosLow)

keyCardRoomRunPast :: (RandomGen g) => Int -> Int -> State g (MetaTree Room String)
keyCardRoomRunPast keyid rmid = do
    cenroom <- shuffleLinks . keyCardAnalyserByDoor keyid rmid =<< roomNgon 6 200
    let doorroom = triggerDoorRoom rmid
    rToOnward "keyCardRoomRunPast" $
        treeFromTrunk [door] $
            Node
                cenroom
                [ treeFromPost [doorroom] (cleatOnward door)
                , treeFromPost [door] (cleatLabel rmid corridor)
                ]

keyCardAnalyserByDoor :: Int -> Int -> Room -> Room
keyCardAnalyserByDoor keyid = analyserByDoor (RequireEquipment (HELD (KEYCARD keyid)))

healthAnalyserByDoor :: Int -> Room -> Room
healthAnalyserByDoor = analyserByDoor (RequireHealth 1100)

analyserByNthLink :: Int -> ProximityRequirement -> Int -> Placement
analyserByNthLink n proxreq i =
    analyser
        (SensorWithRequirement proxreq)
--        (byNthLink n)
        ( atNthLnkOutShiftBy
            n
            ( \(p, a) ->
                ((p +.+ rotateV a (V2 18.5 (-2.5)), a), S.singleton UsedPosLow)
            )
        )
        (byNthLink n)
--        (atNthLnkOutShiftBy n sensorshift)
        & plExternalID
        ?~ i
  where
    sensorshift (p, a) = ((p +.+ rotateV a (V2 (-30) (-10)), a), S.singleton UsedPosLow)

analyserByDoor :: ProximityRequirement -> Int -> Room -> Room
analyserByDoor pr i = rmPmnts .:~ analyserByNthLink 0 pr i

healthTest :: (RandomGen g) => Int -> State g (Tree Room)
healthTest n = do
    cenroom <- shuffleLinks . healthAnalyserByDoor n =<< roomNgon 8 200
    return $
        treePost
            [ door
            , corridor -- & rmPmnts .:~ psPtPl (PS 20 0) (PutFlIt (medkit 100))
            , cenroom
            , triggerDoorRoom n
            , cleatOnward door
            ]

lasSensorTurretTest :: State LayoutVars (MetaTree Room String)
lasSensorTurretTest = do
    n <- nextLayoutInt
    cenroom' <- shuffleLinks . lightSensInsideDoor n =<< cenLasTur
    (i, cenroom'') <- storeRoomID cenroom'
    lshape <- takeOne [vShape, lShape, jShape, liShape]
    let alight a rp = mntLSCond (fmap (fmap $ colorSH black) lshape) (PS (rotateV a $ _rpPos rp) (a + _rpDir rp))
    let cenroom =
            cenroom''
                & rmInPmnt
                <>~ [ (0, return . alight pi . f i)
                    , (0, return . alight (0.5 * pi) . f i)
                    , (0, return . alight (1.5 * pi) . f i)
                    ]
    rToOnward "lasSensorTurretTest" $
        treePost
            [door, cenroom, triggerDoorRoom n, cleatOnward door]
  where
    f i gw = fromJust $ find (isused . _rpType) (getRoomFromID i gw ^. rmPos)
    isused UsedOutLink{_rplsChildNum = 0} = True
    isused _ = False

-- note the double usage of the int, shouldn't cause a problem
lasCenSensEdge :: Int -> State LayoutVars (MetaTree Room String)
lasCenSensEdge n = do
    (i, cenroom') <- storeRoomID =<< shuffleLinks =<< lightSensByDoor n =<< cenLasTur
    lshape <- takeOne [vShape, lShape, jShape, liShape]
    let alight a rp = mntLSCond (fmap (fmap $ colorSH black) lshape) (PS (rotateV a $ _rpPos rp) (a + _rpDir rp))
        blight a = (0, return . alight a . f i)
    let cenroom = cenroom' & rmInPmnt <>~ map blight [pi, 0.5 * pi, 1.5 * pi]
    let doorroom = triggerDoorRoom n
    rToOnward "lasCenSensEdge" $
        treeFromTrunk [door] $
            Node
                cenroom
                [ treePost [doorroom, cleatOnward door]
                , treePost [door, cleatLabel n corridor]
                ]
  where
    f i gw = fromJust $ find (isused . _rpType) (getRoomFromID i gw ^. rmPos)
    isused UsedOutLink{_rplsChildNum = 0} = True
    isused _ = False


lasRunYinYang :: (RandomGen g) => State g (MetaTree Room String)
lasRunYinYang = do
    npoly <- takeOne [6, 8, 10, 12]
    thelight <- mntLightLnkCond $ rprBool $ const . isInLnk
    thelight1 <- mntLightLnkCond $ rprBool $ const . isOutLnk
    thelight2 <-
        mntLightLnkCond $
            rprBool $
                const
                    . ( \rp ->
                            PolyEdge ((npoly + 1) `div` 4)
                                `S.member` fold (rp ^? rpType . rplsType)
                      )
    thelight3 <-
        mntLightLnkCond $
            rprBool $
                const
                    . ( \rp ->
                            PolyEdge (3 * (npoly + 1) `div` 4)
                                `S.member` fold (rp ^? rpType . rplsType)
                      )
    r <-
        shuffleLinks
            =<< ( roomNgon npoly 250
                    <&> rmPmnts
                    .~ [angwall a | a <- [0, pi / 8 .. pi - pi / 9]]
                    <> [bngwall a | a <- [0, pi / 8 .. pi - pi / 9]]
                    <> [ awall 0 (rectWH 15 5)
                       , putLasTurret 0.02 & plSpot . psPos .~ negate offxy
                       , putLasTurret 0.02 & plSpot . psPos .~ offxy
                       , --                , awall (V2 0 50) (square 10)
                         thelight
                       , thelight1
                       , thelight2
                       , thelight3
                       ]
                        <&> rmPath
                        %~ ( addNodesCrossingCirc 0 30
                                . flip (foldr ($)) [apath a | a <- [0, pi / 8 .. pi - 2 * pi / 9]]
                                . flip (foldr ($)) [bpath a | a <- [0, pi / 8 .. pi - 2 * pi / 9]]
                           )
                        <&> rmLinks
                        %~ setInLinksByType (PolyEdge 0)
                        <&> rmLinks
                        %~ setOutLinksByType (PolyEdge (npoly `div` 2))
                )
    rToOnward "lasCenRunClose" $ return $ cleatOnward r
  where
    awall x = heightWallPS (PS x 0) 30
    -- angwall a = awall (V2 0 100 + rotateV a (V2 0 100)) (fmap (rotateV (pi/4 + a/2)) $ rectWH 5 (25 - a*10/pi ))
    rf = 0.8
    offxy = V2 0 (-100)
    angwall a = awall (V2 0 100 + rotateV a (V2 0 100)) (rotateV (pi / 4 + a * rf) <$> rectWH 5 (23 - a * 13 / pi))
    apath a' = addNodesCrossing $ (\x -> (x + f (V2 0 100), x - f (V2 0 100))) (V2 0 100 + rotateV a (V2 0 100))
      where
        a = a' + pi / 16
        f = rotateV (pi / 4 + a * 0.8)
    bngwall a = awall (V2 0 (-100) + rotateV a (V2 0 (-100))) (rotateV (pi / 4 + a * rf) <$> rectWH 5 (23 - a * 13 / pi))
    bpath a' = addNodesCrossing $ (\x -> (x + f (V2 0 100), x - f (V2 0 100))) (V2 0 (-100) + rotateV a (V2 0 (-100)))
      where
        a = a' + pi / 16
        f = rotateV (pi / 4 + a * 0.8)

lasRunYinYangCenter :: (RandomGen g) => State g (MetaTree Room String)
lasRunYinYangCenter = do
    npoly <- takeOne [6, 8, 10, 12]
    thelight <- mntLightLnkCond $ rprBool $ const . isInLnk
    thelight1 <- mntLightLnkCond $ rprBool $ const . isOutLnk
    thelight2 <-
        mntLightLnkCond $
            rprBool $
                const
                    . ( \rp ->
                            PolyEdge ((npoly + 1) `div` 4)
                                `S.member` fold (rp ^? rpType . rplsType)
                      )
    thelight3 <-
        mntLightLnkCond $
            rprBool $
                const
                    . ( \rp ->
                            PolyEdge (3 * (npoly + 1) `div` 4)
                                `S.member` fold (rp ^? rpType . rplsType)
                      )
    --    thelight3 <- mntLightLnkCond $ rprBool $ const . isOutLnk
    r <-
        shuffleLinks
            =<< ( roomNgon npoly 250
                    <&> rmPmnts
                    .~ [angwall a | a <- [0, pi / 8 .. pi - pi / 9]]
                    <> [bngwall a | a <- [0, pi / 8 .. pi - pi / 9]]
                    <> [ putLasTurret 0.02
                       , --                , awall (V2 0 50) (square 10)
                         thelight
                       , thelight1
                       , thelight2
                       , thelight3
                       ]
                        <&> rmPath
                        %~ ( addNodesCrossingCirc 0 30
                                . flip (foldr ($)) [apath a | a <- [0, pi / 8 .. pi - 2 * pi / 9]]
                                . flip (foldr ($)) [bpath a | a <- [0, pi / 8 .. pi - 2 * pi / 9]]
                           )
                        <&> rmLinks
                        %~ setInLinksByType (PolyEdge 0)
                        <&> rmLinks
                        %~ setOutLinksByType (PolyEdge (npoly `div` 2))
                )
    rToOnward "lasCenRunClose" $ return $ cleatOnward r
  where
    awall x = heightWallPS (PS x 0) 30
    -- angwall a = awall (V2 0 100 + rotateV a (V2 0 100)) (fmap (rotateV (pi/4 + a/2)) $ rectWH 5 (25 - a*10/pi ))
    angwall a = awall (V2 0 100 + rotateV a (V2 0 100)) (rotateV (pi / 4 + a * 0.8) <$> rectWH 5 (23 - a * 13 / pi))
    apath a' = addNodesCrossing $ (\x -> (x + f (V2 0 100), x - f (V2 0 100))) (V2 0 100 + rotateV a (V2 0 100))
      where
        a = a' + pi / 16
        f = rotateV (pi / 4 + a * 0.8)
    bngwall a = awall (V2 0 (-100) + rotateV a (V2 0 (-100))) (rotateV (pi / 4 + a * 0.8) <$> rectWH 5 (23 - a * 13 / pi))
    bpath a' = addNodesCrossing $ (\x -> (x + f (V2 0 100), x - f (V2 0 100))) (V2 0 (-100) + rotateV a (V2 0 (-100)))
      where
        a = a' + pi / 16
        f = rotateV (pi / 4 + a * 0.8)

lasCenRunClose' :: (RandomGen g) => State g (MetaTree Room String)
lasCenRunClose' = do
    npoly <- takeOne [5 .. 12]
    inwall <- takeOne obwalls
    outwall <- takeOne obwalls
    thelight <- mntLightLnkCond $ rprBool $ const . isInLnk
    thelight1 <- mntLightLnkCond $ rprBool $ const . isOutLnk
    r <-
        shuffleLinks
            =<< ( roomNgon npoly 250
                    <&> rmPmnts
                    .~ ( fmap (uncurry inlinkwall) inwall
                            <> fmap (uncurry outlinkwall) outwall
                            <> [ putLasTurret 0.02
                               , thelight
                               , thelight1
                               ]
                       )
                    <&> rmPath
                    %~ addNodesCrossingCirc 0 30
                    <&> rmLinks
                    %~ setInLinksByType (PolyEdge 0)
                    <&> rmLinks
                    %~ setOutLinks (\rl -> or [PolyEdge i `S.member` _rlType rl | i <- [2 .. npoly - 2]])
                )
    rToOnward "lasCenRunClose" $ return $ cleatOnward r
  where
    swall =
        [ (70, rectNSWE 10 (-10) (-10) 30)
        , (125, rectNSWE 55 (-55) (-10) 10)
        , (180, rectNSWE 10 (-10) (-30) 10)
        ]
    zwall =
        [ (70, rectNSWE 10 (-10) (-30) 10)
        , (125, rectNSWE 55 (-55) (-10) 10)
        , (180, rectNSWE 10 (-10) (-10) 30)
        ]
    iwall =
        [ (70, rectNSWE 10 (-10) (-15) 20)
        , (180, rectNSWE 10 (-10) (-30) (-5))
        ]
    jwall =
        [ (70, rectNSWE 10 (-10) (-20) 15)
        , (180, rectNSWE 10 (-10) 5 30)
        ]
    uwall = [(180, rectNSWE 10 (-10) (-20) 20)]
    obwalls = [swall, zwall, iwall, jwall, uwall]
    linkwall f x =
        heightWallPS
            (resetPLUse $ rprBoolShift (const . f) (shiftInBy x <&> (,S.singleton UsedPosLow)))
            30
    inlinkwall = linkwall isInLnk
    outlinkwall = linkwall isOutLnk

lasCenRunCloseLongCor :: (RandomGen g) => State g (MetaTree Room String)
lasCenRunCloseLongCor = do
    (alinks, blinks) <- shufflePair (rlinks, llinks)
    rdir <- takeOne [negate, id]
    a <- takeOne [5 * pi / 16]
    let h = 800
    laspos <- takeOne [V2 (h / 2) 80]
    ls <- mntLightLnkCond (PS (V2 (h / 2) 0) pi)
    r <-
        shuffleLinks
            =<< ( roomRectAutoLights h 160
                    <&> rmPmnts
                    <>~ [ putLasTurret 0.02 & plSpot .~ PS laspos a
                        , awall (V2 (h / 4) 80) (rotateV (rdir pi / 16) <$> rectWH 180 10)
                        , awall (V2 (3 * h / 4) 80) (rotateV (rdir pi / 16) <$> rectWH 180 10)
                        , ls
                        ]
                    <&> rmLinks
                    %~ setInLinks alinks
                    <&> rmLinks
                    %~ setOutLinks blinks
                    <&> rmPath
                    %~ ( addNodesCrossing (V2 (h / 2 - 10) 30, V2 (h / 2 + 50) 90)
                            . addNodesCrossing (V2 (h / 2 + 10) 130, V2 (h / 2 - 50) 70)
                       )
                )
    rToOnward "lasCenRunClose" $ return $ cleatOnward r
  where
    llinks = memtest (FromEdge South 1) (OnEdge West)
    rlinks = memtest (FromEdge South 1) (OnEdge East)
    awall x = heightWallPS (PS x 0) 30
    memtest a b x =
        let y = _rlType x
         in a `S.member` y && b `S.member` y

lasCenRunClose1 :: (RandomGen g) => State g (MetaTree Room String)
lasCenRunClose1 = do
    -- (alinks,blinks) <- shufflePair (bllinks,brlinks)
    -- (alinks,blinks) <- shufflePair (bllinks,tmllink)
    lnks <- shuffle [bllinks, brlinks, tmllink, tmrlink]
    let alinks = lnks !! 0
        blinks = lnks !! 1
    outwall <-
        takeOne
            [ awall (V2 185 25) (rectWH 10 50)
            , awall (V2 200 50) (rectWH 50 10)
            ]
    let z = 35
    r <-
        roomRectAutoLights 250 200
            <&> rmPolys
            .~ [
                   [ V2 0 0
                   , V2 250 0
                   , V2 250 (200 - z)
                   , V2 (250 - z) 200
                   , V2 z 200
                   , V2 0 (200 - z)
                   ]
               ]
            <&> rmPmnts
            <>~ [ putLasTurret 0.02 & plSpot .~ PS (V2 125 100) 0
                , awall (V2 65 25) (rectWH 10 50)
                , outwall
                , awall (V2 95 150) (rectWH 10 20)
                , awall (V2 155 150) (rectWH 10 20)
                , sps0 $ putConvexChasm $ rectNSWE 200 110 105 145
                --               , awall (V2 150 215) (rectWH 60 10)
                ]
            <&> rmLinks
            %~ setInLinks alinks
            --            <&> rmLinks %~ setOutLinks (memtest (OnEdge South) (FromEdge West 3))
            <&> rmLinks
            %~ setOutLinks blinks
            <&> rmLinks
            . each
            %~ mvlinks
            <&> rmPath
            %~ S.map (both %~ mvpath)
    rToOnward "lasCenRunClose" $ return $ cleatOnward r
  where
    mvlinks lnk
        | tmllink lnk = lnk & rlPos -~ V2 20 0
        | tmrlink lnk = lnk & rlPos +~ V2 20 0
        | otherwise = lnk
    mvpath (V2 x y)
        | y > 190, x > 50, x < 125 = V2 (x - 20) y
        | y > 190, x > 125, x < 200 = V2 (x + 20) y
        | otherwise = V2 x y
    tmllink = memtest (FromEdge West 1) (OnEdge North)
    tmrlink = memtest (FromEdge West 2) (OnEdge North)
    bllinks =
        etest
            (memtest (FromEdge West 0) (OnEdge South))
            (memtest (FromEdge South 0) (OnEdge West))
    brlinks =
        etest
            (memtest (FromEdge East 0) (OnEdge South))
            (memtest (FromEdge South 0) (OnEdge East))
    awall x = heightWallPS (PS x 0) 30
    etest f g x = f x || g x
    memtest a b x =
        let y = _rlType x
         in a `S.member` y && b `S.member` y

lasRunRand :: (RandomGen g) => State g (MetaTree Room String)
lasRunRand = join $ takeOne [lasCenRunClose2, lasCenRunClose1]

lasCenRunClose2 :: (RandomGen g) => State g (MetaTree Room String)
lasCenRunClose2 = do
    (alinks, blinks) <- shufflePair (bllinks, trlinks)
    a <- takeOne [3 * pi / 2, 3 * pi / 4]
    laspos <- takeOne [V2 60 190, V2 65 185]
    r <-
        shuffleLinks
            =<< ( roomRectAutoLights 250 250
                    <&> rmPmnts
                    <>~ [ putLasTurret 0.02 & plSpot .~ PS laspos a
                        , awall (V2 35 100) (rectWH 10 60)
                        , awall (V2 150 215) (rectWH 60 10)
                        ]
                    <&> rmLinks
                    %~ setInLinks alinks
                    <&> rmLinks
                    %~ setOutLinks blinks
                    <&> rmPath
                    %~ ( addNodesCrossing (V2 110 170, V2 30 250)
                            . addNodesCrossing (V2 70 150, V2 10 210)
                       )
                )
    rToOnward "lasCenRunClose" $ return $ cleatOnward r
  where
    bllinks =
        etest
            (memtest (FromEdge West 0) (OnEdge South))
            (memtest (FromEdge South 0) (OnEdge West))
    trlinks =
        etest
            (memtest (FromEdge East 0) (OnEdge North))
            (memtest (FromEdge North 0) (OnEdge East))
    awall x = heightWallPS (PS x 0) 30
    etest f g x = f x || g x
    memtest a b x =
        let y = _rlType x
         in a `S.member` y && b `S.member` y

lasTunnel :: (RandomGen g) => Float -> State g Room
lasTunnel y = do
    extraPlmnts <-
        takeOne
            [
                [ midWall (rectNSWE 115 90 0 60)
                , midWall (rectNSWE 65 40 (-40) 25)
                ]
            ,
                [ midWall (rectNSWE 125 100 0 25)
                , midWall (rectNSWE 80 40 (-40) 0)
                , midWall (rectNSWE 80 40 25 60)
                ]
            ]
    return
        defaultRoom
            { _rmPolys = polys
            , _rmBound = polys
            , _rmLinks =
                [ outLink (V2 20 (190 + y)) (1.5 * pi)
                , outLink (V2 0 (190 + y)) (0.5 * pi)
                , inLink (V2 (-40) 20) (0.5 * pi)
                , inLink (V2 60 20) (1.5 * pi)
                , inLink (V2 10 0) pi
                ]
            , _rmPmnts =
                [ putLasTurret 0.005 & plSpot .~ PS (V2 10 (240 + y)) (1.5 * pi)
                , -- , midWall (rectNSEW 65 40 0 25)
                  mntLS vShape (V2 60 145) (V3 40 125 90)
                , mntLS vShape (V2 (-40) 145) (V3 (-20) 125 90)
                ]
                    ++ extraPlmnts
            , _rmName = "lasTunnel" ++ show y
            }
  where
    polys =
        [ rectNSWE (250 + y) 0 0 20
        , rectNSWE 145 0 (-40) 60
        ]

-- a y value of 400 is probably "unrunnable"
lasTunnelRunPast :: (RandomGen g) => Float -> State g (MetaTree Room String)
lasTunnelRunPast y = do
    r <- lasTunnel y
    r1 <- takeOne [door, corridor]
    r2 <- takeOne [door, corridor]
    rToOnward "lasTunnelRunPast" $
        Node
            r
            [ pure $ cleatOnward r1
            , return (cleatLabel 0 $ r2 & rmConnectsTo .~ S.member InLink)
            ]