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

Circular laser run past room

Browse Source
This commit is contained in:
justin
2026-03-13 11:59:26 +00:00
parent f28a59e7a3
commit 0044698a5a
2 changed files with 33 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/LasTurret.hs
+33 -13
View File
@@ -145,27 +145,47 @@ lasCenSensEdge n = do
lasCenRunClose :: (RandomGen g) => State g (MetaTree Room String) lasCenRunClose :: (RandomGen g) => State g (MetaTree Room String)
lasCenRunClose = do lasCenRunClose = do
npoly <- takeOne [5,6,7,8,9]
inwall <- takeOne obwalls
outwall <- takeOne obwalls
thelight <- mntLightLnkCond $ rprBool $ const . isInLnk thelight <- mntLightLnkCond $ rprBool $ const . isInLnk
thelight1 <- mntLightLnkCond $ rprBool $ const . isOutLnk thelight1 <- mntLightLnkCond $ rprBool $ const . isOutLnk
r <- r <- shuffleLinks =<<
roomNgon 8 250 (roomNgon npoly 250
<&> rmPmnts <&> rmPmnts
.~ [ putLasTurret 0.02 .~ (
, inlinkwall 70 (rectNSWE 10 (-10) (-10) 30) fmap (uncurry inlinkwall) inwall <>
, inlinkwall 125 (rectNSWE 55 (-55) (-10) 10) fmap (uncurry outlinkwall) outwall <>
, inlinkwall 180 (rectNSWE 10 (-10) (-30) 10) [ putLasTurret 0.02
, outlinkwall 70 (rectNSWE 10 (-10) (-30) 10) -- , outlinkwall 70 (rectNSWE 10 (-10) (-30) 10)
, outlinkwall 125 (rectNSWE 55 (-55) (-10) 10) -- , outlinkwall 125 (rectNSWE 55 (-55) (-10) 10)
, outlinkwall 180 (rectNSWE 10 (-10) (-10) 30) -- , outlinkwall 180 (rectNSWE 10 (-10) (-10) 30)
, thelight , thelight
, thelight1 , thelight1
] ]
-- <&> rmLinks %~ setOutLinksByType (PolyEdge 7) )
-- <&> rmLinks %~ tail <&> rmPath %~ addNodesCrossingCirc 0 30
-- <&> rmLinks %~ setOutLinks (const False) <&> rmLinks %~ setInLinksByType (PolyEdge 0)
<&> rmPath %~ addNodesCrossingCirc 0 35 <&> rmLinks %~ setOutLinks (\rl -> or [PolyEdge i `S.member` _rlType rl | i <- [2..npoly-2]])
)
rToOnward "lasCenRunClose" $ return $ cleatOnward r rToOnward "lasCenRunClose" $ return $ cleatOnward r
where where
swall = [ (70, (rectNSWE 10 (-10) (-10) 30))
, (125, (rectNSWE 55 (-55) (-10) 10))
, (180, (rectNSWE 10 (-10) (-30) 10))
]
zwall = [ (70, (rectNSWE 10 (-10) (-30) 10))
, (125, (rectNSWE 55 (-55) (-10) 10))
, (180, (rectNSWE 10 (-10) (-10) 30))
]
iwall = [ (70, (rectNSWE 10 (-10) (-15) 20))
, (180, (rectNSWE 10 (-10) (-30) (-5)))
]
jwall = [ (70, (rectNSWE 10 (-10) (-20) 15))
, (180, (rectNSWE 10 (-10) 5 30))
]
uwall = [ (180, (rectNSWE 10 (-10) (-20) 20)) ]
obwalls = [swall,zwall,iwall,jwall,uwall]
linkwall f x = heightWallPS linkwall f x = heightWallPS
(resetPLUse $ rprBoolShift (const . f) (shiftInBy x <&> (,S.singleton UsedPosLow))) (resetPLUse $ rprBoolShift (const . f) (shiftInBy x <&> (,S.singleton UsedPosLow)))
30 30
src/Dodge/Room/Path.hs
-4
View File
@@ -50,7 +50,3 @@ addNodesCrossingCirc c r = g . foldMap f
| (j:js) <- sortOn (\x -> argV (x - c)) $ S.toList is | (j:js) <- sortOn (\x -> argV (x - c)) $ S.toList is
= S.fromList . zip js $ (tail js <> [j]) = S.fromList . zip js $ (tail js <> [j])
| otherwise = mempty | otherwise = mempty
-- | null is = mempty
-- | otherwise =
-- let (j:js) = sortOn (\x -> argV (x - c)) $ S.toList is
-- in S.fromList . zip js $ (tail js <> [j])