Cleanup, improve auto wall rotate
This commit is contained in:
+26
-26
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user