-- GENERATED by C->Haskell Compiler, version 0.28.3 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Chiphunk/Low/Helper.chs" #-}
-- | Description: Helpers functions mostly for estimating certain measures.
-- Module provides helper function mostly for estimating certain measures.
module Chiphunk.Low.Helper
  ( momentForCircle
  , momentForSegment
  , momentForPoly
  , momentForBox
  , areaForCircle
  , areaForSegment
  , areaForPoly
  , centroidForPoly
  , convexHull
  , convexDecomposition
  ) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified System.IO.Unsafe as C2HSImp



import Data.VectorSpace
import Foreign
import System.IO.Unsafe

import Chiphunk.Low.Internal

import Chiphunk.Low.Types
{-# LINE 22 "src/Chiphunk/Low/Helper.chs" #-}





-- | Calculate the moment of inertia for a hollow circle, @r1@ and @r2@ are the inner and outer diameters
-- in no particular order. (A solid circle has an inner diameter of 0)
momentForCircle
  :: Double -- ^ Mass
  -> Double -- ^ r1
  -> Double -- ^ r2
  -> Vect   -- ^ Offset
  -> Double
momentForCircle :: Double -> Double -> Double -> Vect -> Double
momentForCircle Double
m Double
r1 Double
r2 Vect
offs = Double
m Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
r1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
r2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r2) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Vect -> Double
forall v s. (InnerSpace v, s ~ Scalar v) => v -> s
magnitudeSq Vect
offs)

-- | Calculate the moment of inertia for a line segment. The endpoints @a@ and @b@ are relative to the body.
momentForSegment
  :: Double -- ^ Mass
  -> Vect   -- ^ a
  -> Vect   -- ^ b
  -> Double -- ^ Thickness
  -> Double
