--{-# LANGUAGE TupleSections #-}
module Dodge.Room.Warning where

import Dodge.Data.BlBl
import Color
import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.Cleat
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 Dodge.WorldEffect
import Geometry
import LensHelp
import RandomHelp

--import Data.Char
--import Data.Tree
--import qualified Data.Text as T

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

addWarningTerminal :: String -> Int -> Room -> Room
addWarningTerminal str outplid =
    (rmName .++~ "warningTerm-")
        . (rmOutPmnt .~ [OutPlacement outplace outplid])
  where
    outplace =
        extTrigLitPos
            (atFstLnkOutShiftBy (\(p, a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
            ( Just . set plSpot (rprShift moveToSideFirstOutLink)
                . putMessageTerminal terminalColor
                . termMessages
            )
    termMessages trpl =
        lineOutputTerminal (makeColorTermLine red "WARNING" : makeTermPara str)
            & tmScrollCommands .:~ toggleCommand
            & tmToggles
                .~ M.fromList
                    [("DOOR", TerminalToggle (fromJust $ _plMID trpl) (BlConst True))]

moveToSideFirstOutLink :: RoomPos -> Room -> Maybe (Point2, Float)
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