{-# LANGUAGE CApiFFI #-}
module OpenCascade.GP.Pnt 
( Pnt
, new
, getX
, getY
, getZ 
, setX
, setY 
, setZ
, distance
, squareDistance
, baryCenter
, isEqual
, mirror
, mirrored
, mirrorAboutAx1
, mirroredAboutAx1
, mirrorAboutAx2
, mirroredAboutAx2
, rotate
, rotated
, scale
, scaled
, transform
, transformed
, translate
, translated
, translateRelative
, translatedRelative
) where

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_Pnt.h hs_new_gp_Pnt" rawNew :: CDouble -> CDouble -> CDouble -> IO (Ptr Pnt)

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

-- getters

foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_X" rawX :: Ptr Pnt -> IO (CDouble)

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

foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_Y" rawY :: Ptr Pnt -> IO (CDouble)

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

foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_Z" rawZ :: Ptr Pnt -> IO (CDouble)

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

-- setters

foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_SetX" rawSetX :: Ptr Pnt -> CDouble -> IO ()

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


foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_SetY" rawSetY :: Ptr Pnt -> CDouble -> IO ()

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


foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_SetZ" rawSetZ :: Ptr Pnt -> CDouble -> IO ()

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


foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_Distance" rawDistance :: Ptr Pnt -> Ptr Pnt -> IO CDouble


-- distance and quadrance

distance :: Ptr Pnt -> Ptr Pnt -> IO Double
distance :: Ptr Pnt -> Ptr Pnt -> IO Double
distance = (Ptr Pnt -> Ptr Pnt -> IO CDouble)
-> Ptr Pnt -> Ptr Pnt -> IO Double
forall a b. Coercible a b => a -> b
coerce Ptr Pnt -> Ptr Pnt -> IO CDouble
rawDistance


foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_SquareDistance" rawSquareDistance :: Ptr Pnt -> Ptr Pnt -> IO CDouble

squareDistance :: Ptr Pnt -> Ptr Pnt -> IO Double
squareDistance :: Ptr Pnt -> Ptr Pnt -> IO Double
squareDistance = (Ptr Pnt -> Ptr Pnt -> IO CDouble)
-> Ptr Pnt -> Ptr Pnt -> IO Double
forall a b. Coercible a b => a -> b
coerce Ptr Pnt -> Ptr Pnt -> IO CDouble
rawSquareDistance

-- baryCenter

foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_BaryCenter" rawBaryCenter :: Ptr Pnt -> CDouble -> Ptr Pnt -> CDouble -> IO ()

baryCenter :: Ptr Pnt -> Double -> Ptr Pnt -> Double -> IO ()
baryCenter :: Ptr Pnt -> Double -> Ptr Pnt -> Double -> IO ()
baryCenter = (Ptr Pnt -> CDouble -> Ptr Pnt -> CDouble -> IO ())
-> Ptr Pnt -> Double -> Ptr Pnt -> Double -> IO ()
forall a b. Coercible a b => a -> b
coerce Ptr Pnt -> CDouble -> Ptr Pnt -> CDouble -> IO ()
rawBaryCenter

-- isEqual

foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_IsEqual" rawIsEqual :: Ptr Pnt -> Ptr Pnt -> CDouble -> IO CBool

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

-- mirror/mirrored

foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_Mirror" mirror :: Ptr Pnt -> Ptr Pnt -> IO ()

foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_Mirrored" rawMirrored :: Ptr Pnt -> Ptr Pnt -> IO (Ptr Pnt)

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

foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_MirrorAboutAx1" mirrorAboutAx1 :: Ptr Pnt -> Ptr Ax1 -> IO ()

foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_MirroredAboutAx1" rawMirroredAboutAx1 :: Ptr Pnt -> Ptr Ax1 -> IO (Ptr Pnt)

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

foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_MirrorAboutAx2" mirrorAboutAx2 :: Ptr Pnt -> Ptr Ax2 -> IO ()

foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_MirroredAboutAx2" rawMirroredAboutAx2 :: Ptr Pnt -> Ptr Ax2 -> IO (Ptr Pnt)

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

-- rotate/rotated

foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_Rotate" rotate :: Ptr Pnt -> Ptr Ax1 -> CDouble-> IO ()

foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_Rotated" rawRotated :: Ptr Pnt -> Ptr Ax1 -> CDouble -> IO (Ptr Pnt)

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

-- scale/scaled

foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_Scale" scale :: Ptr Pnt -> Ptr Pnt -> CDouble-> IO ()

foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_Scaled" rawScaled :: Ptr Pnt -> Ptr Pnt -> CDouble -> IO (Ptr Pnt)

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

-- transform/transformed

foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_Transform" transform :: Ptr Pnt -> Ptr Trsf -> IO ()

foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_Transformed" rawTransformed :: Ptr Pnt -> Ptr Trsf -> IO (Ptr Pnt)

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

-- translate/translated

foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_Translate" translate :: Ptr Pnt -> Ptr Vec -> IO ()

foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_Translated" rawTranslated :: Ptr Pnt -> Ptr Vec -> IO (Ptr Pnt)

translated :: Ptr Pnt -> Ptr Vec -> Acquire (Ptr Pnt)
translated :: Ptr Pnt -> Ptr Vec -> Acquire (Ptr Pnt)
translated Ptr Pnt
point Ptr Vec
vec = IO (Ptr Pnt) -> (Ptr Pnt -> IO ()) -> Acquire (Ptr Pnt)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Pnt -> Ptr Vec -> IO (Ptr Pnt)
rawTranslated Ptr Pnt
point Ptr Vec
vec) Ptr Pnt -> IO ()
deletePnt

-- translateRelative/translatedRelative

foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_TranslateRelative" translateRelative :: Ptr Pnt -> Ptr Pnt -> Ptr Pnt -> IO ()

foreign import capi unsafe "hs_gp_Pnt.h hs_gp_Pnt_TranslatedRelative" rawTranslatedRelative :: Ptr Pnt -> Ptr Pnt -> Ptr Pnt -> IO (Ptr Pnt)

translatedRelative :: Ptr Pnt -> Ptr Pnt -> Ptr Pnt -> Acquire (Ptr Pnt)
translatedRelative :: Ptr Pnt -> Ptr Pnt -> Ptr Pnt -> Acquire (Ptr Pnt)
translatedRelative Ptr Pnt
point Ptr Pnt
from Ptr Pnt
to = IO (Ptr Pnt) -> (Ptr Pnt -> IO ()) -> Acquire (Ptr Pnt)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Pnt -> Ptr Pnt -> Ptr Pnt -> IO (Ptr Pnt)
rawTranslatedRelative Ptr Pnt
point Ptr Pnt
from Ptr Pnt
to) Ptr Pnt -> IO ()
deletePnt