{-# LANGUAGE  CApiFFI #-}
module OpenCascade.GP.Ax3 
( Ax3
, new
, fromAx2
, fromPntDirAndDir
, fromPntAndDir
, xReverse
, yReverse
, zReverse
, setAxis
, setDirection
, setLocation
, setXDirection
, setYDirection
, angle
, axis
, ax2
, direction
, location
, xDirection
, yDirection
, direct
, isCoplanar
, isCoplanarAx1
, mirror
, mirrored
, mirrorAx2
, mirroredAx2
, rotate
, rotated
, scale
, scaled
, transform
, transformed
, translate
, translated
, translateRelative
, translatedRelative
) where


import OpenCascade.GP.Types
import OpenCascade.GP.Internal.Destructors
import Foreign.Ptr
import Foreign.C.Types
import OpenCascade.Internal.Bool (cBoolToBool)
import Data.Acquire 
import Data.Coerce (coerce)

foreign import capi unsafe "hs_gp_Ax3.h hs_new_gp_Ax3" rawNew :: IO (Ptr Ax3)

new :: Acquire (Ptr Ax3)
new :: Acquire (Ptr Ax3)
new = IO (Ptr Ax3) -> (Ptr Ax3 -> IO ()) -> Acquire (Ptr Ax3)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire IO (Ptr Ax3)
rawNew Ptr Ax3 -> IO ()
deleteAx3

foreign import capi unsafe "hs_gp_Ax3.h hs_new_gp_Ax3_fromAx2" rawFromAx2 :: Ptr Ax2 -> IO (Ptr Ax3)

fromAx2 :: Ptr Ax2 -> Acquire (Ptr Ax3)
fromAx2 :: Ptr Ax2 -> Acquire (Ptr Ax3)
fromAx2 Ptr Ax2
ax = IO (Ptr Ax3) -> (Ptr Ax3 -> IO ()) -> Acquire (Ptr Ax3)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax2 -> IO (Ptr Ax3)
rawFromAx2 Ptr Ax2
ax) Ptr Ax3 -> IO ()
deleteAx3

foreign import capi unsafe "hs_gp_Ax3.h hs_new_gp_Ax3_fromPntDirAndDir" rawFromPntDirAndDir :: Ptr Pnt -> Ptr Dir -> Ptr Dir -> IO (Ptr Ax3)

fromPntDirAndDir :: Ptr Pnt -> Ptr Dir -> Ptr Dir -> Acquire (Ptr Ax3)
fromPntDirAndDir :: Ptr Pnt -> Ptr Dir -> Ptr Dir -> Acquire (Ptr Ax3)
fromPntDirAndDir Ptr Pnt
pnt Ptr Dir
u Ptr Dir
v = IO (Ptr Ax3) -> (Ptr Ax3 -> IO ()) -> Acquire (Ptr Ax3)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Pnt -> Ptr Dir -> Ptr Dir -> IO (Ptr Ax3)
rawFromPntDirAndDir Ptr Pnt
pnt Ptr Dir
u Ptr Dir
v) Ptr Ax3 -> IO ()
deleteAx3 

foreign import capi unsafe "hs_gp_Ax3.h hs_new_gp_Ax3_fromPntAndDir" rawFromPntAndDir :: Ptr Pnt -> Ptr Dir -> IO (Ptr Ax3)

fromPntAndDir :: Ptr Pnt -> Ptr Dir -> Acquire (Ptr Ax3)
fromPntAndDir :: Ptr Pnt -> Ptr Dir -> Acquire (Ptr Ax3)
fromPntAndDir Ptr Pnt
pnt Ptr Dir
dir = IO (Ptr Ax3) -> (Ptr Ax3 -> IO ()) -> Acquire (Ptr Ax3)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Pnt -> Ptr Dir -> IO (Ptr Ax3)
rawFromPntAndDir Ptr Pnt
pnt Ptr Dir
dir) Ptr Ax3 -> IO ()
deleteAx3 

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_xReverse" xReverse :: Ptr Ax3 -> IO ()

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_yReverse" yReverse :: Ptr Ax3 -> IO ()

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_zReverse" zReverse :: Ptr Ax3 -> IO ()

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_setAxis" setAxis :: Ptr Ax3 -> Ptr Ax1 -> IO ()

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_setDirection" setDirection :: Ptr Ax3 -> Ptr Dir -> IO ()

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_setLocation" setLocation :: Ptr Ax3 -> Ptr Pnt -> IO ()

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_setXDirection" setXDirection :: Ptr Ax3 -> Ptr Dir -> IO ()

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_setYDirection" setYDirection :: Ptr Ax3 -> Ptr Dir -> IO ()

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_angle" rawAngle :: Ptr Ax3 -> Ptr Ax3 -> IO CDouble 

