Add laser run past rooms
This commit is contained in:
+50
-24
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user