{-# LANGUAGE CApiFFI#-}
module OpenCascade.BRepLib 
( orientClosedSolid
, buildCurve3d
) where 

import OpenCascade.TopoDS.Types (Solid, Edge)
import qualified OpenCascade.GeomAbs.Shape as GeomAbs.Shape
import Foreign.Ptr (Ptr)
import Foreign.C (CBool (..), CDouble (..), CInt (..))
import OpenCascade.Internal.Bool (cBoolToBool)
import Data.Coerce (coerce)

foreign import capi unsafe "hs_BRepLib.h hs_BRepLib_orientClosedSolid" rawOrientClosedSolid ::  Ptr Solid -> IO (CBool)

orientClosedSolid :: Ptr Solid -> IO Bool
orientClosedSolid :: Ptr Solid -> IO Bool
orientClosedSolid Ptr Solid
s = CBool -> Bool
cBoolToBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Solid -> IO CBool
rawOrientClosedSolid Ptr Solid
s


foreign import capi unsafe "hs_BRepLib.h hs_BRepLib_buildCurve3d" rawBuildCurve3d ::  Ptr Edge -> CDouble -> CInt -> CInt -> CInt -> IO CBool

buildCurve3d :: Ptr Edge -> Double -> GeomAbs.Shape.Shape -> Int -> Int -> IO Bool
buildCurve3d :: Ptr Edge -> Double -> Shape -> Int -> Int -> IO Bool
buildCurve3d Ptr Edge
edge Double
tolerance Shape
continuity Int
maxDegree Int
maxSegment = 
    CBool -> Bool
cBoolToBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Edge -> CDouble -> CInt -> CInt -> CInt -> IO CBool
rawBuildCurve3d Ptr Edge
edge (Double -> CDouble
forall a b. Coercible a b => a -> b
coerce Double
tolerance) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Shape -> Int) -> Shape -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shape -> Int
forall a. Enum a => a -> Int
fromEnum (Shape -> CInt) -> Shape -> CInt
forall a b. (a -> b) -> a -> b
$ Shape
continuity) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxDegree) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxSegment)