{-# LANGUAGE CApiFFI #-} 
module OpenCascade.BOPAlgo.BOP 
( BOP
, new
, addTool
, setOperation
) where

import OpenCascade.BOPAlgo.Types
import OpenCascade.BOPAlgo.Internal.Destructors (deleteBOP)
import OpenCascade.BOPAlgo.Operation (Operation)
import qualified OpenCascade.TopoDS.Types as TopoDS

import Foreign.Ptr (Ptr)
import Data.Acquire (Acquire, mkAcquire)
import Foreign.C (CInt (..))


foreign import capi unsafe "hs_BOPAlgo_BOP.h hs_new_BOPAlgo_BOP" rawNew :: IO (Ptr BOP)

new :: Acquire (Ptr BOP)
new :: Acquire (Ptr BOP)
new = IO (Ptr BOP) -> (Ptr BOP -> IO ()) -> Acquire (Ptr BOP)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire IO (Ptr BOP)
rawNew Ptr BOP -> IO ()
deleteBOP

foreign import capi unsafe "hs_BOPAlgo_BOP.h hs_BOPAlgo_BOP_AddTool" addTool :: Ptr BOP -> Ptr TopoDS.Shape -> IO ()

foreign import capi unsafe "hs_BOPAlgo_BOP.h hs_BOPAlgo_BOP_SetOperation" rawSetOperation :: Ptr BOP -> CInt -> IO ()

setOperation :: Ptr BOP -> Operation -> IO ()
setOperation :: Ptr BOP -> Operation -> IO ()
setOperation Ptr BOP
bop Operation
op = Ptr BOP -> CInt -> IO ()
rawSetOperation Ptr BOP
bop (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Operation -> Int) -> Operation -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Operation -> Int
forall a. Enum a => a -> Int
fromEnum (Operation -> CInt) -> Operation -> CInt
forall a b. (a -> b) -> a -> b
$ Operation
op)