{-# LINE 1 "src/Chiphunk/Low/Helper.chs" #-}
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" #-}
momentForCircle
:: Double
-> Double
-> Double
-> Vect
-> 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)
momentForSegment
:: Double
-> Vect
-> Vect
-> Double
-> 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
momentForPoly :: (Double)
-> ([Vect])
-> (Vect)
-> (Double)
-> (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" #-}
momentForBox
:: Double
-> Double
-> Double
-> Double
momentForBox m w h = m * (w * w + h * h) / 12
areaForCircle
:: Double
-> Double
-> 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)
areaForSegment
:: Vect
-> Vect
-> Double
-> 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
areaForPoly :: ([Vect])
-> (Double)
-> (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" #-}
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" #-}
convexHull
:: [Vect]
-> Double
-> ([Vect], Int)
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 ())))