{-# LANGUAGE CApiFFI #-}
module OpenCascade.GP.Ax2d
( Ax2d
, new
, location
, direction
, setLocation
, setDirection
, isCoaxial
, isNormal
, isOpposite
, isParallel
, angle
, reverse
, reversed
, mirror
, mirrored
, mirrorAboutPnt2d
, mirroredAboutPnt2d
, 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_Ax2d.h hs_new_gp_Ax2d" rawNew :: Ptr Pnt2d -> Ptr Dir2d -> IO (Ptr Ax2d)

new :: Ptr Pnt2d -> Ptr Dir2d -> Acquire (Ptr Ax2d)
new :: Ptr Pnt2d -> Ptr Dir2d -> Acquire (Ptr Ax2d)
new Ptr Pnt2d
origin Ptr Dir2d
dir = IO (Ptr Ax2d) -> (Ptr Ax2d -> IO ()) -> Acquire (Ptr Ax2d)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Pnt2d -> Ptr Dir2d -> IO (Ptr Ax2d)
rawNew Ptr Pnt2d
origin Ptr Dir2d
dir) Ptr Ax2d -> IO ()
deleteAx2d

-- getters

foreign import capi unsafe "hs_gp_Ax2d.h hs_gp_Ax2d_Location" rawLocation :: Ptr Ax2d -> IO (Ptr Pnt2d)

location :: Ptr Ax2d -> Acquire (Ptr Pnt2d)
location :: Ptr Ax2d -> Acquire (Ptr Pnt2d)
location Ptr Ax2d
ax2d = IO (Ptr Pnt2d) -> (Ptr Pnt2d -> IO ()) -> Acquire (Ptr Pnt2d)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax2d -> IO (Ptr Pnt2d)
rawLocation Ptr Ax2d
ax2d) Ptr Pnt2d -> IO ()
deletePnt2d

foreign import capi unsafe "hs_gp_Ax2d.h hs_gp_Ax2d_Direction" rawDirection :: Ptr Ax2d -> IO (Ptr Dir2d)

direction :: Ptr Ax2d -> Acquire (Ptr Dir2d)
direction :: Ptr Ax2d -> Acquire (Ptr Dir2d)
direction Ptr Ax2d
ax2d = IO (Ptr Dir2d) -> (Ptr Dir2d -> IO ()) -> Acquire (Ptr Dir2d)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax2d -> IO (Ptr Dir2d)
rawDirection Ptr Ax2d
ax2d) Ptr Dir2d -> IO ()
deleteDir2d

-- setters

foreign import capi unsafe "hs_gp_Ax2d.h hs_gp_Ax2d_SetDirection" setDirection :: Ptr Ax2d -> Ptr Dir2d -> IO ()

foreign import capi unsafe "hs_gp_Ax2d.h hs_gp_Ax2d_SetLocation" setLocation :: Ptr Ax2d -> Ptr Pnt2d -> IO ()

-- tests

-- isCoaxial

foreign import capi unsafe "hs_gp_Ax2d.h hs_gp_Ax2d_IsCoaxial" rawIsCoaxial :: Ptr Ax2d -> Ptr Ax2d -> CDouble -> CDouble -> IO CBool

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

-- isNormal

foreign import capi unsafe "hs_gp_Ax2d.h hs_gp_Ax2d_IsNormal" rawIsNormal :: Ptr Ax2d -> Ptr Ax2d -> CDouble -> IO CBool

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

-- isOpposite

foreign import capi unsafe "hs_gp_Ax2d.h hs_gp_Ax2d_IsOpposite" rawIsOpposite :: Ptr Ax2d -> Ptr Ax2d -> CDouble -> IO CBool

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

-- isParallel

foreign import capi unsafe "hs_gp_Ax2d.h hs_gp_Ax2d_IsParallel" rawIsParallel :: Ptr Ax2d -> Ptr Ax2d -> CDouble -> IO CBool

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

-- angle

foreign import capi unsafe "hs_gp_Ax2d.h hs_gp_Ax2d_Angle" rawAngle :: Ptr Ax2d -> Ptr Ax2d -> IO CDouble

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

-- reverse/reversed

foreign import capi unsafe "hs_gp_Ax2d.h hs_gp_Ax2d_Reverse" reverse :: Ptr Ax2d -> IO ()

foreign import capi unsafe "hs_gp_Ax2d.h hs_gp_Ax2d_Reversed" rawReversed :: Ptr Ax2d -> IO (Ptr Ax2d)

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

-- mirror/mirrored

foreign import capi unsafe "hs_gp_Ax2d.h hs_gp_Ax2d_Mirror" mirror :: Ptr Ax2d -> Ptr Ax2d -> IO ()

foreign import capi unsafe "hs_gp_Ax2d.h hs_gp_Ax2d_Mirrored" rawMirrored :: Ptr Ax2d -> Ptr Ax2d -> IO (Ptr Ax2d)

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


foreign import capi unsafe "hs_gp_Ax2d.h hs_gp_Ax2d_MirrorAboutPnt2d" mirrorAboutPnt2d :: Ptr Ax2d -> Ptr Pnt2d -> IO ()

foreign import capi unsafe "hs_gp_Ax2d.h hs_gp_Ax2d_MirroredAboutPnt2d" rawMirroredAboutPnt2d :: Ptr Ax2d -> Ptr Pnt2d -> IO (Ptr Ax2d)

