module Dodge.Room.Tutorial where

import Dodge.Layout
import Dodge.Item.Held.Utility
import Control.Monad
import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS
import Data.Maybe (mapMaybe)
import qualified Data.Set as S
import Dodge.Cleat
import Dodge.Data.GenWorld
import Dodge.Data.MTRS
import Dodge.Default.Terminal
import Dodge.Item.Ammo
import Dodge.Item.Held.Cane
import Dodge.LevelGen.PlacementHelper
import Dodge.Placement.Instance
import Dodge.PlacementSpot
import Dodge.Room.Airlock
import Dodge.Room.Corridor
import Dodge.Room.Door
import Dodge.Room.LasTurret
import Dodge.Room.Link
import Dodge.Room.Ngon
import Dodge.Room.Procedural
import Dodge.Room.RezBox
import Dodge.Room.RoadBlock
import Dodge.Room.Room
import Dodge.Room.Warning
import Dodge.RoomLink
import Dodge.Terminal
import Dodge.Tree.Compose
import Geometry
import LensHelp
import Linear
import RandomHelp
import ShortShow
import TreeHelp

tutAnoTree :: State LayoutVars MTRS
tutAnoTree = do
    foldMTRS
        [ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
        , corDoor
        , tutHub
        , tutLight
        , tutDrop
        , return $ tToBTree "cor" $ return $ cleatOnward corridor
        ----        , AnTree $ pickupTut
        ----        , AnTree $ weaponTut
        ]

foldMTRS ::
    [State LayoutVars (MetaTree Room String)] ->
    State LayoutVars (MetaTree Room String)
foldMTRS xs = do
    ys <- sequence xs
    return $ foldr1 attachOnward' ys

setRoomInt :: Room -> State LayoutVars (Int, Room)
setRoomInt x = do
    i <- nextLayoutInt
    return (i, x & rmPmnts .:~ sps0 (PutWorldUpdate (f i)))
  where
    f i rid _ gw = gw & genInts . at i ?~ (gw ^?! genRooms . ix rid . rmMID . _Just)

setTreeInts :: Tree Room -> State LayoutVars ([Int], Tree Room)
setTreeInts x = do
    y <- traverse setRoomInt x
    return (foldMap ((: []) . fst) y, fmap snd y)

tutDrop :: State LayoutVars (MetaTree Room String)
tutDrop = do
    x <- shuffleLinks =<< roomNgon 6 100
    i <- nextLayoutInt
    --let y = decontamRoom i
    (j, y) <- setRoomInt (decontamRoom i)
    rm <- roomRectAutoLinks 40 100
    return $
        tToBTree "TutDrop" $
            treePost
                [x & rmInPmnt .:~ (0, t j), y, cleatOnward rm]
  where
    t j = \gw ->
        let x = gw ^? genInts . ix j
         in putMessageTerminal
                terminalColor
                (defaultTerminal & tmBootLines .~ ss <> tlSetStatus (TerminalPressTo $ show x <> "QUIT") <> tlDoEffect TmWdWdPowerDownTerminal)
                & plSpot
                    .~ rprBoolShift
                        isUnusedLnk
                        (\(p, a) -> ((p + 10 *.* unitVectorAtAngle (a - pi / 2), a), S.singleton UsedPosLow))
    ss =
        [ makeTermLine "--------------------------------------------"
        , makeTermLine "YOU CAN ONLY CARRY A LIMITED AMOUNT OF ITEMS"
        , makeTermLine "--------------------------------------------"
        ]
            <> tlSetStatus (TerminalPressTo "CONTINUE")
            <> [ makeTermLine "USE [F] TO DROP SINGLE ITEMS"
               , makeTermLine "--------------------------------------------"
               ]
            <> tlSetStatus (TerminalPressTo "CONTINUE")
            <> [ makeTermLine "YOU CAN SELECT AND MOVE MULTIPLE ITEMS"
               , makeTermLine "                             WITH THE MOUSE"
               , makeTermLine "-------------------------------------------"
               ]

