--{-# LANGUAGE TupleSections #-}
module Dodge.Room.Warning (
    warningRooms,
    addDoorToggleTerminal,
    addDoorToggleTerminal',
    addDoorAtNthLinkToggleTerminal,
    addDoorAtNthLinkToggleInterrupt,
    byNthLink,
) where

import Dodge.LevelGen.PlacementHelper
import Dodge.Default
import Color
import Control.Monad
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Set as S
import Dodge.Cleat
import Dodge.Data.BlBl
import Dodge.Data.GenWorld
import Dodge.Placement.Instance
import Dodge.PlacementSpot
import Dodge.Room.Door
import Dodge.Room.Link
import Dodge.Room.Ngon
import Dodge.Room.Procedural
import Dodge.Room.Tanks
import Dodge.Terminal
import Dodge.Tree
import Geometry
import LensHelp
import RandomHelp

warningRooms :: String -> Int -> State StdGen (MetaTree Room String)
warningRooms str n = do
    rm <- do
        join $ takeOne [roomNgon 8 200, roomRectAutoLights 200 200, tanksRoom [] []]
    cenroom <- shuffleLinks $ addWarningTerminal str n rm
    rToOnward "warningRooms" $ treePost [door, cenroom, triggerDoorRoom n, cleatOnward door]

addDoorToggleTerminal :: [TerminalLine] -> Int -> Room -> Room
addDoorToggleTerminal = addDoorAtNthLinkToggleTerminal 0

byNthLink :: Int -> PlacementSpot
byNthLink = rprShift . moveToSideNthOutLink (S.singleton UsedPosLow)

addDoorAtNthLinkToggleInterrupt :: Int -> [String] -> Int -> Room -> Room
addDoorAtNthLinkToggleInterrupt j x i =
    (rmName .++~ "doorInterrupt-")
        . (rmPmnts .:~ outplace)
  where
    outplace =
        extTrigLitPos
            (atNthLnkOutShiftBy j (\(p, a) -> ((p + rotateV a (V2 18.5 (-2.5)), a), S.singleton UsedPosLow)))
            ( Just . set plSpot (byNthLink j)
                . putInterrupt
            )
            & plExternalID
            ?~ i
    putInterrupt trpl = putTerminal 
        (defaultMachine & mcType .~ McTrigger (fromJust $ _plMID trpl)
            & mcHP .~ 100)
        (simpleTermMessage x)


addDoorAtNthLinkToggleTerminal :: Int -> [TerminalLine] -> Int -> Room -> Room
addDoorAtNthLinkToggleTerminal j xs i =
    (rmName .++~ "doorToggle-")
        . (rmPmnts .:~ outplace)
  where
    outplace =
        extTrigLitPos
            (atNthLnkOutShiftBy j (\(p, a) -> ((p +.+ rotateV a (V2 18.5 (-2.5)), a), S.singleton UsedPosLow)))
            ( Just . set plSpot (byNthLink j)
                . putMessageTerminal
                . termMessages
            )
            & plExternalID
            ?~ i
    termMessages trpl =
        lineOutputTerminal xs
            & tmToggles
                .~ M.fromList
                    [("DOOR", TerminalToggle (fromJust $ _plMID trpl) (BlConst True))
                    ]

addDoorToggleTerminal' :: Int -> PlacementSpot -> Room -> Room
addDoorToggleTerminal' i pspot rm = rm
    & rmPmnts .:~ (pmnt & plExternalID ?~ i)
  where
    pmnt = ptCont (PutTrigger False) $ \pl -> Just $ putMessageTerminal (
        lineOutputTerminal []
            & tmToggles
                .~ M.fromList
                    [("DOOR", TerminalToggle (fromJust $ _plMID pl) (BlConst True))
                    ]) & plSpot .~ pspot

addWarningTerminal :: String -> Int -> Room -> Room
addWarningTerminal str =
    addDoorToggleTerminal
        (makeColorTermLine red "WARNING" : makeTermPara str)

lineOutputTerminal :: [TerminalLine] -> Terminal
lineOutputTerminal tls = defaultTerminal & tmBootLines .~ textInputBlurb tls

moveToSideNthOutLink :: S.Set UsedPos
    -> Int -> RoomPos -> Room -> Maybe ((Point2, Float), S.Set UsedPos)
moveToSideNthOutLink xs i rp rm = do
    j <- rp ^? rpType . rplsChildNum
    guard $ i == j
    let rppos = _rpPos rp
        rpdir = _rpDir rp
        inpos = rppos +.+ rotateV rpdir (V2 0 (-12.5))
        rtpos = inpos +.+ rotateV rpdir (V2 30 0)
        ltpos = inpos +.+ rotateV rpdir (V2 (-30) 0)
    return $
        if any (isJust . intersectSegPolyFirst inpos ltpos) (_rmPolys rm)
            then -- the above test may not work properly if the room polys are
            -- complicated, it should really use created walls...
                ((rtpos, rpdir), xs)
            else ((ltpos, rpdir), xs)