angle :: Ptr Ax3 -> Ptr Ax3 -> IO Double 
angle :: Ptr Ax3 -> Ptr Ax3 -> IO Double
angle = (Ptr Ax3 -> Ptr Ax3 -> IO CDouble)
-> Ptr Ax3 -> Ptr Ax3 -> IO Double
forall a b. Coercible a b => a -> b
coerce Ptr Ax3 -> Ptr Ax3 -> IO CDouble
rawAngle

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_axis" rawAxis :: Ptr Ax3  -> IO (Ptr Ax1)

axis :: Ptr Ax3 -> Acquire (Ptr Ax1)
axis :: Ptr Ax3 -> Acquire (Ptr Ax1)
axis Ptr Ax3
this = IO (Ptr Ax1) -> (Ptr Ax1 -> IO ()) -> Acquire (Ptr Ax1)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax3 -> IO (Ptr Ax1)
rawAxis Ptr Ax3
this) Ptr Ax1 -> IO ()
deleteAx1

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_ax2" rawAx2 :: Ptr Ax3  -> IO (Ptr Ax2)

ax2 :: Ptr Ax3 -> Acquire (Ptr Ax2)
ax2 :: Ptr Ax3 -> Acquire (Ptr Ax2)
ax2 Ptr Ax3
this = IO (Ptr Ax2) -> (Ptr Ax2 -> IO ()) -> Acquire (Ptr Ax2)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax3 -> IO (Ptr Ax2)
rawAx2 Ptr Ax3
this) Ptr Ax2 -> IO ()
deleteAx2

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_direction" rawDirection :: Ptr Ax3  -> IO (Ptr Dir)

direction :: Ptr Ax3 -> Acquire (Ptr Dir)
direction :: Ptr Ax3 -> Acquire (Ptr Dir)
direction Ptr Ax3
this = IO (Ptr Dir) -> (Ptr Dir -> IO ()) -> Acquire (Ptr Dir)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax3 -> IO (Ptr Dir)
rawDirection Ptr Ax3
this) Ptr Dir -> IO ()
deleteDir

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_location" rawLocation :: Ptr Ax3 -> IO (Ptr Pnt)

location :: Ptr Ax3 -> Acquire (Ptr Pnt)
location :: Ptr Ax3 -> Acquire (Ptr Pnt)
location Ptr Ax3
this = IO (Ptr Pnt) -> (Ptr Pnt -> IO ()) -> Acquire (Ptr Pnt)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax3 -> IO (Ptr Pnt)
rawLocation Ptr Ax3
this) Ptr Pnt -> IO ()
deletePnt

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_xDirection" rawXDirection :: Ptr Ax3  -> IO (Ptr Dir)

xDirection :: Ptr Ax3 -> Acquire (Ptr Dir)
xDirection :: Ptr Ax3 -> Acquire (Ptr Dir)
xDirection Ptr Ax3
this = IO (Ptr Dir) -> (Ptr Dir -> IO ()) -> Acquire (Ptr Dir)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax3 -> IO (Ptr Dir)
rawXDirection Ptr Ax3
this) Ptr Dir -> IO ()
deleteDir

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_yDirection" rawYDirection :: Ptr Ax3  -> IO (Ptr Dir)

yDirection :: Ptr Ax3 -> Acquire (Ptr Dir)
yDirection :: Ptr Ax3 -> Acquire (Ptr Dir)
yDirection Ptr Ax3
this = IO (Ptr Dir) -> (Ptr Dir -> IO ()) -> Acquire (Ptr Dir)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax3 -> IO (Ptr Dir)
rawYDirection Ptr Ax3
this) Ptr Dir -> IO ()
deleteDir

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_direct" rawDirect :: Ptr Ax3  -> IO CBool

direct :: Ptr Ax3 -> IO Bool
direct :: Ptr Ax3 -> IO Bool
direct = (CBool -> Bool) -> IO CBool -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CBool -> Bool
cBoolToBool (IO CBool -> IO Bool)
-> (Ptr Ax3 -> IO CBool) -> Ptr Ax3 -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Ax3 -> IO CBool
rawDirect

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_isCoplanar" rawIsCoplanar :: Ptr Ax3 -> Ptr Ax3 -> CDouble -> CDouble -> IO CBool

