Reorganise geometry modules slightly

src/Geometry/Intersect.hs

@@ -1,13 +1,14 @@
+{-# LANGUAGE BangPatterns #-}
 --{-# LANGUAGE TupleSections #-}
-{-
-Testing for and finding intersection points.
--}
+{- Testing for and finding intersection points.  -}
 module Geometry.Intersect where
 import Geometry.Data
 import Geometry.Vector
 import Geometry.LHS
 import Control.Applicative
 
+import Data.List
+
 import Data.Maybe (isNothing)
 -- | If two lines intersect, return 'Just' that point.
 intersectLineLine' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
@@ -212,3 +213,51 @@ intersectSegPolyFirst :: Point2 -> Point2 -> [Point2] -> Maybe Point2
 intersectSegPolyFirst a b xs = foldr (<|>) Nothing $ zipWith lineColl xs (tail xs ++ [head xs])
   where
     lineColl = intersectSegSeg a b
+
+-- | Given a line and a point return the point on the line closest to the
+-- point.
+closestPointOnLine 
+    :: Point2 -- ^ First line point. 
+    -> Point2 -- ^ Second line point.
+    -> Point2 -- ^ Point not on line.
+    -> Point2
+{-# INLINE closestPointOnLine #-}
+closestPointOnLine !a  !b  !p  = a +.+ u *.* (b -.- a)
+  where u = closestPointOnLineParam a b p
+-- | Given a line and a point return a value corresponding to how far along the
+-- line the point is.
+closestPointOnLineParam 
+    :: Point2   -- ^ First line point. 
+    -> Point2   -- ^ Second line point.
+    -> Point2   -- ^ Point not on line.
+    -> Float
+{-# INLINE closestPointOnLineParam #-}
+closestPointOnLineParam !a !b !p
+    = (p -.- a) `dotV` (b -.- a) / (b -.- a) `dotV` (b -.- a)
+
+-- | Given a segment and external point, find the closest point on the segment.
+-- clamps to the end of the segment
+closestPointOnSeg :: Point2 -> Point2 -> Point2 -> Point2
+closestPointOnSeg segP1 segP2 p
+    | closestPointOnLineParam segP1 segP2 p <= 0 = segP1
+    | closestPointOnLineParam segP1 segP2 p >= 1 = segP2
+    | otherwise                                  = closestPointOnLine segP1 segP2 p
+
+-- | Given a segment and external point, find the closest point on the segment.
+-- does not return closest points beyond the segment
+orthogonalPointOnSeg :: Point2 -> Point2 -> Point2 -> Maybe Point2
+orthogonalPointOnSeg a b p
+    | param < 0 || param > 1 = Nothing
+    | otherwise              = Just $ a +.+ param *.* (normalizeV $ b -.- a)
+  where
+    param = closestPointOnLineParam a b p
+intersectCircSeg :: Point2 -> Float -> Point2 -> Point2 -> [Point2]
+intersectCircSeg c r a b 
+    | y < 0 = []
+    | otherwise = nub $ filter ( (< dist a b) . dist a ) [ d -.- v, d +.+ c ]
+  where
+    d = closestPointOnLine a b c
+    x = dist d c
+    y = r ** 2 - x ** 2
+    z = sqrt y
+    v = z *.* normalizeV (b -.- a)