cChasm :: State LayoutVars Room
cChasm = do
    x <- state $ randomR (150, 300)
    y <- state $ randomR (150, 300)
    roomRectAutoLinks x y
        <&> rmLinks %~ setOutLinks (isCornerLink NorthWest)
        <&> rmLinks %~ setInLinks (isCornerLink SouthWest)
        <&> rmPmnts <>~ [sps0 $ PutChasm (rectNSWE (y -50) 50 0 (x -50))]

lChasm :: State LayoutVars Room
lChasm = do
    x <- state $ randomR (150, 300)
    y <- state $ randomR (150, 300)
    roomRectAutoLinks x y
        <&> rmLinks %~ setOutLinks (isCornerLink NorthWest)
        <&> rmLinks %~ setInLinks (isCornerLink SouthEast)
        <&> rmPmnts <>~ [sps0 $ PutChasm (rectNSWE (y -50) 0 0 (x -50))]

zChasm :: Float -> State LayoutVars Room
zChasm z = do
    x <- state $ randomR (150, 300)
    y <- state $ randomR (150, 300)
    roomRectAutoLinks x y
        <&> rmLinks %~ setOutLinks (isCornerLink NorthWest)
        <&> rmLinks %~ setInLinks (isCornerLink SouthEast)
        <&> rmPmnts
            <>~ [ sps0 $ PutChasm (rectNSWE (y / 2 - z) 0 0 (x -50))
                , sps0 $ PutChasm (rectNSWE y (y / 2 + z) 50 x)
                ]

midChasm :: State LayoutVars Room
midChasm = do
    x <- state $ randomR (200, 300)
    y <- state $ randomR (200, 300)
    r <- roomRectAutoLinks x y
    cs <- join $ takeOne [cenoct x y, censquare x y]
    shuffleLinks $
        r
            & rmLinks %~ setOutLinks (isMidEdgeLink r North)
            & rmLinks %~ setInLinks (isMidEdgeLink r South)
            & rmPmnts <>~ cs
  where
    censquare x y = do
        z <- state $ randomR (40, 60)
        return [sps0 $ PutChasm (rectNSWE (y - z) z z (x - z))]
    cenoct x y =
        return
            [sps0 $ PutChasm $ (V2 (x / 2) (y / 2) +) <$> polyOrthDist 8 (min x y / 2 - 25)]

