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

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.Default.Terminal
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, roomRectAutoLinks 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

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

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)

--moveToSideFirstOutLink :: RoomPos -> Room -> Maybe (Point2, Float)
--moveToSideFirstOutLink rp rm = do
--    0 <- rp ^? rpLinkStatus . rplsChildNum
--    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)
--            else  (ltpos, rpdir)
--moveToSideFirstOutLink rp rm = case rp ^? rpLinkStatus . rplsChildNum of
--    Just 0 ->
--        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)
--         in 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...
--                    Just (rtpos, rpdir)
--                else Just (ltpos, rpdir)
--    _ -> Nothing