module Numeric.Geometric.Predicates.ESSA (cinttESSA, intersectESSA_SS2D, ccwESSA, incircleESSA, essa, splitDouble) where
import Numeric.Geometric.Primitives
import Data.Foldable (toList,Foldable)
import Control.Applicative
import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Storable
import Foreign.Marshal.Array
import Foreign.C.Types
import System.IO.Unsafe
foreign import ccall unsafe ccw_essa ∷ Float → Float → Float → Float → Float → Float → IO CInt
foreign import ccall unsafe incircle_essa ∷ Float → Float → Float → Float → Float → Float → Float → Float → IO CInt
foreign import ccall unsafe intersect2D_essa ∷ Float → Float → Float → Float → Float → Float → Float → Float → Ptr CInt → Ptr CInt → IO CInt
foreign import ccall unsafe cintt_essa ∷ Float → Float → Float → IO CInt
foreign import ccall unsafe split_double ∷ Double → Ptr Double → Ptr Double → IO ()
foreign import ccall unsafe essa_double ∷ Ptr Double → CSize → IO CInt
cinttESSA ∷ Float → Float → Float → Bool
cinttESSA lo hi p = (unsafePerformIO $ cintt_essa (cast lo) (cast hi) (cast p)) /= 0
intersectESSA_SS2D ∷ LineSegment (Vector2 Float) → LineSegment (Vector2 Float) → LineIntersection
intersectESSA_SS2D (a,b) (c,d) = unsafePerformIO $
alloca (\ip1p →
alloca (\ip2p → do
x ← intersect2D_essa xi yi xj yj xk yk xl yl ip1p ip2p
case x of
0 → return NINP
1 → return Coincident
2 → return Parallel
3 → do
ip1 ← ip <$> peek ip1p
ip2 ← ip <$> peek ip2p
return (Intersecting (ip1,ip2))
_ → error "intersectESSA_SS2D: unexpected result from FFI"
))
where
ip 0 = Endpoint0
ip 1 = Endpoint1
ip 2 = Between
ip _ = error "intersectESSA_SS2D: unexpected intersection result from FFI"
(xi,yi) = castVector a
(xj,yj) = castVector b
(xk,yk) = castVector c
(xl,yl) = castVector d
ccwESSA ∷ Vector2 Float → Vector2 Float → Vector2 Float → Ordering
ccwESSA p1 p2 p3 = compare (unsafePerformIO $ ccw_essa x1 y1 x2 y2 x3 y3) 0
where
(x1,y1) = castVector p1
(x2,y2) = castVector p2
(x3,y3) = castVector p3
incircleESSA ∷ (Vector2 Float, Vector2 Float, Vector2 Float) → Vector2 Float → Ordering
incircleESSA (a,b,c) d = compare (unsafePerformIO (incircle_essa xi yi xj yj xk yk xl yl)) 0
where
(xi,yi) = castVector a
(xj,yj) = castVector b
(xk,yk) = castVector c
(xl,yl) = castVector d
essa ∷ (Functor t, Foldable t) => t Double → Ordering
essa = doubleESSA . fmap realToFrac
splitDouble ∷ Double → (Double,Double)
splitDouble a = unsafePerformIO (alloca (\xp →
alloca (\yp → do
split_double a xp yp
x ← peek xp
y ← peek yp
return (x,y))))
cast ∷ Float → Float
cast = id
castVector ∷ Vector2 Float → Vector2 Float
castVector = id
doubleESSA ∷ (Functor a, Foldable a) => a Double → Ordering
doubleESSA xs = compare v 0
where
v = unsafePerformIO $ withArrayLen (toList xs) f
f = (\i p → essa_double p (fromIntegral i))