isCoplanar :: Ptr Ax3 -> Ptr Ax3 -> Double -> Double -> IO Bool
isCoplanar :: Ptr Ax3 -> Ptr Ax3 -> Double -> Double -> IO Bool
isCoplanar Ptr Ax3
a Ptr Ax3
b Double
linearTol Double
angularTol =  CBool -> Bool
cBoolToBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Ax3 -> Ptr Ax3 -> CDouble -> CDouble -> IO CBool
rawIsCoplanar Ptr Ax3
a Ptr Ax3
b (Double -> CDouble
forall a b. Coercible a b => a -> b
coerce Double
linearTol) (Double -> CDouble
forall a b. Coercible a b => a -> b
coerce Double
angularTol)

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_isCoplanarAx1" rawIsCoplanarAx1 :: Ptr Ax3 -> Ptr Ax1 -> CDouble -> CDouble -> IO CBool

isCoplanarAx1 :: Ptr Ax3 -> Ptr Ax1 -> Double -> Double -> IO Bool
isCoplanarAx1 :: Ptr Ax3 -> Ptr Ax1 -> Double -> Double -> IO Bool
isCoplanarAx1 Ptr Ax3
a Ptr Ax1
b Double
linearTol Double
angularTol =  CBool -> Bool
cBoolToBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Ax3 -> Ptr Ax1 -> CDouble -> CDouble -> IO CBool
rawIsCoplanarAx1 Ptr Ax3
a Ptr Ax1
b (Double -> CDouble
forall a b. Coercible a b => a -> b
coerce Double
linearTol) (Double -> CDouble
forall a b. Coercible a b => a -> b
coerce Double
angularTol)

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_mirror" mirror:: Ptr Ax3 -> Ptr Ax1 -> IO ()

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_mirrored" rawMirrored:: Ptr Ax3 -> Ptr Ax1 -> IO (Ptr Ax3)

mirrored :: Ptr Ax3 -> Ptr Ax1 -> Acquire (Ptr Ax3)
mirrored :: Ptr Ax3 -> Ptr Ax1 -> Acquire (Ptr Ax3)
mirrored Ptr Ax3
ax Ptr Ax1
mirrorAxis = IO (Ptr Ax3) -> (Ptr Ax3 -> IO ()) -> Acquire (Ptr Ax3)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax3 -> Ptr Ax1 -> IO (Ptr Ax3)
rawMirrored Ptr Ax3
ax Ptr Ax1
mirrorAxis) Ptr Ax3 -> IO ()
deleteAx3

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_mirror_Ax2" mirrorAx2:: Ptr Ax3 -> Ptr Ax2 -> IO ()

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_mirrored_Ax2" rawMirroredAx2 :: Ptr Ax3 -> Ptr Ax2 -> IO (Ptr Ax3)

mirroredAx2 :: Ptr Ax3 -> Ptr Ax2 -> Acquire (Ptr Ax3)
mirroredAx2 :: Ptr Ax3 -> Ptr Ax2 -> Acquire (Ptr Ax3)
mirroredAx2 Ptr Ax3
ax Ptr Ax2
mirrorAxis = IO (Ptr Ax3) -> (Ptr Ax3 -> IO ()) -> Acquire (Ptr Ax3)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax3 -> Ptr Ax2 -> IO (Ptr Ax3)
rawMirroredAx2 Ptr Ax3
ax Ptr Ax2
mirrorAxis) Ptr Ax3 -> IO ()
deleteAx3

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_rotate" rawRotate :: Ptr Ax3 -> Ptr Ax1 -> CDouble  -> IO ()

rotate :: Ptr Ax3 -> Ptr Ax1 -> Double -> IO ()
rotate :: Ptr Ax3 -> Ptr Ax1 -> Double -> IO ()
rotate = (Ptr Ax3 -> Ptr Ax1 -> CDouble -> IO ())
-> Ptr Ax3 -> Ptr Ax1 -> Double -> IO ()
forall a b. Coercible a b => a -> b
coerce Ptr Ax3 -> Ptr Ax1 -> CDouble -> IO ()
rawRotate

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_rotated" rawRotated :: Ptr Ax3 -> Ptr Ax1  -> CDouble -> IO (Ptr Ax3)

