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

Non-convex chasms

Browse Source
This commit is contained in:
justin
2026-01-26 10:59:51 +00:00
parent 962df63e62
commit a6976eae8d
11 changed files with 341 additions and 323 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/Tutorial.hs
+8 -8
View File
@@ -135,7 +135,7 @@ cChasm = do
roomRectAutoLinks x y
<&> rmLinks %~ setOutLinks (isCornerLink NorthWest)
<&> rmLinks %~ setInLinks (isCornerLink SouthWest)
<&> rmPmnts <>~ [sps0 $ PutChasm (rectNSWE (y -50) 50 0 (x -50))]
<&> rmPmnts <>~ [sps0 $ putConvexChasm (rectNSWE (y -50) 50 0 (x -50))]
lChasm :: State LayoutVars Room
lChasm = do
@@ -144,7 +144,7 @@ lChasm = do
roomRectAutoLinks x y
<&> rmLinks %~ setOutLinks (isCornerLink NorthWest)
<&> rmLinks %~ setInLinks (isCornerLink SouthEast)
<&> rmPmnts <>~ [sps0 $ PutChasm (rectNSWE (y -50) 0 0 (x -50))]
<&> rmPmnts <>~ [sps0 $ putConvexChasm (rectNSWE (y -50) 0 0 (x -50))]
-- the Float is the width of the bridge
zChasm :: Float -> State LayoutVars Room
@@ -156,8 +156,8 @@ zChasm z = do
<&> rmLinks %~ setInLinks (isCornerLink SouthEast)
<&> rmPath %~ addNodesCrossing (V2 0 (y/2),V2 x (y/2))
<&> rmPmnts
<>~ [ sps0 $ PutChasm (rectNSWE (y / 2 - z) 0 0 (x -50))
, sps0 $ PutChasm (rectNSWE y (y / 2 + z) 50 x)
<>~ [ sps0 $ putConvexChasm (rectNSWE (y / 2 - z) 0 0 (x -50))
, sps0 $ putConvexChasm (rectNSWE y (y / 2 + z) 50 x)
]
midChasm :: State LayoutVars Room
@@ -174,10 +174,10 @@ midChasm = do
where
censquare x y = do
z <- state $ randomR (40, 60)
return [sps0 $ PutChasm (rectNSWE (y - z) z z (x - z))]
return [sps0 $ putConvexChasm (rectNSWE (y - z) z z (x - z))]
cenoct x y =
return
[sps0 $ PutChasm $ (V2 (x / 2) (y / 2) +) <$> polyOrthDist 8 (min x y / 2 - 25)]
[sps0 $ putConvexChasm $ (V2 (x / 2) (y / 2) +) <$> polyOrthDist 8 (min x y / 2 - 25)]
-- dia x y = [sps0 $ PutChasm [V2 ]
@@ -185,7 +185,7 @@ polyChasm :: Int -> Float -> State LayoutVars Room
polyChasm n x =
shuffleLinks
=<< ( roomNgon n x
<&> rmPmnts <>~ [sps0 $ PutChasm $ polyOrthDist n (x -30)]
<&> rmPmnts <>~ [sps0 $ putConvexChasm $ polyOrthDist n (x -30)]
<&> rmLinks %~ setOutLinks (\rl -> rl ^. rlPos . _y > 0)
<&> rmLinks %~ setInLinks (\rl -> rl ^. rlPos . _y < (5 - x))
)
@@ -193,7 +193,7 @@ polyChasm n x =
polyChasmC :: Int -> Float -> State LayoutVars Room
polyChasmC n x =
roomNgon n x
<&> rmPmnts <>~ [sps0 $ PutChasm $ rectNSWE x (60 - x) (-40) 40]
<&> rmPmnts <>~ [sps0 $ putConvexChasm $ rectNSWE x (60 - x) (-40) 40]
<&> rmLinks %~ setInLinks (\rl -> PolyEdge 1 `S.member` (rl ^. rlType))
<&> rmLinks %~ setOutLinks (\rl -> PolyEdge (n -1) `S.member` (rl ^. rlType))