{-# LANGUAGE CApiFFI #-}
module OpenCascade.BRepFilletAPI.MakeFillet 
( MakeFillet
, fromShape
, addEdge
, addEdgeWithRadius
, addEdgeWithTwoRadiuses
, reset
, nbFaultyContours
, faultyContour
, nbEdges
, edge
, remove
) where

import OpenCascade.BRepFilletAPI.Types (MakeFillet)
import OpenCascade.BRepFilletAPI.Internal.Destructors (deleteMakeFillet)
import qualified OpenCascade.TopoDS as TopoDS
import OpenCascade.TopoDS.Internal.Destructors (deleteShape)
import OpenCascade.Inheritance (upcast)
import Foreign.Ptr
import Foreign.C
import Data.Acquire
import Data.Coerce (coerce)


foreign import capi unsafe "hs_BRepFilletAPI_MakeFillet.h hs_new_BRepFilletAPI_MakeFillet_fromShape" rawFromShape :: Ptr TopoDS.Shape -> IO (Ptr MakeFillet)

fromShape :: Ptr TopoDS.Shape  -> Acquire (Ptr MakeFillet)
fromShape :: Ptr Shape -> Acquire (Ptr MakeFillet)
fromShape Ptr Shape
shape = IO (Ptr MakeFillet)
-> (Ptr MakeFillet -> IO ()) -> Acquire (Ptr MakeFillet)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Shape -> IO (Ptr MakeFillet)
rawFromShape Ptr Shape
shape) Ptr MakeFillet -> IO ()
deleteMakeFillet

foreign import capi unsafe "hs_BRepFilletAPI_MakeFillet.h hs_BRepFilletAPI_MakeFillet_addEdge" addEdge :: Ptr MakeFillet -> Ptr TopoDS.Edge -> IO ()

foreign import capi unsafe "hs_BRepFilletAPI_MakeFillet.h hs_BRepFilletAPI_MakeFillet_addEdgeWithRadius" rawAddEdgeWithRadius :: Ptr MakeFillet -> CDouble -> Ptr TopoDS.Edge -> IO ()

addEdgeWithRadius :: Ptr MakeFillet -> Double -> Ptr TopoDS.Edge -> IO ()
addEdgeWithRadius :: Ptr MakeFillet -> Double -> Ptr Edge -> IO ()
addEdgeWithRadius = (Ptr MakeFillet -> CDouble -> Ptr Edge -> IO ())
-> Ptr MakeFillet -> Double -> Ptr Edge -> IO ()
forall a b. Coercible a b => a -> b
coerce Ptr MakeFillet -> CDouble -> Ptr Edge -> IO ()
rawAddEdgeWithRadius

foreign import capi unsafe "hs_BRepFilletAPI_MakeFillet.h hs_BRepFilletAPI_MakeFillet_addEdgeWithTwoRadiuses" rawAddEdgeWithTwoRadiuses :: Ptr MakeFillet -> CDouble -> CDouble -> Ptr TopoDS.Edge -> IO ()

addEdgeWithTwoRadiuses :: Ptr MakeFillet -> Double -> Double -> Ptr TopoDS.Edge -> IO ()
addEdgeWithTwoRadiuses :: Ptr MakeFillet -> Double -> Double -> Ptr Edge -> IO ()
addEdgeWithTwoRadiuses = (Ptr MakeFillet -> CDouble -> CDouble -> Ptr Edge -> IO ())
-> Ptr MakeFillet -> Double -> Double -> Ptr Edge -> IO ()
forall a b. Coercible a b => a -> b
coerce Ptr MakeFillet -> CDouble -> CDouble -> Ptr Edge -> IO ()
rawAddEdgeWithTwoRadiuses

foreign import capi unsafe "hs_BRepFilletAPI_MakeFillet.h hs_BRepFilletAPI_MakeFillet_reset" reset :: Ptr MakeFillet -> IO ()

foreign import capi unsafe "hs_BRepFilletAPI_MakeFillet.h hs_BRepFilletAPI_MakeFillet_nbFaultyContours" rawNbFaultyContours :: Ptr MakeFillet -> IO CInt

nbFaultyContours :: Ptr MakeFillet -> IO Int
nbFaultyContours :: Ptr MakeFillet -> IO Int
nbFaultyContours = (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 MakeFillet -> IO CInt) -> Ptr MakeFillet -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr MakeFillet -> IO CInt
rawNbFaultyContours

foreign import capi unsafe "hs_BRepFilletAPI_MakeFillet.h hs_BRepFilletAPI_MakeFillet_faultyContour" rawFaultyContour :: Ptr MakeFillet -> CInt -> IO CInt

faultyContour :: Ptr MakeFillet -> Int -> IO Int
faultyContour :: Ptr MakeFillet -> Int -> IO Int
faultyContour Ptr MakeFillet
builder Int
index = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr MakeFillet -> CInt -> IO CInt
rawFaultyContour Ptr MakeFillet
builder (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index)

foreign import capi unsafe "hs_BRepFilletAPI_MakeFillet.h hs_BRepFilletAPI_MakeFillet_nbEdges" rawNbEdges :: Ptr MakeFillet -> CInt -> IO CInt

nbEdges :: Ptr MakeFillet -> Int -> IO Int
nbEdges :: Ptr MakeFillet -> Int -> IO Int
nbEdges Ptr MakeFillet
builder Int
index = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr MakeFillet -> CInt -> IO CInt
rawNbEdges Ptr MakeFillet
builder (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index)

foreign import capi unsafe "hs_BRepFilletAPI_MakeFillet.h hs_BRepFilletAPI_MakeFillet_edge" rawEdge :: Ptr MakeFillet -> CInt -> CInt -> IO (Ptr TopoDS.Edge)

edge :: Ptr MakeFillet -> Int -> Int -> Acquire (Ptr TopoDS.Edge)
edge :: Ptr MakeFillet -> Int -> Int -> Acquire (Ptr Edge)
edge Ptr MakeFillet
builder Int
contourIndex Int
edgeIndex = IO (Ptr Edge) -> (Ptr Edge -> IO ()) -> Acquire (Ptr Edge)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr MakeFillet -> CInt -> CInt -> IO (Ptr Edge)
rawEdge Ptr MakeFillet
builder (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
contourIndex) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
edgeIndex)) (Ptr Shape -> IO ()
deleteShape (Ptr Shape -> IO ())
-> (Ptr Edge -> Ptr Shape) -> Ptr Edge -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Edge -> Ptr Shape
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast)

foreign import capi unsafe "hs_BRepFilletAPI_MakeFillet.h hs_BRepFilletAPI_MakeFillet_remove" remove :: Ptr MakeFillet -> Ptr TopoDS.Edge -> IO ()