103 lines
3.3 KiB
Haskell
103 lines
3.3 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
|
|
module Dodge.Room.SensorDoor (sensAboveDoor, sensorRoomRunPast) where
|
|
|
|
import Control.Monad
|
|
import qualified Data.Set as S
|
|
import Dodge.Cleat
|
|
import Dodge.Data.GenWorld
|
|
import Dodge.Data.MTRS
|
|
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.Modify
|
|
import Dodge.Room.Ngon
|
|
import Dodge.Room.Procedural
|
|
import Dodge.RoomLink
|
|
import Dodge.Terminal
|
|
import Dodge.Tree
|
|
import Dodge.Wire
|
|
import Geometry
|
|
import LensHelp
|
|
import RandomHelp
|
|
|
|
-- TODO fix case where the sensor created by sensInsideDoor blocks another door
|
|
-- for roomRectAutoLinks-- make the locked door a center door?
|
|
sensorRoom :: SensorType -> Int -> State LayoutVars (Tree Room)
|
|
sensorRoom senseType n = do
|
|
rm <-
|
|
join $
|
|
takeOne
|
|
[ addLightsNGon =<< roomNgon 8 200
|
|
, roomRectAutoLights 200 200 <&> rmLinks %~ setOutLinks nonCornerLinks
|
|
]
|
|
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
|
|
|
|
nonCornerLinks :: RoomLink -> Bool
|
|
nonCornerLinks = not . any f . (^. rlType)
|
|
where
|
|
f (FromEdge _ 0) = True
|
|
f _ = False
|
|
|
|
sensorRoomRunPast :: SensorType -> Int -> State LayoutVars 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
|
|
( psposAddLabel
|
|
ColoredLightRP
|
|
(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 termpos (shiftInBy 10 <&> (,S.singleton UsedPosHigh))
|
|
, sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100) & plExternalID ?~ i
|
|
]
|
|
where
|
|
termpos rp rm' =
|
|
isUnusedLnk rp rm'
|
|
&& all ((> 30) . dist (_rpPos rp) . _rpPos) (filter usedlnks $ rm' ^. rmPos)
|
|
usedlnks rp = case _rpType rp of
|
|
UsedOutLink{} -> True
|
|
UsedInLink{} -> True
|
|
UnusedLink{} -> False
|
|
NotLink{} -> False
|