{-# LANGUAGE CApiFFI #-}
module OpenCascade.BRepFilletAPI.MakeChamfer 
( MakeChamfer
, fromShape
, addEdge
, addEdgeWithDistance
, reset
, nbEdges
, edge
, remove
) where

import OpenCascade.BRepFilletAPI.Types (MakeChamfer)
import OpenCascade.BRepFilletAPI.Internal.Destructors (deleteMakeChamfer)
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_MakeChamfer.h hs_new_BRepFilletAPI_MakeChamfer_fromShape" rawFromShape :: Ptr TopoDS.Shape -> IO (Ptr MakeChamfer)

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

foreign import capi unsafe "hs_BRepFilletAPI_MakeChamfer.h hs_BRepFilletAPI_MakeChamfer_addEdge" addEdge :: Ptr MakeChamfer -> Ptr TopoDS.Edge -> IO ()

foreign import capi unsafe "hs_BRepFilletAPI_MakeChamfer.h hs_BRepFilletAPI_MakeChamfer_addEdgeWithDistance" rawAddEdgeWithDistance :: Ptr MakeChamfer -> CDouble -> Ptr TopoDS.Edge -> IO ()

addEdgeWithDistance :: Ptr MakeChamfer -> Double -> Ptr TopoDS.Edge -> IO ()
addEdgeWithDistance :: Ptr MakeChamfer -> Double -> Ptr Edge -> IO ()
addEdgeWithDistance = (Ptr MakeChamfer -> CDouble -> Ptr Edge -> IO ())
-> Ptr MakeChamfer -> Double -> Ptr Edge -> IO ()
forall a b. Coercible a b => a -> b
coerce Ptr MakeChamfer -> CDouble -> Ptr Edge -> IO ()
rawAddEdgeWithDistance

foreign import capi unsafe "hs_BRepFilletAPI_MakeChamfer.h hs_BRepFilletAPI_MakeChamfer_reset" reset :: Ptr MakeChamfer -> IO ()

foreign import capi unsafe "hs_BRepFilletAPI_MakeChamfer.h hs_BRepFilletAPI_MakeChamfer_nbEdges" rawNbEdges :: Ptr MakeChamfer -> CInt -> IO CInt

nbEdges :: Ptr MakeChamfer -> Int -> IO Int
nbEdges :: Ptr MakeChamfer -> Int -> IO Int
nbEdges Ptr MakeChamfer
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 MakeChamfer -> CInt -> IO CInt
rawNbEdges Ptr MakeChamfer
builder (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index)

foreign import capi unsafe "hs_BRepFilletAPI_MakeChamfer.h hs_BRepFilletAPI_MakeChamfer_edge" rawEdge :: Ptr MakeChamfer -> CInt -> CInt -> IO (Ptr TopoDS.Edge)

edge :: Ptr MakeChamfer -> Int -> Int -> Acquire (Ptr TopoDS.Edge)
edge :: Ptr MakeChamfer -> Int -> Int -> Acquire (Ptr Edge)
edge Ptr MakeChamfer
builder Int
contourIndex Int
edgeIndex = IO (Ptr Edge) -> (Ptr Edge -> IO ()) -> Acquire (Ptr Edge)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr MakeChamfer -> CInt -> CInt -> IO (Ptr Edge)
rawEdge Ptr MakeChamfer
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_MakeChamfer.h hs_BRepFilletAPI_MakeChamfer_remove" remove :: Ptr MakeChamfer -> Ptr TopoDS.Edge -> IO ()