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

Try to simplify link code in roomRect

Browse Source
This commit is contained in:
justin
2025-10-27 15:10:19 +00:00
parent c88fc1c729
commit 0946ee1310
9 changed files with 95 additions and 105 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/Procedural.hs
+29 -19
View File
@@ -44,12 +44,8 @@ roomRect x y xn yn =
{ _rmPolys = [rectNSWE y 0 0 x]
, _rmLinks = lnks
, _rmName = "rect"
, _rmPath = foldMap doublePairSet pth
, --, _rmPos = map (roomposat (RoomPosOnPath S.empty)) posps
-- ++ map (roomposat (RoomPosOffPath S.empty)) interposps
_rmPos =
map makeonpos posps
++ map makeoffpos interposps
, _rmPath = pth
, _rmPos = map makeonpos posps ++ map makeoffpos interposps
, _rmPmnts = []
, _rmBound = [rectNSWE (y + 5) (-5) (-5) (x + 5)]
, _rmFloor =
@@ -78,20 +74,34 @@ roomRect x y xn yn =
ys = take (yn + 1) [0,yd..] & each +~ 20
yd = (y - 40) / fromIntegral yn
xd = (x - 40) / fromIntegral xn
pth = linksGridToPath lnks
$ latticeXsYs xs ys
--pth = linksGridToPath lnks
-- $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn)
pth = linksDAGToPath lnks $ latticeXsYs xs ys
hls y' a e = xs <&> \x' -> RoomLink (rlt e) (V2 x' y') a
vls x' a e = ys <&> \y' -> RoomLink (rlt e) (V2 x' y') a
rlt e = S.fromList [OnEdge e, InLink, OutLink]
somelnks poffset ps a = zip (map (+.+ poffset) ps) (repeat a)
wlnks = somelnks (V2 0 20) (gridPoints 0 1 yd (yn + 1)) (pi / 2)
elnks = somelnks (V2 x 20) (gridPoints 0 1 yd (yn + 1)) (- pi / 2)
nlnks = somelnks (V2 20 y) (gridPoints xd (xn + 1) 0 1) 0
slnks = somelnks (V2 20 0) (gridPoints xd (xn + 1) 0 1) pi
lnks =
m North (FromEdge West) (FromEdge East) nlnks
++ m East (FromEdge South) (FromEdge North) elnks
++ m West (FromEdge South) (FromEdge North) wlnks
++ m South (FromEdge West) (FromEdge East) slnks
wlnks = vls 0 (pi/2) West
elnks = vls x (-pi/2) East
nlnks = hls y 0 North --somelnks (V2 20 y) (gridPoints xd (xn + 1) 0 1) 0
slnks = hls 0 pi South --somelnks (V2 20 0) (gridPoints xd (xn + 1) 0 1) pi
lnks = zipWith g nlnks [0..]
<> zipWith g slnks [0..]
<> zipWith g' elnks [0..]
<> zipWith g' wlnks [0..]
g ln xi = ln & rlType <>~ S.fromList [FromEdge West xi,FromEdge East (xn - xi)]
g' ln xi = ln & rlType <>~ S.fromList [FromEdge South xi,FromEdge North (xn - xi)]
-- lnks= m North (FromEdge West) (FromEdge East) nlnks
-- ++ m East (FromEdge South) (FromEdge North) elnks
-- ++ m West (FromEdge South) (FromEdge North) wlnks
-- ++ m South (FromEdge West) (FromEdge East) slnks
--wlnks = somelnks (V2 0 20) (gridPoints 0 1 yd (yn + 1)) (pi / 2)
--elnks = somelnks (V2 x 20) (gridPoints 0 1 yd (yn + 1)) (- pi / 2)
--nlnks = somelnks (V2 20 y) (gridPoints xd (xn + 1) 0 1) 0
--slnks = somelnks (V2 20 0) (gridPoints xd (xn + 1) 0 1) pi
--lnks =
-- m North (FromEdge West) (FromEdge East) nlnks
-- ++ m East (FromEdge South) (FromEdge North) elnks
-- ++ m West (FromEdge South) (FromEdge North) wlnks
-- ++ m South (FromEdge West) (FromEdge East) slnks
m edge edgefrom1 edgefrom2 =
zipWith (lnkBothAnd (OnEdge edge) edgefrom1 edgefrom2) [0 ..]
. zipCountDown