momentForSegment :: Double -> Vect -> Vect -> Double -> Double
momentForSegment Double
m Vect
a Vect
b Double
r = Double
m Double -> Double -> Double
forall a. Num a => a -> a -> a
* ((Double
len Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
len Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
12 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Vect -> Double
forall v s. (InnerSpace v, s ~ Scalar v) => v -> s
magnitudeSq Vect
offs)
  where
    offs :: Vect
offs = Vect -> Vect -> Scalar Vect -> Vect
forall v. VectorSpace v => v -> v -> Scalar v -> v
lerp Vect
a Vect
b Scalar Vect
0.5
    len :: Double
len  = Vect -> Double
forall v s. (InnerSpace v, s ~ Scalar v, Floating s) => v -> s
magnitude (Vect
b Vect -> Vect -> Vect
forall v. AdditiveGroup v => v -> v -> v
^-^ Vect
a) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r

-- | Calculate the moment of inertia for a solid polygon shape assuming its center of gravity is at its centroid.
-- The offset is added to each vertex.
momentForPoly :: (Double) -- ^ Mass
 -> ([Vect]) -- ^ Vertexes
 -> (Vect) -- ^ Offset
 -> (Double) -- ^ Thickness
 -> (Double)
momentForPoly :: Double -> [Vect] -> Vect -> Double -> Double
momentForPoly Double
a1 [Vect]
a2 Vect
a3 Double
a4 =
  IO Double -> Double
forall a. IO a -> a
C2HSImp.unsafePerformIO (IO Double -> Double) -> IO Double -> Double
forall a b. (a -> b) -> a -> b
$
  let {a1' :: CDouble
a1' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
a1} in 
  [Vect] -> ((CInt, Ptr Vect) -> IO Double) -> IO Double
forall a b. Storable a => [a] -> ((CInt, Ptr a) -> IO b) -> IO b
withList [Vect]
a2 (((CInt, Ptr Vect) -> IO Double) -> IO Double)
-> ((CInt, Ptr Vect) -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \(CInt
a2'1, Ptr Vect
a2'2) -> 
  Vect -> (Ptr Vect -> IO Double) -> IO Double
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Vect
a3 ((Ptr Vect -> IO Double) -> IO Double)
-> (Ptr Vect -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \Ptr Vect
a3' -> 
  let {a4' :: CDouble
a4' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
a4} in 
  CDouble -> CInt -> Ptr Vect -> Ptr Vect -> CDouble -> IO CDouble
momentForPoly'_ CDouble
a1' CInt
a2'1  Ptr Vect
a2'2 Ptr Vect
a3' CDouble
a4' IO CDouble -> (CDouble -> IO Double) -> IO Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CDouble
res ->
  let {res' :: Double
res' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
res} in
  Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
res')

{-# LINE 56 "src/Chiphunk/Low/Helper.chs" #-}


-- | Calculate the moment of inertia for a solid box centered on the body.
momentForBox
  :: Double -- ^ Mass
  -> Double -- ^ Width
  -> Double -- ^ Height
  -> Double
momentForBox m w h = m * (w * w + h * h) / 12

-- | Area of a hollow circle.
areaForCircle
  :: Double -- ^ r1
  -> Double -- ^ r2
  -> Double
areaForCircle :: Double -> Double -> Double
areaForCircle Double
r1 Double
r2 = Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Num a => a -> a
abs (Double
r1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
r2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r2)

-- | Area of a beveled segment. (Will always be zero if radius is zero)
areaForSegment
  :: Vect   -- ^ One end
  -> Vect   -- ^ Other end
  -> Double -- ^ Thickness
  -> Double
areaForSegment :: Vect -> Vect -> Double -> Double
areaForSegment Vect
v1 Vect
v2 Double
r = Vect -> Double
forall v s. (InnerSpace v, s ~ Scalar v, Floating s) => v -> s
magnitude (Vect
v1 Vect -> Vect -> Vect
forall v. AdditiveGroup v => v -> v -> v
^-^ Vect
v2) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r

-- | Signed area of a polygon shape. Returns a negative number for polygons with a clockwise winding.
areaForPoly :: ([Vect]) -- ^ Vertexes
 -> (Double) -- ^ Thickness
 -> (Double)
areaForPoly :: [Vect] -> Double -> Double
areaForPoly [Vect]
a1 Double
a2 =
  IO Double -> Double
forall a. IO a -> a
C2HSImp.unsafePerformIO (IO Double -> Double) -> IO Double -> Double
forall a b. (a -> b) -> a -> b
$
  [Vect] -> ((CInt, Ptr Vect) -> IO Double) -> IO Double
forall a b. Storable a => [a] -> ((CInt, Ptr a) -> IO b) -> IO b
withList [Vect]
a1 (((CInt, Ptr Vect) -> IO Double) -> IO Double)
-> ((CInt, Ptr Vect) -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \(CInt
a1'1, Ptr Vect
a1'2) -> 
  let {a2' :: CDouble
a2' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
a2} in 
  CInt -> Ptr Vect -> CDouble -> IO CDouble
areaForPoly'_ CInt
a1'1  Ptr Vect
a1'2 CDouble
a2' IO CDouble -> (CDouble -> IO Double) -> IO Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CDouble
res ->
  let {res' :: Double
res' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
res} in
  Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
res'(((CInt, Ptr Vect) -> IO Vect) -> IO Vect)
-> ((CInt, Ptr Vect) -> IO Vect) -> IO Vect
forall a b. (a -> b) -> a -> b
)

{-# LINE 85 "src/Chiphunk/Low/Helper.chs" #-}


-- | Calculate the centroid for a polygon.
centroidForPoly :: ([Vect]) -> (Vect)
centroidForPoly :: [Vect] -> Vect
centroidForPoly [Vect]
a1 =
  IO Vect -> Vect
forall a. IO a -> a
C2HSImp.unsafePerformIO (IO Vect -> Vect) -> IO Vect -> Vect
forall a b. (a -> b) -> a -> b
$
  [Vect] -> ((CInt, Ptr Vect) -> IO Vect) -> IO Vect
forall a b. Storable a => [a] -> ((CInt, Ptr a) -> IO b) -> IO b
withList a1 $ \(CInt
a1'1, Ptr Vect
a1'2) -> 
  (Ptr Vect -> IO Vect) -> IO Vect
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Vect -> IO Vect) -> IO Vect)
-> (Ptr Vect -> IO Vect) -> IO Vect
forall a b. (a -> b) -> a -> b
$ \Ptr Vect
a2' -> 
  CInt -> Ptr Vect -> Ptr Vect -> IO ()
centroidForPoly'_ CInt
a1'1  Ptr Vect
a1'2 Ptr Vect
a2' IO () -> IO Vect -> IO Vect
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  Ptr Vect -> IO Vect
forall a. Storable a => Ptr a -> IO a
peek  Ptr Vect
a2'IO Vect -> (Vect -> IO Vect) -> IO Vect
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Vect
a2'' -> 
  Vect -> IO Vect
forall (m :: * -> *) a. Monad m => a -> m a
return (Vect
a2'')

{-# LINE 88 "src/Chiphunk/Low/Helper.chs" #-}


-- | Calculate the convex hull of a given set of points.
convexHull
  :: [Vect]        -- ^ Set of vertexes
  -> Double        -- ^ Allowed amount to shrink the hull when simplifying it. A tolerance of 0 creates an exact hull.
  -> ([Vect], Int) -- ^ Second element is index of first output vertex in input list.
convexHull vs tol = unsafePerformIO $
  withArray vs $ \pVs ->
  allocaArray (length vs) $ \pRes ->
  alloca $ \pFst -> do
    n <- c_convexHull (fromIntegral $ length vs) pVs pRes pFst (realToFrac tol)
    (,) <$> peekArray (fromIntegral n) pRes <*> (fromIntegral <$> peek pFst)

convexDecomposition :: [Vect] -> Double -> [[Vect]]
convexDecomposition :: [Vect] -> Double -> [[Vect]]
convexDecomposition [] Double
_ = []
convexDecomposition [Vect]
concavePolygon Double
tol = IO [[Vect]] -> [[Vect]]
forall a. IO a -> a
unsafePerformIO (IO [[Vect]] -> [[Vect]]) -> IO [[Vect]] -> [[Vect]]
forall a b. (a -> b) -> a -> b
$
  Polyline -> (Ptr Polyline -> IO [[Vect]]) -> IO [[Vect]]
forall a. Polyline -> (Ptr Polyline -> IO a) -> IO a
withPolylinePtr ([Vect] -> Polyline
Polyline [Vect]
counterClockwise) ((Ptr Polyline -> IO [[Vect]]) -> IO [[Vect]])
-> (Ptr Polyline -> IO [[Vect]]) -> IO [[Vect]]
forall a b. (a -> b) -> a -> b
$ \Ptr Polyline
lineP -> do
    PolylineSetPtr
setP <- Ptr Polyline -> CDouble -> IO PolylineSetPtr
cpPolylineConvexDecomposition Ptr Polyline
lineP (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
tol)
    PolylineSet
set <- PolylineSetPtr -> IO PolylineSet
peekPolylineSet PolylineSetPtr
setP
    PolylineSetPtr -> CUChar -> IO ()
cpPolylineSetFree PolylineSetPtr
setP CUChar
1
    [[Vect]] -> IO [[Vect]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Vect]] -> IO [[Vect]]) -> [[Vect]] -> IO [[Vect]]
forall a b. (a -> b) -> a -> b
$ (Polyline -> [Vect]) -> [Polyline] -> [[Vect]]
forall a b. (a -> b) -> [a] -> [b]
map Polyline -> [Vect]
unPolyline ([Polyline] -> [[Vect]]) -> [Polyline] -> [[Vect]]
forall a b. (a -> b) -> a -> b
$ PolylineSet -> [Polyline]
unPolylineSet PolylineSet
set
  where
    counterClockwise :: [Vect]
counterClockwise
      | [Vect] -> Double -> Double
areaForPoly [Vect]
concavePolygon Double
0 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 = [Vect] -> [Vect]
forall a. [a] -> [a]
reverse [Vect]
concavePolygon
      | Bool
otherwise                        = [Vect]
concavePolygon

foreign import ccall unsafe "Chiphunk/Low/Helper.chs.h __c2hs_wrapped__cpMomentForPoly"
  momentForPoly'_ :: (C2HSImp.CDouble -> (C2HSImp.CInt -> ((VectPtr) -> ((VectPtr) -> (C2HSImp.CDouble -> (IO C2HSImp.CDouble))))))

foreign import ccall unsafe "Chiphunk/Low/Helper.chs.h cpAreaForPoly"
  areaForPoly'_ :: (C2HSImp.CInt -> ((VectPtr) -> (C2HSImp.CDouble -> (IO C2HSImp.CDouble))))

foreign import ccall unsafe "Chiphunk/Low/Helper.chs.h w_cpCentroidForPoly"
  centroidForPoly'_ :: (C2HSImp.CInt -> ((VectPtr) -> ((VectPtr) -> (IO ()))))

foreign import ccall safe "Chiphunk/Low/Helper.chs.h cpConvexHull"
  c_convexHull :: (C2HSImp.CInt -> ((VectPtr) -> ((VectPtr) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (C2HSImp.CDouble -> (IO C2HSImp.CInt))))))

foreign import ccall safe "Chiphunk/Low/Helper.chs.h cpPolylineConvexDecomposition"
  cpPolylineConvexDecomposition :: ((PolylinePtr) -> (C2HSImp.CDouble -> (IO (PolylineSetPtr))))

foreign import ccall safe "Chiphunk/Low/Helper.chs.h cpPolylineSetFree"
  cpPolylineSetFree :: ((PolylineSetPtr) -> (C2HSImp.CUChar -> (IO ())))