Improve line zoning

This commit is contained in:
jgk
2021-08-16 14:44:52 +02:00
parent 3192ae628f
commit c58ee6d56c
13 changed files with 197 additions and 86 deletions
+5 -5
View File
@@ -74,7 +74,7 @@ wallNormal wl = normalizeV . vNormal $ a -.- b
wallsOnLine :: Point2 -> Point2 -> IM.IntMap Wall -> [Wall]
wallsOnLine p1 p2 ws = hitWalls
where
hitPoint w = uncurry (intersectSegSeg' p1 p2) (_wlLine w)
hitPoint w = uncurry (intersectSegSeg p1 p2) (_wlLine w)
hitWalls = filter (isJust . hitPoint) (IM.elems ws)
wallsOnCirc :: Point2 -> Float -> IM.IntMap Wall -> IM.IntMap Wall
@@ -252,7 +252,7 @@ collidePointFF = undefined
-- -> Maybe (Point2,(Maybe (Point2,StdGen),Int))
--collidePointFF p1 p2 g ff = fmap f ip
-- where (p3:p4:_) = _ffLine ff
-- ip = intersectSegSeg' p1 p2 p3 p4
-- ip = intersectSegSeg p1 p2 p3 p4
-- ref = (_ffDeflect ff) <*> Just g <*> Just (p2 -.- p1) <*> Just ff
-- f p = (p, (ref, _ffID ff))
--
@@ -267,7 +267,7 @@ collideCircWalls' p1 p2 rad ws
((, reflectInParam 0.5 (x -.- y) (p2 -.- p1))
. (+.+ errorNormalizeV 40 (vNormal (x -.- y)))
)
(intersectSegSeg' p1 p2 x y)
(intersectSegSeg p1 p2 x y)
)
. shiftByRad . _wlLine
) ws
@@ -288,7 +288,7 @@ collideCircWalls' p1 p2 rad ws
collidePointLines :: Point2 -> Point2 -> [Wall'] -> Maybe (Point2,Point2)
collidePointLines p1 p2 ws
= safeMinimumOn f
$ mapMaybe (( \(x,y) -> intersectSegSeg' p1 p2 x y <&> ( , vNormal $ x -.- y ) )
$ mapMaybe (( \(x,y) -> intersectSegSeg p1 p2 x y <&> ( , vNormal $ x -.- y ) )
. _wlLine') ws
where
f (a,_) = magV (p1 -.- a)
@@ -298,7 +298,7 @@ collidePointLines p1 p2 ws
collidePointWallsNorm :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2)
collidePointWallsNorm p1 p2 ws
= safeMinimumOn f
$ IM.mapMaybe (( \(x,y) -> intersectSegSeg' p1 p2 x y <&> ( , vNormal $ x -.- y ) )
$ IM.mapMaybe (( \(x,y) -> intersectSegSeg p1 p2 x y <&> ( , vNormal $ x -.- y ) )
. _wlLine) ws
where
f (a,_) = magV (p1 -.- a)