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

Further strictifying

Browse Source
This commit is contained in:
jgk
2021-07-30 00:23:02 +02:00
parent bd8ef3f416
commit 2d8b27746c
33 changed files with 228 additions and 211 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/LevelGen/LineBlock.hs
+1 -1
View File
@@ -29,7 +29,7 @@ putLineBlock basePane blockWidth depth a b w = removePathsCrossing a b $ foldr i
blockCenPs = snd $ evenOddSplit psOnLine
numBlocks = length blockCenPs
is = [0.. numBlocks - 1]
cornerPoints =
cornerPoints = map toV2
[(-halfBlockWidth,-depth) -- goes anticlockwise around the block
,(-halfBlockWidth, depth)
,( halfBlockWidth, depth)
src/Dodge/LevelGen/Pathing.hs
+1 -1
View File
@@ -24,5 +24,5 @@ removePathsCrossing a b w = set pathGraph newGraph $ set pathGraph' pg'
w
where
pg' = filter (isNothing . uncurry (intersectSegSeg' a b)) $ _pathGraph' w
insertPoint pp@(_,(x,y)) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
insertPoint pp@(_,(V2 x y)) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
newGraph = pairsToGraph dist pg'
src/Dodge/LevelGen/TriggerDoor.hs
+3 -2
View File
@@ -33,11 +33,12 @@ addButtonDoor c btp btr a b w = over buttons (IM.insert bid bt)
(newGraphPairs,removedPairs) = partition (isNothing . uncurry (intersectSegSeg' a b))
$ _pathGraph' w
newGraph = pairsToGraph dist newGraphPairs
insertPoint pp@(_,(x,y)) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
insertPoint pp@(_,(V2 x y)) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
eff w' = over pathGraph' (removedPairs ++)
. over pathGraph (flip run_ $ insMapEdgesM $ map f removedPairs) $ w'
f (x,y) = (x,y,dist x y)
-- this has been repeated at least three times: TO BE UNIFIED, REFACTORED
addSwitchDoor :: Color -> Point2 -> Float -> Point2 -> Point2 -> World -> World
addSwitchDoor c btp btr a b w = over buttons (IM.insert bid bt)
$ set pathPoints (foldr insertPoint IM.empty (labNodes newGraph))
@@ -51,7 +52,7 @@ addSwitchDoor c btp btr a b w = over buttons (IM.insert bid bt)
(newGraphPairs,removedPairs) = partition (isNothing . uncurry (intersectSegSeg' a b))
$ _pathGraph' w
newGraph = pairsToGraph dist newGraphPairs
insertPoint pp@(_,(x,y)) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
insertPoint pp@(_,(V2 x y)) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
openDoor w' = over pathGraph' (removedPairs ++)
. over pathGraph (flip run_ $ insMapEdgesM $ map f removedPairs) $ w'
f (x,y) = (x,y,dist x y)