--{-# LANGUAGE TupleSections #-} module Dodge.Room.Warning where import Dodge.UseAll import Dodge.Terminal --import Dodge.LevelGen.Data import Dodge.PlacementSpot import Dodge.Placement.Instance.Terminal import Dodge.Data import Dodge.Tree --import Dodge.RoomLink import Dodge.Room.Door import Dodge.Room.Ngon import Dodge.Room.Procedural --import Dodge.Room.Corridor import Dodge.Room.Link --import Dodge.Room.Procedural --import Dodge.Room.Foreground --import Dodge.Room.RoadBlock import Dodge.Placement.Instance --import Dodge.Default.Room --import Dodge.Item.Weapon.Utility --import Dodge.LevelGen.Data --import Geometry.Data import Geometry --import Padding --import Color --import Shape --import Lorem 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 => Int -> State g (LabTree Room) warningRooms n = do rm <- takeOne [roomNgon 8 200, roomRectAutoLinks 200 200] cenroom <- shuffleLinks $ addWarningTerminal n rm let doorroom = triggerDoorRoom n return ( toOnward "warningRooms" , treeFromPost [ door, cenroom, doorroom] (useAll door) ) addWarningTerminal :: Int -> Room -> Room addWarningTerminal 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) . putTerminal terminalColor . termMessages) termMessages trpl = basicTerminal & 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