{-# LANGUAGE CApiFFI #-}
module OpenCascade.GP.Vec
( Vec
, new
, getX
, getY
, getZ 
, setX
, setY 
, setZ
, isEqual
, isOpposite
, isNormal
, isParallel
, angle
, angleWithRef
, magnitude
, squareMagnitude
, add
, added
, subtract
, subtracted
, multiply
, multiplied
, divide
, divided
, cross
, crossed
, crossCross
, crossCrossed
, crossMagnitude
, crossSquareMagnitude
, dot
, dotCross
, reverse
, reversed
, mirror
, mirrored
, mirrorAboutAx1
, mirroredAboutAx1
, mirrorAboutAx2
, mirroredAboutAx2
, rotate
, rotated
, scale
, scaled
, transform
, transformed
) where


import Prelude hiding (reverse, subtract)
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_Vec.h hs_new_gp_Vec" rawNew :: CDouble -> CDouble -> CDouble -> IO (Ptr Vec)

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

-- getters

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_X" rawX :: Ptr Vec -> IO (CDouble)

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

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_Y" rawY :: Ptr Vec -> IO (CDouble)

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

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_Z" rawZ :: Ptr Vec -> IO (CDouble)

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

-- setters

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_SetX" rawSetX :: Ptr Vec -> CDouble -> IO ()

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


foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_SetY" rawSetY :: Ptr Vec -> CDouble -> IO ()

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


foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_SetZ" rawSetZ :: Ptr Vec -> CDouble -> IO ()

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

-- tests

-- isEqual

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_IsEqual" rawIsEqual :: Ptr Vec -> Ptr Vec -> CDouble -> CDouble -> IO CBool

isEqual :: Ptr Vec -> Ptr Vec -> Double -> Double -> IO Bool
isEqual :: Ptr Vec -> Ptr Vec -> Double -> Double -> IO Bool
isEqual Ptr Vec
a Ptr Vec
b Double
linearTolerance 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 Vec -> Ptr Vec -> CDouble -> CDouble -> IO CBool
rawIsEqual Ptr Vec
a Ptr Vec
b (Double -> CDouble
CDouble Double
linearTolerance) (Double -> CDouble
CDouble Double
angularTolerance)

-- isNormal

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_IsNormal" rawIsNormal :: Ptr Vec -> Ptr Vec -> CDouble -> IO CBool

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

-- isOpposite

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_IsOpposite" rawIsOpposite :: Ptr Vec -> Ptr Vec -> CDouble -> IO CBool

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

-- isParallel

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_IsParallel" rawIsParallel :: Ptr Vec -> Ptr Vec -> CDouble -> IO CBool

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

-- angle

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_Angle" rawAngle :: Ptr Vec -> Ptr Vec -> IO CDouble

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

-- angleWithRef

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_AngleWithRef" rawAngleWithRef :: Ptr Vec -> Ptr Vec -> Ptr Vec -> IO CDouble

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


-- magnitude

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_Magnitude" rawMagnitude :: Ptr Vec -> IO CDouble

magnitude :: Ptr Vec -> IO Double
magnitude :: Ptr Vec -> IO Double
magnitude = (Ptr Vec -> IO CDouble) -> Ptr Vec -> IO Double
forall a b. Coercible a b => a -> b
coerce Ptr Vec -> IO CDouble
rawMagnitude


-- squareMagnitude

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_SquareMagnitude" rawSquareMagnitude :: Ptr Vec -> IO CDouble

squareMagnitude :: Ptr Vec -> IO Double
squareMagnitude :: Ptr Vec -> IO Double
squareMagnitude = (Ptr Vec -> IO CDouble) -> Ptr Vec -> IO Double
forall a b. Coercible a b => a -> b
coerce Ptr Vec -> IO CDouble
rawSquareMagnitude

-- add/added

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_Add" add :: Ptr Vec -> Ptr Vec -> IO ()

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_Added" rawAdded :: Ptr Vec -> Ptr Vec -> IO (Ptr Vec)

added :: Ptr Vec -> Ptr Vec -> Acquire (Ptr Vec)
added :: Ptr Vec -> Ptr Vec -> Acquire (Ptr Vec)
added Ptr Vec
a Ptr Vec
b = IO (Ptr Vec) -> (Ptr Vec -> IO ()) -> Acquire (Ptr Vec)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Vec -> Ptr Vec -> IO (Ptr Vec)
rawAdded Ptr Vec
a Ptr Vec
b) Ptr Vec -> IO ()
deleteVec