--    dia x y = [sps0 $ PutChasm [V2 ]

polyChasm :: Int -> Float -> State LayoutVars Room
polyChasm n x =
    shuffleLinks
        =<< ( roomNgon n x
                <&> rmPmnts <>~ [sps0 $ PutChasm $ polyOrthDist n (x -30)]
                <&> rmLinks %~ setOutLinks (\rl -> rl ^. rlPos . _y > 0)
                <&> rmLinks %~ setInLinks (\rl -> rl ^. rlPos . _y < (5 - x))
            )

polyChasmC :: Int -> Float -> State LayoutVars Room
polyChasmC n x =
    roomNgon n x
        <&> rmPmnts <>~ [sps0 $ PutChasm $ rectNSWE x (60 - x) (-40) 40]
        <&> rmLinks %~ setInLinks (\rl -> PolyEdge 1 `S.member` (rl ^. rlType))
        <&> rmLinks %~ setOutLinks (\rl -> PolyEdge (n -1) `S.member` (rl ^. rlType))

chasmSimpleMaze :: State LayoutVars Room
chasmSimpleMaze =
    join $
        takeOne
            [ midChasm
            , zChasm 25
            , lChasm
            , cChasm
            , pc1
            , pc2
            ]
  where
    pc1 = do
        i <- takeOne [6, 8]
        x <- state $ randomR (100, 150)
        polyChasm i x
    pc2 = do
        i <- takeOne [6, 8]
        x <- state $ randomR (100, 150)
        polyChasmC i x

tutLight :: State LayoutVars (MetaTree Room String)
tutLight = do
    x <- shuffleRoomPos =<< chasmSimpleMaze
    y <- chasmSimpleMaze
    z <- chasmSimpleMaze
    return $
        tToBTree "TutLight" $
            treePost
                [ x & rmPmnts <>~ 
                    [sps g (PutFlIt led)
                    ,sps g (PutFlIt battery)
                    ]
                , corridor & rmPmnts .~ mempty
                , removeLights y
                , corridor & rmPmnts .~ mempty
                , removeLights z
                , door
                , cleatOnward corridor & rmPmnts .~ mempty
                ]
  where
    g = PSPos (\x _ -> f x) (const id) Nothing
      where
        f x = case _rpType x of
            NotLink{} | null (x ^. rpPlacementUse . at UsedPosFloor)  
                -> Just (PS (_rpPos x) (_rpDir x)
                    , x & rpPlacementUse . at UsedPosFloor ?~ ())
            _ -> Nothing

removeLights :: Room -> Room
removeLights = rmPmnts %~ mapMaybe f
  where
    f x = case x ^. plType of
        PutLabel "light" -> Nothing
        _ -> Just x

tutHub :: State LayoutVars (MetaTree Room String)
tutHub = do
    (is, wbp) <- setTreeInts =<< critsRoom 1
    i <- nextLayoutInt
    j <- nextLayoutInt
    k <- nextLayoutInt
    let a gw =
            analyserByNthLinkWithPrompt
                3 --(makeTermPara $ show is <> show (getRoomsFromInts is gw)
                --  <> getCrsFromRooms' is gw)
                []
                (RequireDeadCreatures $ getCrsFromRooms is gw)
                k
    x <-
        shuffleLinks
            . analyserByDoorWithPrompt [] (RequireEquipment (AMMOMAG DRUMMAG)) i
            . (rmInPmnt .:~ (0, a))
            . addDoorAtNthLinkToggleTerminal 1 ss j
            =<< roomNgon 6 100
    bcor <- treeAttachDeep (return door) <$> blockedCorridor
    --bcor <- treeAttachDeep (return door) <$> return (return $ cleatOnward door)
    r1 <- r burstRifle <&> rmPmnts .:~ t
    r2 <- r (drumMag & itConsumables ?~ 90)
    --r2 <- r (tinMag & itConsumables ?~ 500)
    return $
        tToBTree "DoorTest" $
            Node
                x
                [ treeFromPost [triggerDoorRoom i] r1
                , treeFromPost [triggerDoorRoom j] r2
                , (rmClusterStatus . csLinks . at OnwardCluster .~ Nothing)
                    <$> treeAttachDeep wbp bcor
                , treeFromPost [] (cleatOnward $ triggerDoorRoom k & rmInPmnt . ix 0 . _1 .~ 1)
                ]
  where
    ss =
        [ makeTermLine "---------------------------------------------"
        , makeTermLine "YOU CAN INTERACT WITH SOME TERMINALS DIRECTLY"
        , makeTermLine "           THESE WILL DISPLAY A PROMPT SYMBOL"
        , makeTermLine "   *****"
        , makeTermLine "  *     *    TYPE OR SCROLL TO ENTER COMMANDS"
        , makeTermLine "  *  >  *"
        , makeTermLine "  *     *    CLICK OR USE [RETURN] TO CONFIRM"
        , makeTermLine "   *****                                     "
        , makeTermLine "---------------------------------------------"
        , makeTermLine ""
        ]
    r x = roomRectAutoLinks 100 100 <&> rmPmnts .:~ sps (PS 50 0) (PutFlIt x)
    t =
        putMessageTerminal
            terminalColor
            (defaultTerminal & tmBootLines .~ ss' <> tlSetStatus (TerminalPressTo "QUIT") <> tlDoEffect TmWdWdPowerDownTerminal)
            & plSpot
                .~ rprBoolShift
                    isUnusedLnk
                    (\(p, a) -> ((p + 10 *.* unitVectorAtAngle (a - pi / 2), a), S.singleton UsedPosLow))
    ss' =
        [ makeTermLine "---------------------------------------------"
        , makeTermLine "HOLD [CAPS] AND SCROLL"
        , makeTermLine "            OR CLICK AND DRAG"
        , makeTermLine "                 TO REARRANGE INVENTORY ITEMS"
        , makeTermLine "---------------------------------------------"
        ]
            <> tlSetStatus (TerminalPressTo "CONTINUE")
            <> [ makeTermLine "AMMO MAGS ARE NORMALLY LOADED BENEATH WEAPONS"
               , makeTermLine "               .-------."
               , makeTermLine "  BURSTRIFLE   |DRUMMAG|"
               , makeTermLine "        <------^-------^"
               , makeTermLine "---------------------------------------------"
               ]
            <> tlSetStatus (TerminalPressTo "CONTINUE")
            <> [ makeTermLine "HOLD [RMB] TO AIM"
               , makeTermLine "      THEN CLICK [LMB] TO FIRE LOADED WEAPONS"
               , makeTermLine "---------------------------------------------"
               ]

getRoomsFromInts :: [Int] -> GenWorld -> IS.IntSet
getRoomsFromInts is gw =
    foldMap IS.singleton $ IM.restrictKeys (gw ^. genInts) (IS.fromList is)

getCrsFromRooms' :: [Int] -> GenWorld -> String
getCrsFromRooms' is gw = fmap h $ show $ foldMap f (IM.restrictKeys (gw ^. genRooms) js)
  where
    h ',' = ' '
    h x = x
    js = getRoomsFromInts is gw
    f rm = shortShow <$> rm ^.. rmPmnts . each . plType

--f rm = foldMap g $ rm ^. rmPmnts
--g x = case x ^. plType of
--    PutCrit _ -> [x ^?! plMID . _Just]
--    _ -> []

getCrsFromRooms :: [Int] -> GenWorld -> [Int]
getCrsFromRooms is gw = foldMap f (IM.restrictKeys (gw ^. genRooms) js)
  where
    js = getRoomsFromInts is gw
    f rm = foldMap g $ rm ^. rmPmnts
    g x = case x ^. plType of
        PutCrit _ -> [x ^?! plMID . _Just]
        _ -> []

sensorTut :: [TerminalLine]
sensorTut =
    [ makeTermLine "--------------------------------------------"
    , makeTermLine "SOME TERMINALS DETECT EXTERNAL CONDITIONS"
    , makeTermLine "WHILE ACTIVE THESE DISPLAY A SPINNING SYMBOL"
    , makeTermLine "               | / - \\"
    , makeTermLine "--------------------------------------------"
    ]

--        <> tlSetStatus (TerminalPressTo "CONTINUE")

tutRezBox :: RandomGen g => State g Room
tutRezBox = do
    ls <- rezColor
    return $
        roomRect 40 60 1 1
            & rmPmnts
                .~ [ sPS (V2 20 1) 0 $ PutLS ls
                   , Placement (PS 0 0) PutNothing Nothing Nothing $ \w _ ->
                        Just $
                            putImmediateMessageTerminal
                                terminalColor
                                ( defaultTerminal & tmBootLines .~ s w
                                    <> tlSetStatus (TerminalPressTo "QUIT")
                                    <> tlDoEffect TmWdWdPowerDownTerminal
                                    --                            <> tlDoEffect (TmWdWdLeaveTerminal "QUIT")
                                )
                                & plSpot .~ PS (V2 20 0) 0
                   ]
            & restrictInLinks (\(V2 _ h, _) -> h < 1)
            & restrictOutLinks (\(V2 _ h, _) -> h > 59)
            & rmName .~ "tutRezBox"
  where
    s w = tutorialMessage1 (w ^. gwWorld . cWorld . cwGen . cwgSeed)

tutorialMessage1 :: Int -> [TerminalLine]
tutorialMessage1 i =
    [ makeTermLine "--------------------------------------------"
    , makeTermLine $ "WELCOME TO ENVIRONMENT  " ++ show i
    , makeTermLine ""
    , makeTermLine "USE [SPACE] TO INTERACT WITH NEARBY OBJECTS"
    , makeTermLine "--------------------------------------------"
    ]
        <> tlSetStatus (TerminalPressTo "CONTINUE")
        <> [ makeTermLine "USE       [W]"
           , makeTermLine "        [A] [S]"
           , makeTermLine "          [D]       TO MOVE"
           , makeTermLine "--------------------------------------------"
           ]
        <> tlSetStatus (TerminalPressTo "CONTINUE")
        <> [ makeTermLine "AFTER EXITING THIS TERMINAL YOUR INVENTORY"
           , makeTermLine "        AND NEARBY OBJECTS WILL BE DISPLAYED"
           , makeTermLine "--------------------------------------------"
           ]