{-# LANGUAGE CApiFFI #-}
module OpenCascade.GP.Dir 
( Dir
, new
, getX
, getY
, getZ 
, setX
, setY 
, setZ
, isEqual
, isOpposite
, isNormal
, isParallel
, angle
, angleWithRef
, cross
, crossed
, crossCross
, crossCrossed
, dot
, dotCross
, reverse
, reversed
, mirror
, mirrored
, mirrorAboutAx1
, mirroredAboutAx1
, mirrorAboutAx2
, mirroredAboutAx2
, rotate
, rotated
, transform
, transformed
) where


import Prelude hiding (reverse)
import OpenCascade.GP.Types
import OpenCascade.GP.Internal.Destructors
import Foreign.C
import Foreign.Ptr
import Data.Coerce (coerce)
import Data.Acquire 

-- new

foreign import capi unsafe "hs_gp_Dir.h hs_new_gp_Dir" rawNew :: CDouble -> CDouble -> CDouble -> IO (Ptr Dir)

new :: Double -> Double -> Double -> Acquire (Ptr Dir)
new :: Double -> Double -> Double -> Acquire (Ptr Dir)
new Double
x Double
y Double
z = IO (Ptr Dir) -> (Ptr Dir -> IO ()) -> Acquire (Ptr Dir)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (CDouble -> CDouble -> CDouble -> IO (Ptr Dir)
rawNew (Double -> CDouble
CDouble Double
x) (Double -> CDouble
CDouble Double
y) (Double -> CDouble
CDouble Double
z)) Ptr Dir -> IO ()
deleteDir

-- getters

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_X" rawX :: Ptr Dir -> IO (CDouble)

getX :: Ptr Dir -> IO Double
getX :: Ptr Dir -> IO Double
getX = (Ptr Dir -> IO CDouble) -> Ptr Dir -> IO Double
forall a b. Coercible a b => a -> b
coerce Ptr Dir -> IO CDouble
rawX

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_Y" rawY :: Ptr Dir -> IO (CDouble)

getY :: Ptr Dir -> IO Double
getY :: Ptr Dir -> IO Double
getY = (Ptr Dir -> IO CDouble) -> Ptr Dir -> IO Double
forall a b. Coercible a b => a -> b
coerce Ptr Dir -> IO CDouble
rawY

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_Z" rawZ :: Ptr Dir -> IO (CDouble)

getZ :: Ptr Dir -> IO Double
getZ :: Ptr Dir -> IO Double
getZ = (Ptr Dir -> IO CDouble) -> Ptr Dir -> IO Double
forall a b. Coercible a b => a -> b
coerce Ptr Dir -> IO CDouble
rawZ

-- setters

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_SetX" rawSetX :: Ptr Dir -> CDouble -> IO ()

setX :: Ptr Dir -> Double -> IO ()
setX :: Ptr Dir -> Double -> IO ()
setX = (Ptr Dir -> CDouble -> IO ()) -> Ptr Dir -> Double -> IO ()
forall a b. Coercible a b => a -> b
coerce Ptr Dir -> CDouble -> IO ()
rawSetX


foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_SetY" rawSetY :: Ptr Dir -> CDouble -> IO ()

setY :: Ptr Dir -> Double -> IO ()
setY :: Ptr Dir -> Double -> IO ()
setY = (Ptr Dir -> CDouble -> IO ()) -> Ptr Dir -> Double -> IO ()
forall a b. Coercible a b => a -> b
coerce Ptr Dir -> CDouble -> IO ()
rawSetY


foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_SetZ" rawSetZ :: Ptr Dir -> CDouble -> IO ()

setZ :: Ptr Dir -> Double -> IO ()
setZ :: Ptr Dir -> Double -> IO ()
setZ = (Ptr Dir -> CDouble -> IO ()) -> Ptr Dir -> Double -> IO ()
forall a b. Coercible a b => a -> b
coerce Ptr Dir -> CDouble -> IO ()
rawSetZ

-- tests

-- isEqual

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_IsEqual" rawIsEqual :: Ptr Dir -> Ptr Dir -> CDouble -> IO CBool

isEqual :: Ptr Dir -> Ptr Dir -> Double -> IO Bool
isEqual :: Ptr Dir -> Ptr Dir -> Double -> IO Bool
isEqual Ptr Dir
a Ptr Dir
b Double
tolerance = (CBool -> CBool -> Bool
forall a. Eq a => a -> a -> Bool
/= CBool
0) (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Dir -> Ptr Dir -> CDouble -> IO CBool
rawIsEqual Ptr Dir
a Ptr Dir
b (Double -> CDouble
CDouble Double
tolerance)

-- isNormal

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_IsNormal" rawIsNormal :: Ptr Dir -> Ptr Dir -> CDouble -> IO CBool

isNormal :: Ptr Dir -> Ptr Dir -> Double -> IO Bool
isNormal :: Ptr Dir -> Ptr Dir -> Double -> IO Bool
isNormal Ptr Dir
a Ptr Dir
b Double
tolerance = (CBool -> CBool -> Bool
forall a. Eq a => a -> a -> Bool
/= CBool
0) (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Dir -> Ptr Dir -> CDouble -> IO CBool
rawIsNormal Ptr Dir
a Ptr Dir
b (Double -> CDouble
CDouble Double
tolerance)


-- isOpposite

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_IsOpposite" rawIsOpposite :: Ptr Dir -> Ptr Dir -> CDouble -> IO CBool

isOpposite :: Ptr Dir -> Ptr Dir -> Double -> IO Bool
isOpposite :: Ptr Dir -> Ptr Dir -> Double -> IO Bool
isOpposite Ptr Dir
a Ptr Dir
b Double
tolerance = (CBool -> CBool -> Bool
forall a. Eq a => a -> a -> Bool
/= CBool
0) (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Dir -> Ptr Dir -> CDouble -> IO CBool
rawIsOpposite Ptr Dir
a Ptr Dir
b (Double -> CDouble
CDouble Double
tolerance)

-- isParallel

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_IsParallel" rawIsParallel :: Ptr Dir -> Ptr Dir -> CDouble -> IO CBool

isParallel :: Ptr Dir -> Ptr Dir -> Double -> IO Bool
isParallel :: Ptr Dir -> Ptr Dir -> Double -> IO Bool
isParallel Ptr Dir
a Ptr Dir
b Double
tolerance = (CBool -> CBool -> Bool
forall a. Eq a => a -> a -> Bool
/= CBool
0) (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Dir -> Ptr Dir -> CDouble -> IO CBool
rawIsParallel Ptr Dir
a Ptr Dir
b (Double -> CDouble
CDouble Double
tolerance)

-- angle

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_Angle" rawAngle :: Ptr Dir -> Ptr Dir -> IO CDouble

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

-- angleWithRef

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_AngleWithRef" rawAngleWithRef :: Ptr Dir -> Ptr Dir -> Ptr Dir -> IO CDouble

angleWithRef :: Ptr Dir -> Ptr Dir -> Ptr Dir -> IO Double
angleWithRef :: Ptr Dir -> Ptr Dir -> Ptr Dir -> IO Double
angleWithRef = (Ptr Dir -> Ptr Dir -> Ptr Dir -> IO CDouble)
-> Ptr Dir -> Ptr Dir -> Ptr Dir -> IO Double
forall a b. Coercible a b => a -> b
coerce Ptr Dir -> Ptr Dir -> Ptr Dir -> IO CDouble
rawAngleWithRef

-- cross/crossed

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_Cross" cross :: Ptr Dir -> Ptr Dir -> IO ()

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_Crossed" rawCrossed :: Ptr Dir -> Ptr Dir -> IO (Ptr Dir)

crossed :: Ptr Dir -> Ptr Dir -> Acquire (Ptr Dir)
crossed :: Ptr Dir -> Ptr Dir -> Acquire (Ptr Dir)
crossed Ptr Dir
a Ptr Dir
b = IO (Ptr Dir) -> (Ptr Dir -> IO ()) -> Acquire (Ptr Dir)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Dir -> Ptr Dir -> IO (Ptr Dir)
rawCrossed Ptr Dir
a Ptr Dir
b) Ptr Dir -> IO ()
deleteDir


-- crossCross/crossCrossed

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_CrossCross" crossCross :: Ptr Dir -> Ptr Dir -> Ptr Dir -> IO ()

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_CrossCrossed" rawCrossCrossed :: Ptr Dir -> Ptr Dir -> Ptr Dir -> IO (Ptr Dir)

crossCrossed :: Ptr Dir -> Ptr Dir -> Ptr Dir -> Acquire (Ptr Dir)
crossCrossed :: Ptr Dir -> Ptr Dir -> Ptr Dir -> Acquire (Ptr Dir)
crossCrossed Ptr Dir
a Ptr Dir
b Ptr Dir
c = IO (Ptr Dir) -> (Ptr Dir -> IO ()) -> Acquire (Ptr Dir)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Dir -> Ptr Dir -> Ptr Dir -> IO (Ptr Dir)
rawCrossCrossed Ptr Dir
a Ptr Dir
b Ptr Dir
c) Ptr Dir -> IO ()
deleteDir


-- dot

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_Dot" rawDot :: Ptr Dir -> Ptr Dir -> IO CDouble

dot :: Ptr Dir -> Ptr Dir -> IO Double
dot :: Ptr Dir -> Ptr Dir -> IO Double
dot = (Ptr Dir -> Ptr Dir -> IO CDouble)
-> Ptr Dir -> Ptr Dir -> IO Double
forall a b. Coercible a b => a -> b
coerce Ptr Dir -> Ptr Dir -> IO CDouble
rawDot


-- dotCross

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_DotCross" rawDotCross :: Ptr Dir -> Ptr Dir -> Ptr Dir -> IO CDouble

dotCross :: Ptr Dir -> Ptr Dir -> Ptr Dir -> IO Double
dotCross :: Ptr Dir -> Ptr Dir -> Ptr Dir -> IO Double
dotCross = (Ptr Dir -> Ptr Dir -> Ptr Dir -> IO CDouble)
-> Ptr Dir -> Ptr Dir -> Ptr Dir -> IO Double
forall a b. Coercible a b => a -> b
coerce Ptr Dir -> Ptr Dir -> Ptr Dir -> IO CDouble
rawDotCross


-- reverse/reversed

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_Reverse" reverse :: Ptr Dir -> IO ()

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_Reversed" rawReversed :: Ptr Dir -> IO (Ptr Dir)

reversed :: Ptr Dir -> Acquire (Ptr Dir)
reversed :: Ptr Dir -> Acquire (Ptr Dir)
reversed Ptr Dir
axis = IO (Ptr Dir) -> (Ptr Dir -> IO ()) -> Acquire (Ptr Dir)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Dir -> IO (Ptr Dir)
rawReversed Ptr Dir
axis) Ptr Dir -> IO ()
deleteDir

-- mirror/mirrored

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_Mirror" mirror :: Ptr Dir -> Ptr Dir -> IO ()

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_Mirrored" rawMirrored :: Ptr Dir -> Ptr Dir -> IO (Ptr Dir)

mirrored :: Ptr Dir -> Ptr Dir -> Acquire (Ptr Dir)
mirrored :: Ptr Dir -> Ptr Dir -> Acquire (Ptr Dir)
mirrored Ptr Dir
point Ptr Dir
axis = IO (Ptr Dir) -> (Ptr Dir -> IO ()) -> Acquire (Ptr Dir)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Dir -> Ptr Dir -> IO (Ptr Dir)
rawMirrored Ptr Dir
point Ptr Dir
axis) Ptr Dir -> IO ()
deleteDir

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_MirrorAboutAx1" mirrorAboutAx1 :: Ptr Dir -> Ptr Ax1 -> IO ()

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_MirroredAboutAx1" rawMirroredAboutAx1 :: Ptr Dir -> Ptr Ax1 -> IO (Ptr Dir)

mirroredAboutAx1 :: Ptr Dir -> Ptr Ax1 -> Acquire (Ptr Dir)
mirroredAboutAx1 :: Ptr Dir -> Ptr Ax1 -> Acquire (Ptr Dir)
mirroredAboutAx1 Ptr Dir
point Ptr Ax1
axis = IO (Ptr Dir) -> (Ptr Dir -> IO ()) -> Acquire (Ptr Dir)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Dir -> Ptr Ax1 -> IO (Ptr Dir)
rawMirroredAboutAx1 Ptr Dir
point Ptr Ax1
axis) Ptr Dir -> IO ()
deleteDir

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_MirrorAboutAx2" mirrorAboutAx2 :: Ptr Dir -> Ptr Ax2 -> IO ()

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_MirroredAboutAx2" rawMirroredAboutAx2 :: Ptr Dir -> Ptr Ax2 -> IO (Ptr Dir)

