{-# LANGUAGE CApiFFI #-}
module OpenCascade.GProp.GProps
( GProps
, new
, fromSystemLocation
, mass
, centreOfMass
, momentOfInertia
) where

import Foreign.Ptr (Ptr)
import Foreign.C (CDouble (..))
import OpenCascade.GProp.Types (GProps)
import OpenCascade.GProp.Internal.Destructors (deleteGProps)
import OpenCascade.GP.Types (Pnt, Ax1)
import OpenCascade.GP.Internal.Destructors (deletePnt)
import Data.Acquire 
import Data.Coerce (coerce)

foreign import capi unsafe "hs_GProp_GProps.h hs_new_GProp_GProps" rawNew :: IO (Ptr GProps)

new :: Acquire (Ptr GProps)
new :: Acquire (Ptr GProps)
new = IO (Ptr GProps) -> (Ptr GProps -> IO ()) -> Acquire (Ptr GProps)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire IO (Ptr GProps)
rawNew Ptr GProps -> IO ()
deleteGProps

foreign import capi unsafe "hs_GProp_GProps.h hs_new_GProp_GProps_fromSystemLocation" rawFromSystemLocation :: Ptr Pnt -> IO (Ptr GProps)

fromSystemLocation :: Ptr Pnt -> Acquire (Ptr GProps)
fromSystemLocation :: Ptr Pnt -> Acquire (Ptr GProps)
fromSystemLocation Ptr Pnt
pnt = IO (Ptr GProps) -> (Ptr GProps -> IO ()) -> Acquire (Ptr GProps)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Pnt -> IO (Ptr GProps)
rawFromSystemLocation Ptr Pnt
pnt) Ptr GProps -> IO ()
deleteGProps

foreign import capi unsafe "hs_GProp_GProps.h hs_GProp_GProps_mass" rawMass :: Ptr GProps -> IO CDouble 

mass :: Ptr GProps -> IO Double
mass :: Ptr GProps -> IO Double
mass = (Ptr GProps -> IO CDouble) -> Ptr GProps -> IO Double
forall a b. Coercible a b => a -> b
coerce Ptr GProps -> IO CDouble
rawMass

foreign import capi unsafe "hs_GProp_GProps.h hs_GProp_GProps_centreOfMass" rawCentreOfMass :: Ptr GProps -> IO (Ptr Pnt)

centreOfMass :: Ptr GProps -> Acquire (Ptr Pnt)
centreOfMass :: Ptr GProps -> Acquire (Ptr Pnt)
centreOfMass Ptr GProps
gProps = IO (Ptr Pnt) -> (Ptr Pnt -> IO ()) -> Acquire (Ptr Pnt)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr GProps -> IO (Ptr Pnt)
rawCentreOfMass Ptr GProps
gProps) Ptr Pnt -> IO ()
deletePnt

foreign import capi unsafe "hs_GProp_GProps.h hs_GProp_GProps_momentOfInertia" rawMomentOfIntertia :: Ptr GProps -> Ptr Ax1 -> IO CDouble 

momentOfInertia :: Ptr GProps -> Ptr Ax1 -> IO Double
momentOfInertia :: Ptr GProps -> Ptr Ax1 -> IO Double
momentOfInertia = (Ptr GProps -> Ptr Ax1 -> IO CDouble)
-> Ptr GProps -> Ptr Ax1 -> IO Double
forall a b. Coercible a b => a -> b
coerce Ptr GProps -> Ptr Ax1 -> IO CDouble
rawMomentOfIntertia