rotated :: Ptr Ax3 -> Ptr Ax1 -> Double -> Acquire (Ptr Ax3)
rotated :: Ptr Ax3 -> Ptr Ax1 -> Double -> Acquire (Ptr Ax3)
rotated Ptr Ax3
ax Ptr Ax1
axisOfRotation Double
angleOfRotation = IO (Ptr Ax3) -> (Ptr Ax3 -> IO ()) -> Acquire (Ptr Ax3)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax3 -> Ptr Ax1 -> CDouble -> IO (Ptr Ax3)
rawRotated Ptr Ax3
ax Ptr Ax1
axisOfRotation (Double -> CDouble
forall a b. Coercible a b => a -> b
coerce Double
angleOfRotation)) Ptr Ax3 -> IO ()
deleteAx3

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_scale" rawScale :: Ptr Ax3 -> Ptr Pnt -> CDouble  -> IO ()

scale :: Ptr Ax3 -> Ptr Pnt -> Double -> IO ()
scale :: Ptr Ax3 -> Ptr Pnt -> Double -> IO ()
scale = (Ptr Ax3 -> Ptr Pnt -> CDouble -> IO ())
-> Ptr Ax3 -> Ptr Pnt -> Double -> IO ()
forall a b. Coercible a b => a -> b
coerce Ptr Ax3 -> Ptr Pnt -> CDouble -> IO ()
rawScale

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_scaled" rawScaled :: Ptr Ax3 -> Ptr Pnt  -> CDouble -> IO (Ptr Ax3)

scaled :: Ptr Ax3 -> Ptr Pnt -> Double -> Acquire (Ptr Ax3)
scaled :: Ptr Ax3 -> Ptr Pnt -> Double -> Acquire (Ptr Ax3)
scaled Ptr Ax3
ax Ptr Pnt
origin Double
factor = IO (Ptr Ax3) -> (Ptr Ax3 -> IO ()) -> Acquire (Ptr Ax3)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax3 -> Ptr Pnt -> CDouble -> IO (Ptr Ax3)
rawScaled Ptr Ax3
ax Ptr Pnt
origin (Double -> CDouble
forall a b. Coercible a b => a -> b
coerce Double
factor)) Ptr Ax3 -> IO ()
deleteAx3


foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_transform" transform:: Ptr Ax3 -> Ptr Trsf -> IO ()

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_transformed" rawTransformed :: Ptr Ax3 -> Ptr Trsf -> IO (Ptr Ax3)

transformed :: Ptr Ax3 -> Ptr Trsf -> Acquire (Ptr Ax3)
transformed :: Ptr Ax3 -> Ptr Trsf -> Acquire (Ptr Ax3)
transformed Ptr Ax3
ax Ptr Trsf
trsf = IO (Ptr Ax3) -> (Ptr Ax3 -> IO ()) -> Acquire (Ptr Ax3)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax3 -> Ptr Trsf -> IO (Ptr Ax3)
rawTransformed Ptr Ax3
ax Ptr Trsf
trsf) Ptr Ax3 -> IO ()
deleteAx3


foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_translate" translate :: Ptr Ax3 -> Ptr Vec -> IO ()

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_translated" rawTranslated :: Ptr Ax3 -> Ptr Vec -> IO (Ptr Ax3)

translated :: Ptr Ax3 -> Ptr Vec -> Acquire (Ptr Ax3)
translated :: Ptr Ax3 -> Ptr Vec -> Acquire (Ptr Ax3)
translated Ptr Ax3
ax Ptr Vec
vec = IO (Ptr Ax3) -> (Ptr Ax3 -> IO ()) -> Acquire (Ptr Ax3)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax3 -> Ptr Vec -> IO (Ptr Ax3)
rawTranslated Ptr Ax3
ax Ptr Vec
vec) Ptr Ax3 -> IO ()
deleteAx3

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_translateRelative" translateRelative :: Ptr Ax3 -> Ptr Pnt -> Ptr Pnt -> IO ()

foreign import capi unsafe "hs_gp_Ax3.h hs_gp_Ax3_translatedRelative" rawTranslatedRelative :: Ptr Ax3 -> Ptr Pnt -> Ptr Pnt -> IO (Ptr Ax3)

translatedRelative :: Ptr Ax3 -> Ptr Pnt -> Ptr Pnt -> Acquire (Ptr Ax3)
translatedRelative :: Ptr Ax3 -> Ptr Pnt -> Ptr Pnt -> Acquire (Ptr Ax3)
translatedRelative Ptr Ax3
ax Ptr Pnt
from Ptr Pnt
to = IO (Ptr Ax3) -> (Ptr Ax3 -> IO ()) -> Acquire (Ptr Ax3)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax3 -> Ptr Pnt -> Ptr Pnt -> IO (Ptr Ax3)
rawTranslatedRelative Ptr Ax3
ax Ptr Pnt
from Ptr Pnt
to) Ptr Ax3 -> IO ()
deleteAx3