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

Finish replacement of sortOn with safeMinimumBy, regress door space leak

Browse Source
This commit is contained in:
justin
2021-07-20 05:40:57 +02:00
parent 8bc5b49a3c
commit 40ee81aff9
4 changed files with 10 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/LevelGen/StaticWalls.hs
+5 -7
View File
@@ -5,6 +5,7 @@ Description : Concerns carving out of static walls to create the general room pl
module Dodge.LevelGen.StaticWalls
where
import Dodge.Data
import Dodge.Base.Collide
import Geometry
--import Control.Lens
@@ -180,8 +181,7 @@ addPolyWall (p1,p2) wls =
else (p1,p2) : wls
Nothing -> (p1,p2) : wls
where
maybeWs = listToMaybe hitWls
hitWls = sortOn (dist p3 . fromJust . f) $ filter (isJust . f) wls
maybeWs = safeMinimumOn (dist p3 . fromJust . f) $ filter (isJust . f) wls
p3 = 0.5 *.* (p1 +.+ p2)
p4 = p3 +.+ 10000 *.* vNormal (p2 -.- p1)
f = uncurry $ myIntersectSegSeg p3 p4
@@ -289,19 +289,18 @@ brokenAdd :: WallP
brokenAdd = head brokenAddedWalls
findShadowWall :: WallP -> [WallP] -> Maybe WallP
findShadowWall (p1,p2) wls = listToMaybe hitWls
findShadowWall (p1,p2) wls = safeMinimumOn (dist p3 . fromJust . f) $ filter (isJust . f) wls
where
p3 = 0.5 *.* (p1 +.+ p2)
p4 = p3 +.+ 10000 *.* rotateV (negate $ pi/4) (vNormal (p2 -.- p1))
hitWls = sortOn (dist p3 . fromJust . f) $ filter (isJust . f) wls
f = uncurry $ myIntersectSegSeg p3 p4
findShadowWalls :: WallP -> [WallP] -> [WallP]
findShadowWalls (p1,p2) wls = hitWls
where
hitWls = sortOn (dist p3 . fromJust . f) $ filter (isJust . f) wls
p3 = 0.5 *.* (p1 +.+ p2)
p4 = p3 +.+ 10000 *.* vNormal (p2 -.- p1)
hitWls = sortOn (dist p3 . fromJust . f) $ filter (isJust . f) wls
f = uncurry $ myIntersectSegSeg p3 p4
addWallDebug :: WallP -> [WallP] -> [WallP]
@@ -312,8 +311,7 @@ addWallDebug (p1,p2) wls =
else (p1,p2) : wls
Nothing -> (p1,p2) : wls
where
maybeWs = listToMaybe hitWls
hitWls = sortOn (dist p3 . fromJust . f) $ filter (isJust . f) wls
maybeWs = safeMinimumOn (dist p3 . fromJust . f) $ filter (isJust . f) wls
p3 = 0.5 *.* (p1 +.+ p2)
p4 = p3 +.+ 10000 *.* vNormal (p2 -.- p1)
f = uncurry $ myIntersectSegSeg p3 p4