Add new files

src/Geometry.hs

@@ -14,12 +14,14 @@ module Geometry
     , module Geometry.Intersect
     , module Geometry.Bezier
     , module Geometry.Vector
+    , module Geometry.LHS
     )
     where
 import Geometry.Data
 import Geometry.Intersect
 import Geometry.Bezier
 import Geometry.Vector
+import Geometry.LHS
 
 --import Data.Function
 import Data.List
@@ -105,44 +107,6 @@ errorClosestPointOnLineParam :: Int -> Point2 -> Point2 -> Point2 -> Float
 errorClosestPointOnLineParam  _ !x! y! z 
     | x == y    = dist x z
     | otherwise = closestPointOnLineParam x y z
--- | Test whether a point is on the LHS of a line.
--- Returns False if the line is of zero length.
-isLHS 
-    :: Point2  -- ^ First line point. 
-    -> Point2  -- ^ Second line point.
-    -> Point2  -- ^ Point not on line.
-    -> Bool
-{-# INLINE isLHS #-}
-isLHS 
-    (V2 x y)      
-    (V2 x' y')   
-    (V2 x'' y'') 
-    | (x,y) == (x',y')  = False
-    | otherwise = a1 * b2 - a2 * b1 > 0
-  where 
-    a1 = x' - x
-    a2 = y' - y
-    b1 = x'' - x
-    b2 = y'' - y
--- | Test whether a point is on the LHS of a line.
--- Returns False if the line is of zero length.
-isRHS 
-    :: Point2 -- ^ First line point. 
-    -> Point2 -- ^ Second line point.
-    -> Point2 -- ^ Point not on line.
-    -> Bool
-{-# INLINE isRHS #-}
-isRHS 
-    (V2 x y)       
-    (V2 x' y')    
-    (V2 x'' y'')  
-    | (x,y) == (x',y')  = False
-    | otherwise = a1 * b2 - a2 * b1 < 0
-  where 
-    a1 = x' - x
-    a2 = y' - y
-    b1 = x'' - x
-    b2 = y'' - y
 orderPolygonAround 
     :: Point2 -- ^ point to order around
     -> [Point2]
@@ -182,10 +146,6 @@ grahamEliminate (x:y:z:xs)
     | isRHS x y z = grahamEliminate (x:z:xs)
 grahamEliminate xs = xs
 
--- | Return distance between two points.
-dist :: Point2 -> Point2 -> Float
-{-# INLINE dist #-}
-dist !p1 !p2 = magV (p2 -.- p1)
 -- | Return midpoint between two points.
 pHalf :: Point2 -> Point2 -> Point2
 pHalf !a !b = 0.5 *.* (a +.+ b)
@@ -234,18 +194,39 @@ doubleV2 (V2 x y) = [V2 x y,V2 y x]
 
 -- | Test whether two polygons intersect by testing the intersection of each
 -- consecutive pair of points.
+--polysIntersect :: [Point2] -> [Point2] -> Bool
+--{-# INLINE polysIntersect #-}
+--polysIntersect (p:ps) (q:qs) 
+--    -- = any isJust $ (\(V2 a b) (V2 c d) -> myIntersectSegSeg a b c d) <$> pairs1 <*> pairs2
+--    = or $ (\(V2 a b) (V2 c d) -> isJust $ myIntersectSegSeg a b c d) <$> pairs1 <*> pairs2
+--  where 
+--    pairs1 = zipWith V2 (p:ps) (ps++[p])
+--    pairs2 = zipWith V2 (q:qs) (qs++[q])
+--polysIntersect _ _ = False
+
 polysIntersect :: [Point2] -> [Point2] -> Bool
-polysIntersect (p:ps) (q:qs) 
-    = any isJust $ (\(a,b) (c,d) -> myIntersectSegSeg a b c d) <$> pairs1 <*> pairs2
-  where 
-    pairs1 = zip (p:ps) (ps++[p])
-    pairs2 = zip (q:qs) (qs++[q])
+polysIntersect (a:b:xs) ps = go a (a:b:xs) ps
+  where
+    go x' (a':b':xs') ps' = pairPolyIntersect a' b' ps' || go x' (b':xs') ps'
+    go b' (a':[]) ps' = pairPolyIntersect a' b' ps'
+    go _ _ _ = False
 polysIntersect _ _ = False
+
+pairPolyIntersect :: Point2 -> Point2 -> [Point2] -> Bool
+pairPolyIntersect a' b' (c':d':xs') = go c' a' b' (c':d':xs')
+  where
+    go x a b (c:d:xs) 
+        | isJust $ myIntersectSegSeg a b c d = True
+        | otherwise = go x a b (d:xs)
+    go d a b (c:[]) = isJust $ myIntersectSegSeg a b c d
+    go _ _ _ _ = False
+pairPolyIntersect _ _ _ = False
+
 -- | Test whether two polygons intersect or if one is contained in the other.
 polysOverlap :: [Point2] -> [Point2] -> Bool
-polysOverlap (p:ps) (q:qs) = polysIntersect (p:ps) (q:qs) 
-    || pointInPolygon p (q:qs)
+polysOverlap (p:ps) (q:qs) = pointInPolygon p (q:qs)
     || pointInPolygon q (p:ps)
+    || polysIntersect (p:ps) (q:qs) 
 polysOverlap _ _ = False
 -- | Test whether any polygons from a first list intersect with any polygons from
 -- a second list.
@@ -499,6 +480,3 @@ pointIsInCone
     -> Point2           -- ^ Point to test.
     -> Bool
 pointIsInCone c (rightp,leftp) p = isLHS c rightp p && isLHS leftp c p
--- | TODO: implement using Control.Foldl
-centroid :: Foldable t => t Point2 -> Point2
-centroid xs = 1 / fromIntegral (length xs) *.* foldl' (+.+) (V2 0 0) xs