justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Anothing laser run past room

Browse Source
This commit is contained in:
justin
2026-03-13 14:17:34 +00:00
parent 0044698a5a
commit 74e6be2f95
2 changed files with 168 additions and 119 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/LasTurret.hs
+47 -4
View File
@@ -11,6 +11,7 @@ module Dodge.Room.LasTurret (
lasCenRunClose,
) where
import Data.Foldable (fold)
import Dodge.Room.Path
import Dodge.Room.Procedural
import qualified Data.Set as S
@@ -145,7 +146,52 @@ lasCenSensEdge n = do
lasCenRunClose :: (RandomGen g) => State g (MetaTree Room String)
lasCenRunClose = do
npoly <- takeOne [5,6,7,8,9]
npoly <- takeOne [6,8,10,12]
thelight <- mntLightLnkCond $ rprBool $ const . isInLnk
thelight1 <- mntLightLnkCond $ rprBool $ const . isOutLnk
thelight2 <- mntLightLnkCond $ rprBool $ const . (\rp -> PolyEdge ((npoly + 1) `div` 4) `S.member`
(fold $ rp ^? rpType . rplsType))
thelight3 <- mntLightLnkCond $ rprBool $ const . (\rp -> PolyEdge (3*(npoly + 1) `div` 4) `S.member`
(fold $ rp ^? rpType . rplsType))
-- thelight3 <- mntLightLnkCond $ rprBool $ const . isOutLnk
r <- shuffleLinks =<<
(roomNgon npoly 250
<&> rmPmnts
.~
[angwall a | a <- [0,pi/8..pi-pi/9]] <>
[bngwall a | a <- [0,pi/8..pi-pi/9]] <>
[ putLasTurret 0.02
-- , awall (V2 0 50) (square 10)
, thelight
, thelight1
, thelight2
, thelight3
]
<&> rmPath %~ (addNodesCrossingCirc 0 30
. flip (foldr ($)) [apath a | a <- [0,pi/8..pi-2*pi/9]]
. flip (foldr ($)) [bpath a | a <- [0,pi/8..pi-2*pi/9]]
)
<&> rmLinks %~ setInLinksByType (PolyEdge 0)
<&> rmLinks %~ setOutLinksByType (PolyEdge (npoly `div` 2))
)
rToOnward "lasCenRunClose" $ return $ cleatOnward r
where
awall x v = heightWallPS (PS x 0) 30 v
--angwall a = awall (V2 0 100 + rotateV a (V2 0 100)) (fmap (rotateV (pi/4 + a/2)) $ rectWH 5 (25 - a*10/pi ))
angwall a = awall (V2 0 100 + rotateV a (V2 0 100)) (fmap (rotateV (pi/4 + a*0.8)) $ rectWH 5 (23 - a*13/pi ))
apath a' = addNodesCrossing $ (\x -> (x + f (V2 0 100),x - f (V2 0 100))) (V2 0 100 + rotateV a (V2 0 100))
where
a = a' + pi/16
f = rotateV (pi/4 + a *0.8)
bngwall a = awall (V2 0 (-100) + rotateV a (V2 0 (-100))) (fmap (rotateV (pi/4 + a*0.8)) $ rectWH 5 (23 - a*13/pi ))
bpath a' = addNodesCrossing $ (\x -> (x + f (V2 0 100),x - f (V2 0 100))) (V2 0 (-100) + rotateV a (V2 0 (-100)))
where
a = a' + pi/16
f = rotateV (pi/4 + a *0.8)
lasCenRunClose' :: (RandomGen g) => State g (MetaTree Room String)
lasCenRunClose' = do
npoly <- takeOne [5..12]
inwall <- takeOne obwalls
outwall <- takeOne obwalls
thelight <- mntLightLnkCond $ rprBool $ const . isInLnk
@@ -157,9 +203,6 @@ lasCenRunClose = do
fmap (uncurry inlinkwall) inwall <>
fmap (uncurry outlinkwall) outwall <>
[ putLasTurret 0.02
-- , outlinkwall 70 (rectNSWE 10 (-10) (-30) 10)
-- , outlinkwall 125 (rectNSWE 55 (-55) (-10) 10)
-- , outlinkwall 180 (rectNSWE 10 (-10) (-10) 30)
, thelight
, thelight1
]