Improve intersection test--fails sometimes

src/Dodge/LevelGen/StaticWalls.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE TupleSections #-}
 {-|
 Module      : Dodge.LevelGen.StaticWalls
 Description : Concerns carving out of static walls to create the general room plan of the level.
@@ -154,11 +155,10 @@ cutWallsWithPoints (p:ps) ws = foldl' f ([],ws) (zip (p:ps) (ps++[p]))
 cutWallsWithPoints _ _ = error "Trying to cut empty polygon"
 -- | List the points of intersection between a segment and collection of walls.
 cutWallsPoints :: Point2 -> Point2 -> [WallP] -> [Point2]
---cutWallsPoints p1 p2 ws = mapMaybe (\(x:y:_) -> intersectExtendedSegSeg p1 p2 x y)
-cutWallsPoints p1 p2 = mapMaybe (uncurry $ myIntersectSegSeg p1 p2)
+cutWallsPoints p1 p2 = mapMaybe (uncurry $ intersectSegSegPreTest p1 p2)
 -- | Given a segment and a wall, split the wall into two if it crosses the segment.
 cutWall :: Point2 -> Point2 -> WallP -> [WallP]
-cutWall p1 p2 (x,y) = case myIntersectSegSeg p1 p2 x y of
+cutWall p1 p2 (x,y) = case intersectSegSegPreTest p1 p2 x y of
     Nothing -> [(x,y)]
     Just cp -> [(x,cp),(cp,y)]
 -- | Add poly walls?
@@ -182,10 +182,13 @@ addPolyWall wls (p1,p2) =
             else (p1,p2) : wls
         Nothing -> (p1,p2) : wls
   where 
-    maybeWs = safeMinimumOn (dist p3 . fromJust . f) $ filter (isJust . f) wls
+    --maybeWs = safeMinimumOn (dist p3 . fromJust . f) $ filter (isJust . f) wls
+    --maybeWs = fmap fst $ safeMinimumOn (dist p3 . snd) $ mapMaybe (\x -> (x,) <$> f x) wls
+    maybeWs = safeMinimumOnMaybe (fmap (dist p3) . f) wls
     p3 = 0.5 *.* (p1 +.+ p2)
     p4 = p3 +.+ 10000 *.* vNormal (p2 -.- p1)
-    f = uncurry $ myIntersectSegSeg p3 p4
+    f = uncurry $ intersectSegSegPreTest p3 p4
+    --g = uncurry $ intersectSegSegTest p3 p4
 -- | Given a list of points and a point, returns a point in the list if any is close
 -- to the point.
 findClosePoint :: [Point2] -> Point2 -> Maybe Point2