Cleanup

src/Geometry/Intersect.hs

@@ -17,12 +17,20 @@ import Linear
 -- | If two lines intersect, return 'Just' that point.
 intersectLineLine :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 {-# INLINE intersectLineLine #-}
-intersectLineLine (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
+--intersectLineLine a@(V2 x1 y1) b@(V2 x2 y2) c@(V2 x3 y3) d@(V2 x4 y4)
-    | den == 0 = Nothing
+intersectLineLine a b c d = do
-    | otherwise = Just $ V2 (x1 + (x2 - x1) * t' / den) (y1 + (y2 - y1) * t' / den)
+    let den = detV (a-b) (c-d)
-  where
+    guard $ den /= 0
-    den = (x1 - x2) * (y3 - y4) - (y1 - y2) * (x3 - x4)
+    let t = detV (a-c) (c-d)
-    t' = (x1 - x3) * (y3 - y4) - (y1 - y3) * (x3 - x4)
+    return $ a + (t/den) *^ (b-a)
+--    | den == 0 = Nothing
+--    | otherwise = Just $ a + (t/den) *^ (b - a)
+----    | otherwise = Just $ V2 (x1 + (x2 - x1) * t / den) (y1 + (y2 - y1) * t / den)
+--  where
+--    den = detV (a-b) (c-d)
+----    den = (x1 - x2) * (y3 - y4) - (y1 - y2) * (x3 - x4)
+--    t = detV (a-c) (c-d) --x1 - x3) * (y3 - y4) - (y1 - y3) * (x3 - x4)
+----    t = (x1 - x3) * (y3 - y4) - (y1 - y3) * (x3 - x4)
 
 ---- note that the second argument is a vector, not the second point of the line
 --intersectLinePlane :: Point3 -> Point3 -> Point3 -> Point3 -> Maybe Point3
@@ -38,13 +46,17 @@ intersectLinePlaneAlong x y p n = do
 
 -- this needs to be checked
 intersectSegPlane :: Point3 -> Point3 -> Point3 -> Point3 -> Maybe Point3
-intersectSegPlane sp ep p n = case dot v n of
+intersectSegPlane x y p n = do
-    0 -> Nothing
+    d <- intersectLinePlaneAlong x y p n
-    x -> case dot (p - sp) n / x of
+    guard $ d >= 0 && d < 1
-        d | d >= 0 && d <= 1 -> Just $ sp + d *.*.* v
+    return $ x + d *^ (y - x)
-        _ -> Nothing
+--case dot v n of
-  where
+--    0 -> Nothing
-    v = ep - sp
+--    x -> case dot (p - sp) n / x of
+--        d | d >= 0 && d <= 1 -> Just $ sp + d *.*.* v
+--        _ -> Nothing
+--  where
+--    v = ep - sp
 
 intersectSegSurface ::
     Point3 ->
@@ -112,20 +124,20 @@ intersectSegRay (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
     t' = (x1 - x3) * (y3 - y4) - (y1 - y3) * (x3 - x4)
     u' = (y1 - y2) * (x1 - x3) - (x1 - x2) * (y1 - y3)
 
--- | Similar to 'intersectSegLineFrom'', but this version is probably not correct...
+---- | Similar to 'intersectSegLineFrom'', but this version is probably not correct...
-intersectSegLineext :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
+--intersectSegLineext :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
-{-# INLINE intersectSegLineext #-}
+--{-# INLINE intersectSegLineext #-}
-intersectSegLineext (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
+--intersectSegLineext (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
-    | den == 0 = Nothing
+--    | den == 0 = Nothing
-    | den > 0 && (t' < 0 || u' < den || t' > den) =
+--    | den > 0 && (t' < 0 || u' < den || t' > den) =
-        Nothing
+--        Nothing
-    | den < 0 && (t' > 0 || u' > - den || t' < den) =
+--    | den < 0 && (t' > 0 || u' > - den || t' < den) =
-        Nothing
+--        Nothing
-    | otherwise = Just $ V2 (x1 + (x2 - x1) * t' / den) (y1 + (y2 - y1) * t' / den)
+--    | otherwise = Just $ V2 (x1 + (x2 - x1) * t' / den) (y1 + (y2 - y1) * t' / den)
-  where
+--  where
-    den = (x1 - x2) * (y3 - y4) - (y1 - y2) * (x3 - x4)
+--    den = (x1 - x2) * (y3 - y4) - (y1 - y2) * (x3 - x4)
-    t' = (x1 - x3) * (y3 - y4) - (y1 - y3) * (x3 - x4)
+--    t' = (x1 - x3) * (y3 - y4) - (y1 - y3) * (x3 - x4)
-    u' = (y1 - y2) * (x1 - x3) - (x1 - x2) * (y1 - y3)
+--    u' = (y1 - y2) * (x1 - x3) - (x1 - x2) * (y1 - y3)
 
 {- | Intersect a segment with a line.
  the line intersects with the first endpoint of the segment

src/Geometry/Vector.hs

@@ -173,12 +173,6 @@ magV :: Point2 -> Float
 {-# INLINE magV #-}
 magV (V2 x y) = sqrt $ x ^ (2 :: Int) + y ^ (2 :: Int)
 
-{- | Magnitude of the cross product of two vectors.
-Identical to detV.
--}
-crossV :: Point2 -> Point2 -> Float
-crossV (V2 ax ay) (V2 bx by) = ax * by - ay * bx
-
 -- | TO CHECK Orthographic projection of one vector onto another.
 projV :: Point2 -> Point2 -> Point2
 projV fromv onv