{-# LANGUAGE CApiFFI #-}
module OpenCascade.GP 
( origin
, dx
, dy
, dz
, ox
, oy
, oz
, xoy
, yoz
, zox
, origin2d
, dx2d
, dy2d
, ox2d
, oy2d
, module OpenCascade.GP.Types
) where

import OpenCascade.GP.Types
import OpenCascade.GP.Internal.Destructors
import Foreign.Ptr
import Data.Acquire 

-- origin

foreign import capi unsafe "hs_gp.h hs_gp_Origin" rawOrigin :: IO (Ptr Pnt)

origin :: Acquire (Ptr Pnt)
origin :: Acquire (Ptr Pnt)
origin = IO (Ptr Pnt) -> (Ptr Pnt -> IO ()) -> Acquire (Ptr Pnt)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (IO (Ptr Pnt)
rawOrigin) Ptr Pnt -> IO ()
deletePnt

-- cardinal directions

foreign import capi unsafe "hs_gp.h hs_gp_DX" rawDX :: IO (Ptr Dir)

dx :: Acquire (Ptr Dir)
dx :: Acquire (Ptr Dir)
dx = IO (Ptr Dir) -> (Ptr Dir -> IO ()) -> Acquire (Ptr Dir)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (IO (Ptr Dir)
rawDX) Ptr Dir -> IO ()
deleteDir

foreign import capi unsafe "hs_gp.h hs_gp_DY" rawDY :: IO (Ptr Dir)

dy :: Acquire (Ptr Dir)
dy :: Acquire (Ptr Dir)
dy = IO (Ptr Dir) -> (Ptr Dir -> IO ()) -> Acquire (Ptr Dir)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (IO (Ptr Dir)
rawDY) Ptr Dir -> IO ()
deleteDir


foreign import capi unsafe "hs_gp.h hs_gp_DZ" rawDZ :: IO (Ptr Dir)

dz :: Acquire (Ptr Dir)
dz :: Acquire (Ptr Dir)
dz = IO (Ptr Dir) -> (Ptr Dir -> IO ()) -> Acquire (Ptr Dir)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (IO (Ptr Dir)
rawDZ) Ptr Dir -> IO ()
deleteDir

-- cardinal axes

foreign import capi unsafe "hs_gp.h hs_gp_OX" rawOX :: IO (Ptr Ax1)

ox :: Acquire (Ptr Ax1)
ox :: Acquire (Ptr Ax1)
ox = IO (Ptr Ax1) -> (Ptr Ax1 -> IO ()) -> Acquire (Ptr Ax1)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (IO (Ptr Ax1)
rawOX) Ptr Ax1 -> IO ()
deleteAx1

foreign import capi unsafe "hs_gp.h hs_gp_OY" rawOY :: IO (Ptr Ax1)

oy :: Acquire (Ptr Ax1)
oy :: Acquire (Ptr Ax1)
oy = IO (Ptr Ax1) -> (Ptr Ax1 -> IO ()) -> Acquire (Ptr Ax1)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (IO (Ptr Ax1)
rawOY) Ptr Ax1 -> IO ()
deleteAx1


foreign import capi unsafe "hs_gp.h hs_gp_OZ" rawOZ :: IO (Ptr Ax1)

oz :: Acquire (Ptr Ax1)
oz :: Acquire (Ptr Ax1)
oz = IO (Ptr Ax1) -> (Ptr Ax1 -> IO ()) -> Acquire (Ptr Ax1)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (IO (Ptr Ax1)
rawOZ) Ptr Ax1 -> IO ()
deleteAx1

-- axes - 2

foreign import capi unsafe "hs_gp.h hs_gp_XOY" rawXOY :: IO (Ptr Ax2)

xoy :: Acquire (Ptr Ax2)
xoy :: Acquire (Ptr Ax2)
xoy = IO (Ptr Ax2) -> (Ptr Ax2 -> IO ()) -> Acquire (Ptr Ax2)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (IO (Ptr Ax2)
rawXOY) Ptr Ax2 -> IO ()
deleteAx2

foreign import capi unsafe "hs_gp.h hs_gp_YOZ" rawYOZ :: IO (Ptr Ax2)

yoz :: Acquire (Ptr Ax2)
yoz :: Acquire (Ptr Ax2)
yoz = IO (Ptr Ax2) -> (Ptr Ax2 -> IO ()) -> Acquire (Ptr Ax2)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (IO (Ptr Ax2)
rawYOZ) Ptr Ax2 -> IO ()
deleteAx2


foreign import capi unsafe "hs_gp.h hs_gp_ZOX" rawZOX :: IO (Ptr Ax2)

zox :: Acquire (Ptr Ax2)
zox :: Acquire (Ptr Ax2)
zox = IO (Ptr Ax2) -> (Ptr Ax2 -> IO ()) -> Acquire (Ptr Ax2)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (IO (Ptr Ax2)
rawZOX) Ptr Ax2 -> IO ()
deleteAx2

-- origin 2d

foreign import capi unsafe "hs_gp.h hs_gp_Origin2d" rawOrigin2d :: IO (Ptr Pnt2d)

origin2d :: Acquire (Ptr Pnt2d)
origin2d :: Acquire (Ptr Pnt2d)
origin2d = IO (Ptr Pnt2d) -> (Ptr Pnt2d -> IO ()) -> Acquire (Ptr Pnt2d)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (IO (Ptr Pnt2d)
rawOrigin2d) Ptr Pnt2d -> IO ()
deletePnt2d

-- cardinal directions (2d)

foreign import capi unsafe "hs_gp.h hs_gp_DX2d" rawDX2d :: IO (Ptr Dir2d)

dx2d :: Acquire (Ptr Dir2d)
dx2d :: Acquire (Ptr Dir2d)
dx2d = IO (Ptr Dir2d) -> (Ptr Dir2d -> IO ()) -> Acquire (Ptr Dir2d)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (IO (Ptr Dir2d)
rawDX2d) Ptr Dir2d -> IO ()
deleteDir2d

foreign import capi unsafe "hs_gp.h hs_gp_DY2d" rawDY2d :: IO (Ptr Dir2d)

dy2d :: Acquire (Ptr Dir2d)
dy2d :: Acquire (Ptr Dir2d)
dy2d = IO (Ptr Dir2d) -> (Ptr Dir2d -> IO ()) -> Acquire (Ptr Dir2d)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (IO (Ptr Dir2d)
rawDY2d) Ptr Dir2d -> IO ()
deleteDir2d

-- cardinal axes (2d)

foreign import capi unsafe "hs_gp.h hs_gp_OX2d" rawOX2d :: IO (Ptr Ax2d)

ox2d :: Acquire (Ptr Ax2d)
ox2d :: Acquire (Ptr Ax2d)
ox2d = IO (Ptr Ax2d) -> (Ptr Ax2d -> IO ()) -> Acquire (Ptr Ax2d)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (IO (Ptr Ax2d)
rawOX2d) Ptr Ax2d -> IO ()
deleteAx2d

foreign import capi unsafe "hs_gp.h hs_gp_OY2d" rawOY2d :: IO (Ptr Ax2d)

oy2d :: Acquire (Ptr Ax2d)
oy2d :: Acquire (Ptr Ax2d)
oy2d = IO (Ptr Ax2d) -> (Ptr Ax2d -> IO ()) -> Acquire (Ptr Ax2d)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (IO (Ptr Ax2d)
rawOY2d) Ptr Ax2d -> IO ()
deleteAx2d