{-# LANGUAGE CApiFFI #-}
module OpenCascade.BRepBuilderAPI.Sewing
( Sewing
, new
, load
, add
, perform
, sewedShape
, nbFreeEdges
, nbContigousEdges
, nbMultipleEdges
) where 

import qualified OpenCascade.TopoDS.Types as TopoDS
import OpenCascade.TopoDS.Internal.Destructors (deleteShape)
import OpenCascade.BRepBuilderAPI.Internal.Destructors (deleteSewing)
import OpenCascade.BRepBuilderAPI.Types (Sewing)
import Foreign.Ptr (Ptr)
import Foreign.C (CBool (..), CDouble (..), CInt (..))
import OpenCascade.Internal.Bool (boolToCBool)
import Data.Acquire (Acquire, mkAcquire)
import Data.Coerce (coerce)

foreign import capi unsafe "hs_BRepBuilderAPI_Sewing.h hs_new_BRepBuilderAPI_Sewing" rawNew :: CDouble -> CBool -> CBool -> CBool -> CBool -> IO (Ptr Sewing)

new :: Double -> Bool -> Bool -> Bool -> Bool -> Acquire (Ptr Sewing)
new :: Double -> Bool -> Bool -> Bool -> Bool -> Acquire (Ptr Sewing)
new Double
tolerance Bool
opt1 Bool
opt2 Bool
opt3 Bool
opt4 = IO (Ptr Sewing) -> (Ptr Sewing -> IO ()) -> Acquire (Ptr Sewing)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (CDouble -> CBool -> CBool -> CBool -> CBool -> IO (Ptr Sewing)
rawNew (Double -> CDouble
forall a b. Coercible a b => a -> b
coerce Double
tolerance) (Bool -> CBool
boolToCBool Bool
opt1) (Bool -> CBool
boolToCBool Bool
opt2) (Bool -> CBool
boolToCBool Bool
opt3) (Bool -> CBool
boolToCBool Bool
opt4)) Ptr Sewing -> IO ()
deleteSewing

foreign import capi unsafe "hs_BRepBuilderAPI_Sewing.h hs_BRepBuilderAPI_Sewing_load" load :: Ptr Sewing -> Ptr TopoDS.Shape -> IO ()

foreign import capi unsafe "hs_BRepBuilderAPI_Sewing.h hs_BRepBuilderAPI_Sewing_add" add :: Ptr Sewing -> Ptr TopoDS.Shape -> IO ()

foreign import capi unsafe "hs_BRepBuilderAPI_Sewing.h hs_BRepBuilderAPI_Sewing_perform" perform :: Ptr Sewing -> IO ()

foreign import capi unsafe "hs_BRepBuilderAPI_Sewing.h hs_BRepBuilderAPI_Sewing_sewedShape" rawSewedShape :: Ptr Sewing -> IO (Ptr TopoDS.Shape)

sewedShape :: Ptr Sewing -> Acquire (Ptr TopoDS.Shape)
sewedShape :: Ptr Sewing -> Acquire (Ptr Shape)
sewedShape Ptr Sewing
sewing = IO (Ptr Shape) -> (Ptr Shape -> IO ()) -> Acquire (Ptr Shape)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Sewing -> IO (Ptr Shape)
rawSewedShape Ptr Sewing
sewing) (Ptr Shape -> IO ()
deleteShape)

foreign import capi unsafe "hs_BRepBuilderAPI_Sewing.h hs_BRepBuilderAPI_Sewing_nbFreeEdges" rawNbFreeEdges:: Ptr Sewing -> IO (CInt)

nbFreeEdges :: Ptr Sewing -> IO Int
nbFreeEdges :: Ptr Sewing -> IO Int
nbFreeEdges = (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int)
-> (Ptr Sewing -> IO CInt) -> Ptr Sewing -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Sewing -> IO CInt
rawNbFreeEdges


foreign import capi unsafe "hs_BRepBuilderAPI_Sewing.h hs_BRepBuilderAPI_Sewing_nbContigousEdges" rawNbContigousEdges:: Ptr Sewing -> IO (CInt)

nbContigousEdges :: Ptr Sewing -> IO Int
nbContigousEdges :: Ptr Sewing -> IO Int
nbContigousEdges = (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int)
-> (Ptr Sewing -> IO CInt) -> Ptr Sewing -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Sewing -> IO CInt
rawNbContigousEdges


foreign import capi unsafe "hs_BRepBuilderAPI_Sewing.h hs_BRepBuilderAPI_Sewing_nbMultipleEdges" rawNbMultipleEdges:: Ptr Sewing -> IO (CInt)

nbMultipleEdges :: Ptr Sewing -> IO Int
nbMultipleEdges :: Ptr Sewing -> IO Int
nbMultipleEdges = (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int)
-> (Ptr Sewing -> IO CInt) -> Ptr Sewing -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Sewing -> IO CInt
rawNbMultipleEdges