Add laser run past rooms

This commit is contained in:
2026-03-13 10:02:29 +00:00
parent be72daf6d5
commit f28a59e7a3
3 changed files with 94 additions and 38 deletions
+50 -24
View File
@@ -11,6 +11,7 @@ module Dodge.Room.LasTurret (
lasCenRunClose,
) where
import Dodge.Room.Path
import Dodge.Room.Procedural
import qualified Data.Set as S
import Dodge.Cleat
@@ -142,8 +143,8 @@ lasCenSensEdge n = do
, treePost [door, cleatLabel 0 corridor]
]
lasCenRunClose' :: (RandomGen g) => State g (MetaTree Room String)
lasCenRunClose' = do
lasCenRunClose :: (RandomGen g) => State g (MetaTree Room String)
lasCenRunClose = do
thelight <- mntLightLnkCond $ rprBool $ const . isInLnk
thelight1 <- mntLightLnkCond $ rprBool $ const . isOutLnk
r <-
@@ -162,6 +163,7 @@ lasCenRunClose' = do
-- <&> rmLinks %~ setOutLinksByType (PolyEdge 7)
-- <&> rmLinks %~ tail
-- <&> rmLinks %~ setOutLinks (const False)
<&> rmPath %~ addNodesCrossingCirc 0 35
rToOnward "lasCenRunClose" $ return $ cleatOnward r
where
linkwall f x = heightWallPS
@@ -170,41 +172,65 @@ lasCenRunClose' = do
inlinkwall = linkwall isInLnk
outlinkwall = linkwall isOutLnk
lasCenRunClose :: (RandomGen g) => State g (MetaTree Room String)
lasCenRunClose = do
a <- takeOne [3*pi/2]--,pi/4]
lasCenRunCloseLongCor :: (RandomGen g) => State g (MetaTree Room String)
lasCenRunCloseLongCor = do
(alinks,blinks) <- shufflePair (rlinks,llinks)
a <- takeOne [5*pi/16]
let h = 800
laspos <- takeOne [V2 (h/2) 80]
ls <- mntLightLnkCond (PS (V2 (h/2) 0) pi)
r <- shuffleLinks =<<
(roomRectAutoLights h 160
<&> rmPmnts
<>~ [ putLasTurret 0.02 & plSpot .~ PS laspos a
, awall (V2 (h /4) 80) (rotateV (pi/16) <$> rectWH 180 10)
, awall (V2 (3*h/4) 80) (rotateV (pi/16) <$> rectWH 180 10)
, ls
]
<&> rmLinks %~ setInLinks alinks
<&> rmLinks %~ setOutLinks blinks
<&> rmPath %~
(addNodesCrossing (V2 (h/2-10) 30,V2 (h/2+50) 90)
.addNodesCrossing (V2 (h/2+10) 130,V2 (h/2-50) 70) )
)
rToOnward "lasCenRunClose" $ return $ cleatOnward r
where
llinks = memtest (FromEdge South 1) (OnEdge West)
rlinks = memtest (FromEdge South 1) (OnEdge East)
awall x v = heightWallPS (PS x 0) 30 v
etest f g x = f x || g x
memtest a b x = let y = _rlType x
in a `S.member` y && b `S.member` y
lasCenRunClose1 :: (RandomGen g) => State g (MetaTree Room String)
lasCenRunClose1 = do
(alinks,blinks) <- shufflePair (bllinks,trlinks)
a <- takeOne [3*pi/2,3*pi/4]
laspos <- takeOne [V2 60 190, V2 65 185]
r <- shuffleLinks =<<
(roomRectAutoLights 250 250
<&> rmPmnts
<>~ [ putLasTurret 0.02 & plSpot .~ PS laspos a
-- <>~ [ putLasTurret 0.02 & plSpot .~ PS (V2 65 185) 0
-- <>~ [ putLasTurret 0.02 & plSpot .~ PS (V2 70 180) 0
, awall (V2 35 100) (rectWH 10 60) -- (rectNSWE 80 (-40) (-30) (-10))
, awall (V2 150 215) (rectWH 60 10) -- (rectNSWE 80 (-40) (-30) (-10))
, awall (V2 35 100) (rectWH 10 60)
, awall (V2 150 215) (rectWH 60 10)
]
<&> rmLinks %~ setInLinks
(etest
(memtest (FromEdge West 0) (OnEdge South))
(memtest (FromEdge South 0) (OnEdge West))
)
<&> rmLinks %~ setOutLinks
(etest
(memtest (FromEdge East 0) (OnEdge North))
(memtest (FromEdge North 0) (OnEdge East))
)
<&> rmLinks %~ setInLinks alinks
<&> rmLinks %~ setOutLinks blinks
<&> rmPath %~ (addNodesCrossing (V2 110 170,V2 30 250)
.addNodesCrossing (V2 70 150,V2 10 210) )
)
rToOnward "lasCenRunClose" $ return $ cleatOnward r
where
bllinks = etest
(memtest (FromEdge West 0) (OnEdge South))
(memtest (FromEdge South 0) (OnEdge West))
trlinks = etest
(memtest (FromEdge East 0) (OnEdge North))
(memtest (FromEdge North 0) (OnEdge East))
awall x v = heightWallPS (PS x 0) 30 v
etest f g x = f x || g x
memtest a b x = let y = _rlType x
in a `S.member` y && b `S.member` y
linkwall f x = heightWallPS
(resetPLUse $ rprBoolShift (const . f) (shiftByV2 x <&> (,S.singleton UsedPosLow)))
30
inlinkwall = linkwall isInLnk
outlinkwall = linkwall isOutLnk
lasTunnel :: (RandomGen g) => Float -> State g Room
lasTunnel y = do