--{-# LANGUAGE TupleSections #-}
module Dodge.Room.Warning where
import Dodge.Cleat
import Dodge.Terminal
import Dodge.PlacementSpot
import Dodge.Placement.Instance.Terminal
import Dodge.Data
import Dodge.Tree
import Dodge.Room.Door
import Dodge.Room.Ngon
import Dodge.Room.Procedural
import Dodge.Room.Tanks
import Dodge.Room.Link
import Dodge.Placement.Instance
import Geometry
import Color
import LensHelp
import RandomHelp

--import qualified Data.Set as S
import Data.Maybe
import qualified Data.Map.Strict as M
--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) (const (const 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)
            -- the above test may not work properly if the room polys are
            -- complicated, it should really use created walls...
            then Just (rtpos, rpdir)
            else Just (ltpos, rpdir)
    _ -> Nothing