{-# LANGUAGE CApiFFI #-}
module OpenCascade.BRepBuilderAPI.MakePolygon
( from3Pnts 
) where

import qualified OpenCascade.GP as GP
import qualified OpenCascade.TopoDS as TopoDS
import OpenCascade.TopoDS.Internal.Destructors (deleteShape)
import OpenCascade.Inheritance (upcast)
import Foreign.C (CBool (..))
import Foreign.Ptr (Ptr)
import Data.Acquire (Acquire, mkAcquire)
import OpenCascade.Internal.Bool (boolToCBool)

foreign import capi unsafe "hs_BRepBuilderAPI_MakePolygon.h hs_BRepBuilderAPI_MakePolygon_from3Pnts" rawFrom3Pnts :: Ptr GP.Pnt -> Ptr GP.Pnt -> Ptr GP.Pnt -> CBool -> IO (Ptr TopoDS.Wire)

from3Pnts :: Ptr GP.Pnt -> Ptr GP.Pnt -> Ptr GP.Pnt -> Bool -> Acquire (Ptr TopoDS.Wire)
from3Pnts :: Ptr Pnt -> Ptr Pnt -> Ptr Pnt -> Bool -> Acquire (Ptr Wire)
from3Pnts Ptr Pnt
p1 Ptr Pnt
p2 Ptr Pnt
p3 Bool
close = IO (Ptr Wire) -> (Ptr Wire -> IO ()) -> Acquire (Ptr Wire)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Pnt -> Ptr Pnt -> Ptr Pnt -> CBool -> IO (Ptr Wire)
rawFrom3Pnts Ptr Pnt
p1 Ptr Pnt
p2 Ptr Pnt
p3 (Bool -> CBool
boolToCBool Bool
close)) (Ptr Shape -> IO ()
deleteShape (Ptr Shape -> IO ())
-> (Ptr Wire -> Ptr Shape) -> Ptr Wire -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Wire -> Ptr Shape
forall a b. SubTypeOf a b => Ptr b -> Ptr a
upcast)