{-# LANGUAGE CApiFFI #-}
module OpenCascade.GP.Ax1
( Ax1
, new
, location
, direction
, setLocation
, setDirection
, isCoaxial
, isNormal
, isOpposite
, isParallel
, angle
, reverse
, reversed
, mirror
, mirrored
, mirrorAboutPnt
, mirroredAboutPnt
, mirrorAboutAx2
, mirroredAboutAx2
, rotate
, rotated
, scale
, scaled
, transform
, transformed
, translate
, translated
, translateRelative
, translatedRelative
) where

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

-- new and delete

foreign import capi unsafe "hs_gp_Ax1.h hs_new_gp_Ax1" rawNew :: Ptr Pnt -> Ptr Dir -> IO (Ptr Ax1)

new :: Ptr Pnt -> Ptr Dir -> Acquire (Ptr Ax1)
new :: Ptr Pnt -> Ptr Dir -> Acquire (Ptr Ax1)
new Ptr Pnt
origin Ptr Dir
dir = IO (Ptr Ax1) -> (Ptr Ax1 -> IO ()) -> Acquire (Ptr Ax1)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Pnt -> Ptr Dir -> IO (Ptr Ax1)
rawNew Ptr Pnt
origin Ptr Dir
dir) Ptr Ax1 -> IO ()
deleteAx1

-- getters

foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_Location" rawLocation :: Ptr Ax1 -> IO (Ptr Pnt)

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

foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_Direction" rawDirection :: Ptr Ax1 -> IO (Ptr Dir)

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

-- setters

foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_SetDirection" setDirection :: Ptr Ax1 -> Ptr Dir -> IO ()

foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_SetLocation" setLocation :: Ptr Ax1 -> Ptr Pnt -> IO ()

-- tests

-- isCoaxial

foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_IsCoaxial" rawIsCoaxial :: Ptr Ax1 -> Ptr Ax1 -> CDouble -> CDouble -> IO CBool