-- subtract/subtracted

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_Subtract" subtract :: Ptr Vec -> Ptr Vec -> IO ()

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_Subtracted" rawSubtracted :: Ptr Vec -> Ptr Vec -> IO (Ptr Vec)

subtracted :: Ptr Vec -> Ptr Vec -> Acquire (Ptr Vec)
subtracted :: Ptr Vec -> Ptr Vec -> Acquire (Ptr Vec)
subtracted Ptr Vec
a Ptr Vec
b = IO (Ptr Vec) -> (Ptr Vec -> IO ()) -> Acquire (Ptr Vec)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Vec -> Ptr Vec -> IO (Ptr Vec)
rawSubtracted Ptr Vec
a Ptr Vec
b) Ptr Vec -> IO ()
deleteVec


-- multiply/multiplied

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_Multiply" rawMultiply :: Ptr Vec -> CDouble -> IO ()

multiply :: Ptr Vec -> Double -> IO ()
multiply :: Ptr Vec -> Double -> IO ()
multiply = (Ptr Vec -> CDouble -> IO ()) -> Ptr Vec -> Double -> IO ()
forall a b. Coercible a b => a -> b
coerce Ptr Vec -> CDouble -> IO ()
rawMultiply

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_Multiplied" rawMultiplied :: Ptr Vec -> CDouble -> IO (Ptr Vec)

multiplied :: Ptr Vec -> Double -> Acquire (Ptr Vec)
multiplied :: Ptr Vec -> Double -> Acquire (Ptr Vec)
multiplied Ptr Vec
a Double
b = IO (Ptr Vec) -> (Ptr Vec -> IO ()) -> Acquire (Ptr Vec)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Vec -> CDouble -> IO (Ptr Vec)
rawMultiplied Ptr Vec
a (Double -> CDouble
CDouble Double
b)) Ptr Vec -> IO ()
deleteVec

-- divide/divided

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_Divide" rawDivide :: Ptr Vec -> CDouble -> IO ()

divide :: Ptr Vec -> Double -> IO ()
divide :: Ptr Vec -> Double -> IO ()
divide = (Ptr Vec -> CDouble -> IO ()) -> Ptr Vec -> Double -> IO ()
forall a b. Coercible a b => a -> b
coerce Ptr Vec -> CDouble -> IO ()
rawDivide

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_Divided" rawDivided :: Ptr Vec -> CDouble -> IO (Ptr Vec)

divided :: Ptr Vec -> Double -> Acquire (Ptr Vec)
divided :: Ptr Vec -> Double -> Acquire (Ptr Vec)
divided Ptr Vec
a Double
b = IO (Ptr Vec) -> (Ptr Vec -> IO ()) -> Acquire (Ptr Vec)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Vec -> CDouble -> IO (Ptr Vec)
rawDivided Ptr Vec
a (Double -> CDouble
CDouble Double
b)) Ptr Vec -> IO ()
deleteVec

-- cross/crossed

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_Cross" cross :: Ptr Vec -> Ptr Vec -> IO ()

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_Crossed" rawCrossed :: Ptr Vec -> Ptr Vec -> IO (Ptr Vec)

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

-- crossCross/crossCrossed

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_CrossCross" crossCross :: Ptr Vec -> Ptr Vec -> Ptr Vec -> IO ()

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_CrossCrossed" rawCrossCrossed :: Ptr Vec -> Ptr Vec -> Ptr Vec -> IO (Ptr Vec)

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

