{-# LANGUAGE CApiFFI #-}
module OpenCascade.GP.Trsf
( Trsf
, new
, fromTrsf2d
, setMirrorAboutPnt
, setMirrorAboutAx1
, setMirrorAboutAx2
, setRotationAboutAxisAngle
, setScale
, setTranslation
, setDisplacement
, setScaleFactor
, setTranslationPart
, setValues
, isNegative
, scaleFactor
, value
, invert
, inverted
, multiply
, multiplied
, preMultiply
, power
, powered
) 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_Trsf.h hs_new_gp_Trsf" rawNew ::IO (Ptr Trsf)

new :: Acquire (Ptr Trsf)
new :: Acquire (Ptr Trsf)
new = IO (Ptr Trsf) -> (Ptr Trsf -> IO ()) -> Acquire (Ptr Trsf)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire IO (Ptr Trsf)
rawNew Ptr Trsf -> IO ()
deleteTrsf

foreign import capi unsafe "hs_gp_Trsf.h hs_new_gp_Trsf_fromTrsf2d" rawFromTrsf2d :: Ptr Trsf2d -> IO (Ptr Trsf)

fromTrsf2d :: Ptr Trsf2d -> Acquire (Ptr Trsf)
fromTrsf2d :: Ptr Trsf2d -> Acquire (Ptr Trsf)
fromTrsf2d Ptr Trsf2d
t = IO (Ptr Trsf) -> (Ptr Trsf -> IO ()) -> Acquire (Ptr Trsf)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Trsf2d -> IO (Ptr Trsf)
rawFromTrsf2d Ptr Trsf2d
t) Ptr Trsf -> IO ()
deleteTrsf

-- mirror 

foreign import capi unsafe "hs_gp_Trsf.h hs_gp_Trsf_SetMirrorAboutPnt" setMirrorAboutPnt :: Ptr Trsf -> Ptr Pnt -> IO ()

foreign import capi unsafe "hs_gp_Trsf.h hs_gp_Trsf_SetMirrorAboutAx1" setMirrorAboutAx1 :: Ptr Trsf -> Ptr Ax1 -> IO ()

foreign import capi unsafe "hs_gp_Trsf.h hs_gp_Trsf_SetMirrorAboutAx2" setMirrorAboutAx2 :: Ptr Trsf -> Ptr Ax2 -> IO ()

-- rotate

foreign import capi unsafe "hs_gp_Trsf.h hs_gp_Trsf_SetRotationAboutAxisAngle" rawSetRotationAboutAxisAngle :: Ptr Trsf -> Ptr Ax1 -> CDouble -> IO ()

setRotationAboutAxisAngle :: Ptr Trsf -> Ptr Ax1 -> Double -> IO ()
setRotationAboutAxisAngle :: Ptr Trsf -> Ptr Ax1 -> Double -> IO ()
setRotationAboutAxisAngle = (Ptr Trsf -> Ptr Ax1 -> CDouble -> IO ())
-> Ptr Trsf -> Ptr Ax1 -> Double -> IO ()
forall a b. Coercible a b => a -> b
coerce Ptr Trsf -> Ptr Ax1 -> CDouble -> IO ()
rawSetRotationAboutAxisAngle

-- scale

foreign import capi unsafe "hs_gp_Trsf.h hs_gp_Trsf_SetScale" rawSetScale :: Ptr Trsf -> Ptr Pnt -> CDouble -> IO ()

setScale :: Ptr Trsf -> Ptr Pnt -> Double -> IO ()
setScale :: Ptr Trsf -> Ptr Pnt -> Double -> IO ()
setScale = (Ptr Trsf -> Ptr Pnt -> CDouble -> IO ())
-> Ptr Trsf -> Ptr Pnt -> Double -> IO ()
forall a b. Coercible a b => a -> b
coerce Ptr Trsf -> Ptr Pnt -> CDouble -> IO ()
rawSetScale

-- translation

foreign import capi unsafe "hs_gp_Trsf.h hs_gp_Trsf_SetTranslation" setTranslation :: Ptr Trsf -> Ptr Vec -> IO ()

foreign import capi unsafe "hs_gp_Trsf.h hs_gp_Trsf_SetTranslationPart" setTranslationPart :: Ptr Trsf -> Ptr Vec -> IO ()

-- setDisplacement

foreign import capi unsafe "hs_gp_Trsf.h hs_gp_Trsf_SetDisplacement" setDisplacement :: Ptr Trsf -> Ptr Ax3 -> Ptr Ax3 -> IO ()

-- scaleFactor

foreign import capi unsafe "hs_gp_Trsf.h hs_gp_Trsf_SetScaleFactor" rawSetScaleFactor :: Ptr Trsf -> CDouble -> IO ()

setScaleFactor :: Ptr Trsf -> Double -> IO ()
setScaleFactor :: Ptr Trsf -> Double -> IO ()
setScaleFactor = (Ptr Trsf -> CDouble -> IO ()) -> Ptr Trsf -> Double -> IO ()
forall a b. Coercible a b => a -> b
coerce Ptr Trsf -> CDouble -> IO ()
rawSetScaleFactor

-- setValues

foreign import capi unsafe "hs_gp_Trsf.h hs_gp_Trsf_SetValues" rawSetValues :: Ptr Trsf -> CDouble -> CDouble-> CDouble-> CDouble-> CDouble-> CDouble-> CDouble-> CDouble-> CDouble-> CDouble-> CDouble-> CDouble -> IO ()