isCoaxial :: Ptr Ax1 -> Ptr Ax1 -> Double -> Double -> IO Bool
isCoaxial :: Ptr Ax1 -> Ptr Ax1 -> Double -> Double -> IO Bool
isCoaxial Ptr Ax1
a Ptr Ax1
b Double
angularTolerance Double
linearTolerance = (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 Ax1 -> Ptr Ax1 -> CDouble -> CDouble -> IO CBool
rawIsCoaxial Ptr Ax1
a Ptr Ax1
b (Double -> CDouble
CDouble Double
angularTolerance) (Double -> CDouble
CDouble Double
linearTolerance)

-- isNormal

foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_IsNormal" rawIsNormal :: Ptr Ax1 -> Ptr Ax1 -> CDouble -> IO CBool

isNormal :: Ptr Ax1 -> Ptr Ax1 -> Double -> IO Bool
isNormal :: Ptr Ax1 -> Ptr Ax1 -> Double -> IO Bool
isNormal Ptr Ax1
a Ptr Ax1
b Double
angularTolerance = (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 Ax1 -> Ptr Ax1 -> CDouble -> IO CBool
rawIsNormal Ptr Ax1
a Ptr Ax1
b (Double -> CDouble
CDouble Double
angularTolerance)

-- isOpposite

foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_IsOpposite" rawIsOpposite :: Ptr Ax1 -> Ptr Ax1 -> CDouble -> IO CBool

isOpposite :: Ptr Ax1 -> Ptr Ax1 -> Double -> IO Bool
isOpposite :: Ptr Ax1 -> Ptr Ax1 -> Double -> IO Bool
isOpposite Ptr Ax1
a Ptr Ax1
b Double
angularTolerance = (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 Ax1 -> Ptr Ax1 -> CDouble -> IO CBool
rawIsOpposite Ptr Ax1
a Ptr Ax1
b (Double -> CDouble
CDouble Double
angularTolerance)

-- isParallel

foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_IsParallel" rawIsParallel :: Ptr Ax1 -> Ptr Ax1 -> CDouble -> IO CBool

isParallel :: Ptr Ax1 -> Ptr Ax1 -> Double -> IO Bool
isParallel :: Ptr Ax1 -> Ptr Ax1 -> Double -> IO Bool
isParallel Ptr Ax1
a Ptr Ax1
b Double
angularTolerance = (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 Ax1 -> Ptr Ax1 -> CDouble -> IO CBool
rawIsParallel Ptr Ax1
a Ptr Ax1
b (Double -> CDouble
CDouble Double
angularTolerance)

-- angle

foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_Angle" rawAngle :: Ptr Ax1 -> Ptr Ax1 -> IO CDouble

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

-- reverse/reversed

foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_Reverse" reverse :: Ptr Ax1 -> IO ()

foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_Reversed" rawReversed :: Ptr Ax1 -> IO (Ptr Ax1)

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

-- mirror/mirrored

foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_Mirror" mirror :: Ptr Ax1 -> Ptr Ax1 -> IO ()

foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_Mirrored" rawMirrored :: Ptr Ax1 -> Ptr Ax1 -> IO (Ptr Ax1)

mirrored :: Ptr Ax1 -> Ptr Ax1 -> Acquire (Ptr Ax1)
mirrored :: Ptr Ax1 -> Ptr Ax1 -> Acquire (Ptr Ax1)
mirrored Ptr Ax1
axis Ptr Ax1
mirrorAxis = IO (Ptr Ax1) -> (Ptr Ax1 -> IO ()) -> Acquire (Ptr Ax1)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax1 -> Ptr Ax1 -> IO (Ptr Ax1)
rawMirrored Ptr Ax1
axis Ptr Ax1
mirrorAxis) Ptr Ax1 -> IO ()
deleteAx1


foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_MirrorAboutPnt" mirrorAboutPnt :: Ptr Ax1 -> Ptr Pnt -> IO ()

foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_MirroredAboutPnt" rawMirroredAboutPnt :: Ptr Ax1 -> Ptr Pnt -> IO (Ptr Ax1)

mirroredAboutPnt :: Ptr Ax1 -> Ptr Pnt -> Acquire (Ptr Ax1)
mirroredAboutPnt :: Ptr Ax1 -> Ptr Pnt -> Acquire (Ptr Ax1)
mirroredAboutPnt Ptr Ax1
axis Ptr Pnt
mirrorPnt = IO (Ptr Ax1) -> (Ptr Ax1 -> IO ()) -> Acquire (Ptr Ax1)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax1 -> Ptr Pnt -> IO (Ptr Ax1)
rawMirroredAboutPnt Ptr Ax1
axis Ptr Pnt
mirrorPnt) Ptr Ax1 -> IO ()
deleteAx1


foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_MirrorAboutAx2" mirrorAboutAx2 :: Ptr Ax1 -> Ptr Ax2 -> IO ()

foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_MirroredAboutAx2" rawMirroredAboutAx2 :: Ptr Ax1 -> Ptr Ax2 -> IO (Ptr Ax1)

mirroredAboutAx2 :: Ptr Ax1 -> Ptr Ax2 -> Acquire (Ptr Ax1)
mirroredAboutAx2 :: Ptr Ax1 -> Ptr Ax2 -> Acquire (Ptr Ax1)
mirroredAboutAx2 Ptr Ax1
axis Ptr Ax2
mirrorAxis = IO (Ptr Ax1) -> (Ptr Ax1 -> IO ()) -> Acquire (Ptr Ax1)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax1 -> Ptr Ax2 -> IO (Ptr Ax1)
rawMirroredAboutAx2 Ptr Ax1
axis Ptr Ax2
mirrorAxis) Ptr Ax1 -> IO ()
deleteAx1

-- rotate/rotated 

foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_Rotate" rawRotate :: Ptr Ax1 -> Ptr Ax1 -> CDouble -> IO ()

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

foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_Rotated" rawRotated :: Ptr Ax1 -> Ptr Ax1 -> CDouble -> IO (Ptr Ax1)

rotated :: Ptr Ax1 -> Ptr Ax1 -> Double -> Acquire (Ptr Ax1)
rotated :: Ptr Ax1 -> Ptr Ax1 -> Double -> Acquire (Ptr Ax1)
rotated Ptr Ax1
axis Ptr Ax1
axisOfRotation Double
angleOfRotation = IO (Ptr Ax1) -> (Ptr Ax1 -> IO ()) -> Acquire (Ptr Ax1)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax1 -> Ptr Ax1 -> CDouble -> IO (Ptr Ax1)
rawRotated Ptr Ax1
axis Ptr Ax1
axisOfRotation (Double -> CDouble
CDouble Double
angleOfRotation)) Ptr Ax1 -> IO ()
deleteAx1

