{-# LANGUAGE TupleSections #-} module Dodge.Room.SensorDoor (sensAboveDoor,sensorRoomRunPast) where import Dodge.Data.MTRS import qualified Data.Set as S import Dodge.Cleat import Dodge.Data.GenWorld import Dodge.LevelGen.PlacementHelper import Dodge.Placement.Instance import Dodge.PlacementSpot import Dodge.Room.Corridor import Dodge.Room.Door import Dodge.Room.Link import Dodge.Room.Ngon import Dodge.Room.Procedural import Dodge.Terminal import Dodge.Tree import Dodge.Wire import Geometry import LensHelp import RandomHelp import Control.Monad -- TODO fix case where the sensor created by sensInsideDoor blocks another door -- for roomRectAutoLinks-- make the locked door a center door? sensorRoom :: RandomGen g => SensorType -> Int -> State g (Tree Room) sensorRoom senseType n = do rm <- join $ takeOne [roomNgon 8 200, roomRectAutoLights 200 200] cenroom <- shuffleLinks $ sensInsideDoor senseType n rm return $ treePost [ door , cenroom & rmLinkEff .~ f , triggerDoorRoom n , cleatOnward door ] where f _ _ 0 rl rm = rm & rmLinks %~ map (g (_rlPos rl) (_rlDir rl)) f _ _ _ _ rm = rm g p d rl | isclose = rl & rlType . at BlockedLink ?~ () | otherwise = rl where p' = p +.+ rotateV d (V2 0 (negate 100)) isclose = dist (_rlPos rl) p' < 30 sensorRoomRunPast :: RandomGen g => SensorType -> Int -> State g MTRS sensorRoomRunPast dt n = do t <- sensorRoom dt n rToOnward "sensorRoomRunPast" $ t & applyToSubforest [0] ( ++ [ treePost [ door & rmConnectsTo .~ (\s -> S.member InLink s && not (S.member BlockedLink s)) , cleatLabel n corridor ] ]) sensAboveDoor :: SensorType -> Float -> PlacementSpot -> Placement sensAboveDoor sensetype wth ps = extTrigLitPos (atFstLnkOutShiftBy (\(p, a) -> ((p +.+ rotateV a (V2 18.5 (-2.5)), a), S.singleton UsedPosHigh))) (\tp -> Just $ damageSensor sensetype wth (_plMID tp) ps) sensInsideDoor :: SensorType -> Int -> Room -> Room sensInsideDoor senseType i rm = rm & rmName .++~ take 4 (show senseType) & rmPmnts .++~ [ psPt atFstLnkOut . PutForeground $ floorWire (V2 20 0) (V2 20 (-100)) , psPt atFstLnkOut . PutForeground $ floorWire (V2 0 (-100)) (V2 20 (-100)) , psPt atFstLnkOut . PutForeground $ verticalWire (V2 20 0) 0 80 , putMessageTerminal (textTerminal & tmCommands .:~ TCDamageCommand) & plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10 <&> (, S.singleton UsedPosHigh)) , sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100) & plExternalID ?~ i ] -- & rmOutPmnt . at i ?~ sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)