module Numeric.Geometric.Predicates.Interval (cinttSSE, incircleSSE, ccwSSE) where
import Numeric.Geometric.Primitives
import System.IO.Unsafe
import Foreign.Ptr
import Foreign.Marshal
import Foreign.C.Types
import Control.Exception (assert)
import GHC.Float
foreign import ccall unsafe ccw_d ∷ Double → Double → Double → Double → Double → Double → Ptr Double → IO ()
foreign import ccall unsafe incircle_d ∷ Double → Double → Double → Double → Double → Double → Double → Double → Ptr Double → IO ()
foreign import ccall unsafe cintt_d ∷ Double → Double → Double → Ptr Double → IO CInt
cinttSSE ∷ Real a => a → a → a → Maybe Bool
cinttSSE a b c = cinttSSE_D (realToFrac a) (realToFrac b) (realToFrac c)
ccwSSE ∷ Real a => Vector2 a → Vector2 a → Vector2 a → Maybe Ordering
ccwSSE (xa,ya) (xb,yb) (xc,yc) = ccwSSE_D (realToFrac xa,realToFrac ya)
(realToFrac xb,realToFrac yb)
(realToFrac xc,realToFrac yc)
incircleSSE ∷ Real a => (Vector2 a, Vector2 a, Vector2 a) → Vector2 a → Maybe Ordering
incircleSSE ((x1,y1), (x2,y2), (x3,y3)) (x4,y4) = incircleSSE_D ((realToFrac x1, realToFrac y1),
(realToFrac x2, realToFrac y2),
(realToFrac x3, realToFrac y3))
(realToFrac x4, realToFrac y4)
cinttSSE_F ∷ Float → Float → Float → Maybe Bool
cinttSSE_F a b c = cinttSSE_D (float2Double a) (float2Double b) (float2Double c)
ccwSSE_F ∷ Vector2 Float → Vector2 Float → Vector2 Float → Maybe Ordering
ccwSSE_F (xa,ya) (xb,yb) (xc,yc) = ccwSSE_D (float2Double xa,float2Double ya)
(float2Double xb,float2Double yb)
(float2Double xc,float2Double yc)
incircleSSE_F ∷ (Vector2 Float, Vector2 Float, Vector2 Float) → Vector2 Float → Maybe Ordering
incircleSSE_F ((x1,y1), (x2,y2), (x3,y3)) (x4,y4) = incircleSSE_D ((float2Double x1, float2Double y1),
(float2Double x2, float2Double y2),
(float2Double x3, float2Double y3))
(float2Double x4, float2Double y4)
cinttSSE_D ∷ Double → Double → Double → Maybe Bool
cinttSSE_D l h p
| l == h = Just (p == l)
| otherwise = unsafePerformIO $ allocaArray 2 $ \out → do
x ← cintt_d l h p out
if x == 0
then return Nothing
else do
[hi,lo] ← peekArray 2 out
return . assert (lo <= hi) $ check lo hi
where
check lo hi
| hi < 0 = Just False
| lo > 1 = Just False
| lo >= 0 && hi <= 1 = Just True
| otherwise = Nothing
incircleSSE_D ∷ (Vector2 Double, Vector2 Double, Vector2 Double) → Vector2 Double → Maybe Ordering
incircleSSE_D ((x1,y1), (x2,y2), (x3,y3)) (x4,y4) = unsafePerformIO $ allocaArray 2 $ \out → do
incircle_d x1 y1
x2 y2
x3 y3
x4 y4 out
[hi,lo] ← peekArray 2 out
return . assert (lo <= hi) $ check lo hi
where
check lo hi
| lo > 0 = Just GT
| hi < 0 = Just LT
| lo == 0 && hi == 0 = Just EQ
| otherwise = Nothing
ccwSSE_D ∷ Vector2 Double → Vector2 Double → Vector2 Double → Maybe Ordering
ccwSSE_D (x1,y1) (x2,y2) (x3,y3) = unsafePerformIO $ allocaArray 2 $ \out → do
ccw_d x1 y1
x2 y2
x3 y3 out
[hi,lo] ← peekArray 2 out
return . assert (lo <= hi) $ check lo hi
where
check lo hi
| lo > 0 = Just GT
| hi < 0 = Just LT
| lo == 0 && hi == 0 = Just EQ
| otherwise = Nothing