-- scale/scaled 

foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_Scale" rawScale :: Ptr Ax1 -> Ptr Pnt -> CDouble -> IO ()

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

foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_Scaled" rawScaled :: Ptr Ax1 -> Ptr Pnt -> CDouble -> IO (Ptr Ax1)

scaled :: Ptr Ax1 -> Ptr Pnt -> Double -> Acquire (Ptr Ax1)
scaled :: Ptr Ax1 -> Ptr Pnt -> Double -> Acquire (Ptr Ax1)
scaled Ptr Ax1
axis Ptr Pnt
origin Double
amount = IO (Ptr Ax1) -> (Ptr Ax1 -> IO ()) -> Acquire (Ptr Ax1)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax1 -> Ptr Pnt -> CDouble -> IO (Ptr Ax1)
rawScaled Ptr Ax1
axis Ptr Pnt
origin (Double -> CDouble
CDouble Double
amount)) Ptr Ax1 -> IO ()
deleteAx1

-- transform/transformed 

foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_Transform" transform :: Ptr Ax1 -> Ptr Trsf -> IO ()

foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_Transformed" rawTransformed :: Ptr Ax1 -> Ptr Trsf -> IO (Ptr Ax1)

transformed :: Ptr Ax1 -> Ptr Trsf -> Acquire (Ptr Ax1)
transformed :: Ptr Ax1 -> Ptr Trsf -> Acquire (Ptr Ax1)
transformed Ptr Ax1
axis Ptr Trsf
trsf = IO (Ptr Ax1) -> (Ptr Ax1 -> IO ()) -> Acquire (Ptr Ax1)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax1 -> Ptr Trsf -> IO (Ptr Ax1)
rawTransformed Ptr Ax1
axis Ptr Trsf
trsf) Ptr Ax1 -> IO ()
deleteAx1


-- translate/translated

foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_Translate" translate :: Ptr Ax1 -> Ptr Vec -> IO ()

foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_Translated" rawTranslated :: Ptr Ax1 -> Ptr Vec -> IO (Ptr Ax1)

translated :: Ptr Ax1 -> Ptr Vec -> Acquire (Ptr Ax1)
translated :: Ptr Ax1 -> Ptr Vec -> Acquire (Ptr Ax1)
translated Ptr Ax1
axis Ptr Vec
vec = IO (Ptr Ax1) -> (Ptr Ax1 -> IO ()) -> Acquire (Ptr Ax1)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax1 -> Ptr Vec -> IO (Ptr Ax1)
rawTranslated Ptr Ax1
axis Ptr Vec
vec) Ptr Ax1 -> IO ()
deleteAx1


foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_TranslateRelative" translateRelative :: Ptr Ax1 -> Ptr Pnt -> Ptr Pnt -> IO ()

foreign import capi unsafe "hs_gp_Ax1.h hs_gp_Ax1_TranslatedRelative" rawTranslatedRelative :: Ptr Ax1 -> Ptr Pnt -> Ptr Pnt -> IO (Ptr Ax1)

translatedRelative :: Ptr Ax1 -> Ptr Pnt -> Ptr Pnt -> Acquire (Ptr Ax1)
translatedRelative :: Ptr Ax1 -> Ptr Pnt -> Ptr Pnt -> Acquire (Ptr Ax1)
translatedRelative Ptr Ax1
axis Ptr Pnt
from Ptr Pnt
to = IO (Ptr Ax1) -> (Ptr Ax1 -> IO ()) -> Acquire (Ptr Ax1)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax1 -> Ptr Pnt -> Ptr Pnt -> IO (Ptr Ax1)
rawTranslatedRelative Ptr Ax1
axis Ptr Pnt
from Ptr Pnt
to) Ptr Ax1 -> IO ()
deleteAx1