setValues :: Ptr Trsf -> Double -> Double-> Double-> Double-> Double-> Double-> Double-> Double-> Double-> Double-> Double-> Double -> IO ()
setValues :: Ptr Trsf
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> IO ()
setValues = (Ptr Trsf
 -> CDouble
 -> CDouble
 -> CDouble
 -> CDouble
 -> CDouble
 -> CDouble
 -> CDouble
 -> CDouble
 -> CDouble
 -> CDouble
 -> CDouble
 -> CDouble
 -> IO ())
-> Ptr Trsf
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> IO ()
forall a b. Coercible a b => a -> b
coerce Ptr Trsf
-> CDouble
-> CDouble
-> CDouble
-> CDouble
-> CDouble
-> CDouble
-> CDouble
-> CDouble
-> CDouble
-> CDouble
-> CDouble
-> CDouble
-> IO ()
rawSetValues

-- tests 

foreign import capi unsafe "hs_gp_Trsf.h hs_gp_Trsf_IsNegative" rawIsNegative :: Ptr Trsf -> IO CBool

isNegative :: Ptr Trsf -> IO Bool
isNegative :: Ptr Trsf -> IO Bool
isNegative = (CBool -> Bool) -> IO CBool -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CBool -> CBool -> Bool
forall a. Eq a => a -> a -> Bool
/= CBool
0) (IO CBool -> IO Bool)
-> (Ptr Trsf -> IO CBool) -> Ptr Trsf -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Trsf -> IO CBool
rawIsNegative

foreign import capi unsafe "hs_gp_Trsf.h hs_gp_Trsf_ScaleFactor" rawScaleFactor :: Ptr Trsf -> IO CDouble

scaleFactor :: Ptr Trsf -> IO Double
scaleFactor :: Ptr Trsf -> IO Double
scaleFactor = (Ptr Trsf -> IO CDouble) -> Ptr Trsf -> IO Double
forall a b. Coercible a b => a -> b
coerce Ptr Trsf -> IO CDouble
rawScaleFactor

foreign import capi unsafe "hs_gp_Trsf.h hs_gp_Trsf_Value" rawValue :: Ptr Trsf -> CInt -> CInt -> IO CDouble

value :: Ptr Trsf -> Int -> Int -> IO Double
value :: Ptr Trsf -> Int -> Int -> IO Double
value Ptr Trsf
t Int
row Int
col = IO CDouble -> IO Double
forall a b. Coercible a b => a -> b
coerce (IO CDouble -> IO Double) -> IO CDouble -> IO Double
forall a b. (a -> b) -> a -> b
$ Ptr Trsf -> CInt -> CInt -> IO CDouble
rawValue Ptr Trsf
t (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
row) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
col)

-- invert/inverted

foreign import capi unsafe "hs_gp_Trsf.h hs_gp_Trsf_Invert" invert :: Ptr Trsf-> IO ()

foreign import capi unsafe "hs_gp_Trsf.h hs_gp_Trsf_Inverted" rawInverted :: Ptr Trsf-> IO (Ptr Trsf)

inverted :: Ptr Trsf -> Acquire (Ptr Trsf)
inverted :: Ptr Trsf -> Acquire (Ptr Trsf)
inverted Ptr Trsf
t = IO (Ptr Trsf) -> (Ptr Trsf -> IO ()) -> Acquire (Ptr Trsf)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Trsf -> IO (Ptr Trsf)
rawInverted Ptr Trsf
t) Ptr Trsf -> IO ()
deleteTrsf

-- multiply/multiplied

foreign import capi unsafe "hs_gp_Trsf.h hs_gp_Trsf_Multiply" multiply :: Ptr Trsf -> Ptr Trsf -> IO ()

foreign import capi unsafe "hs_gp_Trsf.h hs_gp_Trsf_Multiplied" rawMultiplied :: Ptr Trsf -> Ptr Trsf -> IO (Ptr Trsf)

multiplied :: Ptr Trsf -> Ptr Trsf -> Acquire (Ptr Trsf)
multiplied :: Ptr Trsf -> Ptr Trsf -> Acquire (Ptr Trsf)
multiplied Ptr Trsf
a Ptr Trsf
b = IO (Ptr Trsf) -> (Ptr Trsf -> IO ()) -> Acquire (Ptr Trsf)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Trsf -> Ptr Trsf -> IO (Ptr Trsf)
rawMultiplied Ptr Trsf
a Ptr Trsf
b) Ptr Trsf -> IO ()
deleteTrsf

-- PreMultiply

foreign import capi unsafe "hs_gp_Trsf.h hs_gp_Trsf_PreMultiply" preMultiply :: Ptr Trsf -> Ptr Trsf -> IO ()

-- power/powered

foreign import capi unsafe "hs_gp_Trsf.h hs_gp_Trsf_Power" rawPower :: Ptr Trsf -> CInt -> IO ()

power :: Ptr Trsf -> Int -> IO ()
power :: Ptr Trsf -> Int -> IO ()
power Ptr Trsf
trsf Int
times = Ptr Trsf -> CInt -> IO ()
rawPower Ptr Trsf
trsf (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
times)

foreign import capi unsafe "hs_gp_Trsf.h hs_gp_Trsf_Powered" rawPowered :: Ptr Trsf -> CInt -> IO (Ptr Trsf)

powered :: Ptr Trsf -> Int -> Acquire (Ptr Trsf)
powered :: Ptr Trsf -> Int -> Acquire (Ptr Trsf)
powered Ptr Trsf
trsf Int
times = IO (Ptr Trsf) -> (Ptr Trsf -> IO ()) -> Acquire (Ptr Trsf)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Trsf -> CInt -> IO (Ptr Trsf)
rawPowered Ptr Trsf
trsf (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
times)) Ptr Trsf -> IO ()
deleteTrsf