-- crossMagnitude

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_CrossMagnitude" rawCrossMagnitude :: Ptr Vec -> Ptr Vec -> IO CDouble

crossMagnitude :: Ptr Vec -> Ptr Vec -> IO Double
crossMagnitude :: Ptr Vec -> Ptr Vec -> IO Double
crossMagnitude = (Ptr Vec -> Ptr Vec -> IO CDouble)
-> Ptr Vec -> Ptr Vec -> IO Double
forall a b. Coercible a b => a -> b
coerce Ptr Vec -> Ptr Vec -> IO CDouble
rawCrossMagnitude

-- crossSquareMagnitude

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_CrossSquareMagnitude" rawCrossSquareMagnitude :: Ptr Vec -> Ptr Vec -> IO CDouble

crossSquareMagnitude :: Ptr Vec -> Ptr Vec -> IO Double
crossSquareMagnitude :: Ptr Vec -> Ptr Vec -> IO Double
crossSquareMagnitude = (Ptr Vec -> Ptr Vec -> IO CDouble)
-> Ptr Vec -> Ptr Vec -> IO Double
forall a b. Coercible a b => a -> b
coerce Ptr Vec -> Ptr Vec -> IO CDouble
rawCrossSquareMagnitude

-- dot

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_Dot" rawDot :: Ptr Vec -> Ptr Vec -> IO CDouble

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


-- dotCross

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_DotCross" rawDotCross :: Ptr Vec -> Ptr Vec -> Ptr Vec -> IO CDouble

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


-- reverse/reversed

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_Reverse" reverse :: Ptr Vec -> IO ()

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_Reversed" rawReversed :: Ptr Vec -> IO (Ptr Vec)

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

-- mirror/mirrored

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_Mirror" mirror :: Ptr Vec -> Ptr Vec -> IO ()

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_Mirrored" rawMirrored :: Ptr Vec -> Ptr Vec -> IO (Ptr Vec)

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

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_MirrorAboutAx1" mirrorAboutAx1 :: Ptr Vec -> Ptr Ax1 -> IO ()

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_MirroredAboutAx1" rawMirroredAboutAx1 :: Ptr Vec -> Ptr Ax1 -> IO (Ptr Vec)

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

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_MirrorAboutAx2" mirrorAboutAx2 :: Ptr Vec -> Ptr Ax2 -> IO ()

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_MirroredAboutAx2" rawMirroredAboutAx2 :: Ptr Vec -> Ptr Ax2 -> IO (Ptr Vec)

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

-- rotate/rotated

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_Rotate" rotate :: Ptr Vec -> Ptr Ax1 -> CDouble-> IO ()

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_Rotated" rawRotated :: Ptr Vec -> Ptr Ax1 -> CDouble -> IO (Ptr Vec)

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

-- scale/scaled

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_Scale" rawScale :: Ptr Vec -> CDouble -> IO ()

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

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_Scaled" rawScaled :: Ptr Vec -> CDouble -> IO (Ptr Vec)

scaled :: Ptr Vec -> Double -> Acquire (Ptr Vec)
scaled :: Ptr Vec -> Double -> Acquire (Ptr Vec)
scaled Ptr Vec
a Double
b = IO (Ptr Vec) -> (Ptr Vec -> IO ()) -> Acquire (Ptr Vec)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Vec -> CDouble -> IO (Ptr Vec)
rawScaled Ptr Vec
a (Double -> CDouble
CDouble Double
b)) Ptr Vec -> IO ()
deleteVec


-- transform/transformed

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_Transform" transform :: Ptr Vec -> Ptr Trsf -> IO ()

foreign import capi unsafe "hs_gp_Vec.h hs_gp_Vec_Transformed" rawTransformed :: Ptr Vec -> Ptr Trsf -> IO (Ptr Vec)

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