Cleanup, improve auto wall rotate

This commit is contained in:
2026-03-24 11:28:11 +00:00
parent be2f7160ba
commit 32f1740577
25 changed files with 226 additions and 252 deletions
+26 -26
View File
@@ -49,7 +49,7 @@ import Shape
-- no lights!
cenLasTur :: (RandomGen g) => State g Room
cenLasTur = do
cenLasTur =
roomNgon 8 200
<&> rmPmnts
.~ [ putLasTurret 0.02
@@ -168,7 +168,7 @@ lasCenSensEdge n = do
lshape <- takeOne [vShape, lShape, jShape, liShape]
let alight a rp = mntLSCond (fmap (fmap $ colorSH black) lshape) (PS (rotateV a $ _rpPos rp) (a + _rpDir rp))
blight a = (0, return . alight a . f i)
let cenroom = cenroom' & rmInPmnt <>~ map blight [pi, (0.5 * pi), (1.5 * pi)]
let cenroom = cenroom' & rmInPmnt <>~ map blight [pi, 0.5 * pi, 1.5 * pi]
let doorroom = triggerDoorRoom n
rToOnward "lasCenSensEdge" $
treeFromTrunk [door] $
@@ -194,7 +194,7 @@ lasRunYinYang = do
const
. ( \rp ->
PolyEdge ((npoly + 1) `div` 4)
`S.member` (fold $ rp ^? rpType . rplsType)
`S.member` fold (rp ^? rpType . rplsType)
)
thelight3 <-
mntLightLnkCond $
@@ -202,7 +202,7 @@ lasRunYinYang = do
const
. ( \rp ->
PolyEdge (3 * (npoly + 1) `div` 4)
`S.member` (fold $ rp ^? rpType . rplsType)
`S.member` fold (rp ^? rpType . rplsType)
)
r <-
shuffleLinks
@@ -231,16 +231,16 @@ lasRunYinYang = do
)
rToOnward "lasCenRunClose" $ return $ cleatOnward r
where
awall x v = heightWallPS (PS x 0) 30 v
awall x = heightWallPS (PS x 0) 30
-- angwall a = awall (V2 0 100 + rotateV a (V2 0 100)) (fmap (rotateV (pi/4 + a/2)) $ rectWH 5 (25 - a*10/pi ))
rf = 0.8
offxy = V2 0 (-100)
angwall a = awall (V2 0 100 + rotateV a (V2 0 100)) (fmap (rotateV (pi / 4 + a * rf)) $ rectWH 5 (23 - a * 13 / pi))
angwall a = awall (V2 0 100 + rotateV a (V2 0 100)) (rotateV (pi / 4 + a * rf) <$> 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 * rf)) $ rectWH 5 (23 - a * 13 / pi))
bngwall a = awall (V2 0 (-100) + rotateV a (V2 0 (-100))) (rotateV (pi / 4 + a * rf) <$> 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
@@ -257,7 +257,7 @@ lasRunYinYangCenter = do
const
. ( \rp ->
PolyEdge ((npoly + 1) `div` 4)
`S.member` (fold $ rp ^? rpType . rplsType)
`S.member` fold (rp ^? rpType . rplsType)
)
thelight3 <-
mntLightLnkCond $
@@ -265,7 +265,7 @@ lasRunYinYangCenter = do
const
. ( \rp ->
PolyEdge (3 * (npoly + 1) `div` 4)
`S.member` (fold $ rp ^? rpType . rplsType)
`S.member` fold (rp ^? rpType . rplsType)
)
-- thelight3 <- mntLightLnkCond $ rprBool $ const . isOutLnk
r <-
@@ -293,14 +293,14 @@ lasRunYinYangCenter = do
)
rToOnward "lasCenRunClose" $ return $ cleatOnward r
where
awall x v = heightWallPS (PS x 0) 30 v
awall x = heightWallPS (PS x 0) 30
-- 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))
angwall a = awall (V2 0 100 + rotateV a (V2 0 100)) (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))
bngwall a = awall (V2 0 (-100) + rotateV a (V2 0 (-100))) (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
@@ -334,24 +334,24 @@ lasCenRunClose' = do
rToOnward "lasCenRunClose" $ return $ cleatOnward r
where
swall =
[ (70, (rectNSWE 10 (-10) (-10) 30))
, (125, (rectNSWE 55 (-55) (-10) 10))
, (180, (rectNSWE 10 (-10) (-30) 10))
[ (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))
[ (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)))
[ (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))
[ (70, rectNSWE 10 (-10) (-20) 15)
, (180, rectNSWE 10 (-10) 5 30)
]
uwall = [(180, (rectNSWE 10 (-10) (-20) 20))]
uwall = [(180, rectNSWE 10 (-10) (-20) 20)]
obwalls = [swall, zwall, iwall, jwall, uwall]
linkwall f x =
heightWallPS
@@ -390,7 +390,7 @@ lasCenRunCloseLongCor = do
where
llinks = memtest (FromEdge South 1) (OnEdge West)
rlinks = memtest (FromEdge South 1) (OnEdge East)
awall x v = heightWallPS (PS x 0) 30 v
awall x = heightWallPS (PS x 0) 30
memtest a b x =
let y = _rlType x
in a `S.member` y && b `S.member` y
@@ -459,7 +459,7 @@ lasCenRunClose1 = do
etest
(memtest (FromEdge East 0) (OnEdge South))
(memtest (FromEdge South 0) (OnEdge East))
awall x v = heightWallPS (PS x 0) 30 v
awall x = heightWallPS (PS x 0) 30
etest f g x = f x || g x
memtest a b x =
let y = _rlType x
@@ -500,7 +500,7 @@ lasCenRunClose2 = do
etest
(memtest (FromEdge East 0) (OnEdge North))
(memtest (FromEdge North 0) (OnEdge East))
awall x v = heightWallPS (PS x 0) 30 v
awall x = heightWallPS (PS x 0) 30
etest f g x = f x || g x
memtest a b x =
let y = _rlType x