mirroredAboutAx2 :: Ptr Dir -> Ptr Ax2 -> Acquire (Ptr Dir)
mirroredAboutAx2 :: Ptr Dir -> Ptr Ax2 -> Acquire (Ptr Dir)
mirroredAboutAx2 Ptr Dir
point Ptr Ax2
axis = IO (Ptr Dir) -> (Ptr Dir -> IO ()) -> Acquire (Ptr Dir)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Dir -> Ptr Ax2 -> IO (Ptr Dir)
rawMirroredAboutAx2 Ptr Dir
point Ptr Ax2
axis) Ptr Dir -> IO ()
deleteDir

-- rotate/rotated

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_Rotate" rotate :: Ptr Dir -> Ptr Ax1 -> CDouble-> IO ()

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_Rotated" rawRotated :: Ptr Dir -> Ptr Ax1 -> CDouble -> IO (Ptr Dir)

rotated :: Ptr Dir -> Ptr Ax1 -> Double -> Acquire (Ptr Dir)
rotated :: Ptr Dir -> Ptr Ax1 -> Double -> Acquire (Ptr Dir)
rotated Ptr Dir
point Ptr Ax1
axis Double
amount = IO (Ptr Dir) -> (Ptr Dir -> IO ()) -> Acquire (Ptr Dir)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Dir -> Ptr Ax1 -> CDouble -> IO (Ptr Dir)
rawRotated Ptr Dir
point Ptr Ax1
axis (Double -> CDouble
CDouble Double
amount)) Ptr Dir -> IO ()
deleteDir

-- transform/transformed

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_Transform" transform :: Ptr Dir -> Ptr Trsf -> IO ()

foreign import capi unsafe "hs_gp_Dir.h hs_gp_Dir_Transformed" rawTransformed :: Ptr Dir -> Ptr Trsf -> IO (Ptr Dir)

transformed :: Ptr Dir -> Ptr Trsf -> Acquire (Ptr Dir)
transformed :: Ptr Dir -> Ptr Trsf -> Acquire (Ptr Dir)
transformed Ptr Dir
point Ptr Trsf
trsf = IO (Ptr Dir) -> (Ptr Dir -> IO ()) -> Acquire (Ptr Dir)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Dir -> Ptr Trsf -> IO (Ptr Dir)
rawTransformed Ptr Dir
point Ptr Trsf
trsf) Ptr Dir -> IO ()
deleteDir