mirroredAboutPnt2d :: Ptr Ax2d -> Ptr Pnt2d -> Acquire (Ptr Ax2d)
mirroredAboutPnt2d :: Ptr Ax2d -> Ptr Pnt2d -> Acquire (Ptr Ax2d)
mirroredAboutPnt2d Ptr Ax2d
axis Ptr Pnt2d
mirrorPnt = IO (Ptr Ax2d) -> (Ptr Ax2d -> IO ()) -> Acquire (Ptr Ax2d)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax2d -> Ptr Pnt2d -> IO (Ptr Ax2d)
rawMirroredAboutPnt2d Ptr Ax2d
axis Ptr Pnt2d
mirrorPnt) Ptr Ax2d -> IO ()
deleteAx2d

-- rotate/rotated 

foreign import capi unsafe "hs_gp_Ax2d.h hs_gp_Ax2d_Rotate" rawRotate :: Ptr Ax2d -> Ptr Pnt2d -> CDouble -> IO ()

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

foreign import capi unsafe "hs_gp_Ax2d.h hs_gp_Ax2d_Rotated" rawRotated :: Ptr Ax2d -> Ptr Pnt2d -> CDouble -> IO (Ptr Ax2d)

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

-- scale/scaled 

foreign import capi unsafe "hs_gp_Ax2d.h hs_gp_Ax2d_Scale" rawScale :: Ptr Ax2d -> Ptr Pnt2d -> CDouble -> IO ()

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

foreign import capi unsafe "hs_gp_Ax2d.h hs_gp_Ax2d_Scaled" rawScaled :: Ptr Ax2d -> Ptr Pnt2d -> CDouble -> IO (Ptr Ax2d)

scaled :: Ptr Ax2d -> Ptr Pnt2d -> Double -> Acquire (Ptr Ax2d)
scaled :: Ptr Ax2d -> Ptr Pnt2d -> Double -> Acquire (Ptr Ax2d)
scaled Ptr Ax2d
axis Ptr Pnt2d
origin Double
amount = IO (Ptr Ax2d) -> (Ptr Ax2d -> IO ()) -> Acquire (Ptr Ax2d)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax2d -> Ptr Pnt2d -> CDouble -> IO (Ptr Ax2d)
rawScaled Ptr Ax2d
axis Ptr Pnt2d
origin (Double -> CDouble
CDouble Double
amount)) Ptr Ax2d -> IO ()
deleteAx2d

-- transform/transformed 

foreign import capi unsafe "hs_gp_Ax2d.h hs_gp_Ax2d_Transform" transform :: Ptr Ax2d -> Ptr Trsf2d -> IO ()

foreign import capi unsafe "hs_gp_Ax2d.h hs_gp_Ax2d_Transformed" rawTransformed :: Ptr Ax2d -> Ptr Trsf2d -> IO (Ptr Ax2d)

transformed :: Ptr Ax2d -> Ptr Trsf2d -> Acquire (Ptr Ax2d)
transformed :: Ptr Ax2d -> Ptr Trsf2d -> Acquire (Ptr Ax2d)
transformed Ptr Ax2d
axis Ptr Trsf2d
trsf = IO (Ptr Ax2d) -> (Ptr Ax2d -> IO ()) -> Acquire (Ptr Ax2d)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax2d -> Ptr Trsf2d -> IO (Ptr Ax2d)
rawTransformed Ptr Ax2d
axis Ptr Trsf2d
trsf) Ptr Ax2d -> IO ()
deleteAx2d


-- translate/translated

foreign import capi unsafe "hs_gp_Ax2d.h hs_gp_Ax2d_Translate" translate :: Ptr Ax2d -> Ptr Vec2d -> IO ()

foreign import capi unsafe "hs_gp_Ax2d.h hs_gp_Ax2d_Translated" rawTranslated :: Ptr Ax2d -> Ptr Vec2d -> IO (Ptr Ax2d)

translated :: Ptr Ax2d -> Ptr Vec2d -> Acquire (Ptr Ax2d)
translated :: Ptr Ax2d -> Ptr Vec2d -> Acquire (Ptr Ax2d)
translated Ptr Ax2d
axis Ptr Vec2d
vec = IO (Ptr Ax2d) -> (Ptr Ax2d -> IO ()) -> Acquire (Ptr Ax2d)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax2d -> Ptr Vec2d -> IO (Ptr Ax2d)
rawTranslated Ptr Ax2d
axis Ptr Vec2d
vec) Ptr Ax2d -> IO ()
deleteAx2d


foreign import capi unsafe "hs_gp_Ax2d.h hs_gp_Ax2d_TranslateRelative" translateRelative :: Ptr Ax2d -> Ptr Pnt2d -> Ptr Pnt2d -> IO ()

foreign import capi unsafe "hs_gp_Ax2d.h hs_gp_Ax2d_TranslatedRelative" rawTranslatedRelative :: Ptr Ax2d -> Ptr Pnt2d -> Ptr Pnt2d -> IO (Ptr Ax2d)

translatedRelative :: Ptr Ax2d -> Ptr Pnt2d -> Ptr Pnt2d -> Acquire (Ptr Ax2d)
translatedRelative :: Ptr Ax2d -> Ptr Pnt2d -> Ptr Pnt2d -> Acquire (Ptr Ax2d)
translatedRelative Ptr Ax2d
axis Ptr Pnt2d
from Ptr Pnt2d
to = IO (Ptr Ax2d) -> (Ptr Ax2d -> IO ()) -> Acquire (Ptr Ax2d)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Ax2d -> Ptr Pnt2d -> Ptr Pnt2d -> IO (Ptr Ax2d)
rawTranslatedRelative Ptr Ax2d
axis Ptr Pnt2d
from Ptr Pnt2d
to) Ptr Ax2d -> IO ()
deleteAx2d