122 lines
4.0 KiB
Haskell
122 lines
4.0 KiB
Haskell
--{-# 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)
|