{-# LANGUAGE CApiFFI #-}
module OpenCascade.TopLoc.Location
( Location
, new
, fromGPTrsf
, isIdentity
, firstPower
, nextLocation
, inverted
, multiplied
, divided
, predivided
, powered
, isEqual
, isDifferent
, clear
, toGPTrsf
) where

import OpenCascade.TopLoc.Types
import OpenCascade.TopLoc.Internal.Destructors
import OpenCascade.GP.Internal.Destructors (deleteTrsf)
import Foreign.C
import Foreign.Ptr
import Data.Acquire 
import qualified OpenCascade.GP as GP

-- new 

foreign import capi unsafe "hs_TopLoc_Location.h hs_new_TopLoc_Location" rawNew :: IO (Ptr Location)

new :: Acquire (Ptr Location)
new :: Acquire (Ptr Location)
new = IO (Ptr Location)
-> (Ptr Location -> IO ()) -> Acquire (Ptr Location)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire IO (Ptr Location)
rawNew Ptr Location -> IO ()
deleteLocation

-- from GP.Trsf

foreign import capi unsafe "hs_TopLoc_Location.h hs_new_TopLoc_Location_fromGPTrsf" rawFromGPTrsf :: Ptr GP.Trsf -> IO (Ptr Location)

fromGPTrsf :: Ptr (GP.Trsf) -> Acquire (Ptr Location)
fromGPTrsf :: Ptr Trsf -> Acquire (Ptr Location)
fromGPTrsf Ptr Trsf
t = IO (Ptr Location)
-> (Ptr Location -> IO ()) -> Acquire (Ptr Location)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Trsf -> IO (Ptr Location)
rawFromGPTrsf Ptr Trsf
t) Ptr Location -> IO ()
deleteLocation

-- isIdentity

foreign import capi unsafe "hs_TopLoc_Location.h hs_TopLoc_Location_IsIdentity" rawIsIdentity :: Ptr Location -> IO (CBool)

isIdentity :: Ptr Location -> IO Bool
isIdentity :: Ptr Location -> IO Bool
isIdentity Ptr Location
l = (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 Location -> IO CBool
rawIsIdentity Ptr Location
l

-- firstPower 
--
foreign import capi unsafe "hs_TopLoc_Location.h hs_TopLoc_Location_FirstPower" rawFirstPower :: Ptr Location -> IO (CInt)

firstPower :: Ptr Location -> IO Int
firstPower :: Ptr Location -> IO Int
firstPower Ptr Location
l = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Location -> IO CInt
rawFirstPower Ptr Location
l 

-- nextLocation

foreign import capi unsafe "hs_TopLoc_Location.h hs_TopLoc_Location_NextLocation" rawNextLocation :: Ptr Location -> IO (Ptr Location)

nextLocation :: Ptr Location -> Acquire (Ptr Location)
nextLocation :: Ptr Location -> Acquire (Ptr Location)
nextLocation Ptr Location
l = IO (Ptr Location)
-> (Ptr Location -> IO ()) -> Acquire (Ptr Location)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Location -> IO (Ptr Location)
rawNextLocation Ptr Location
l) Ptr Location -> IO ()
deleteLocation

-- inverted

foreign import capi unsafe "hs_TopLoc_Location.h hs_TopLoc_Location_Inverted" rawInverted :: Ptr Location -> IO (Ptr Location)

inverted :: Ptr Location -> Acquire (Ptr Location)
inverted :: Ptr Location -> Acquire (Ptr Location)
inverted Ptr Location
l = IO (Ptr Location)
-> (Ptr Location -> IO ()) -> Acquire (Ptr Location)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Location -> IO (Ptr Location)
rawInverted Ptr Location
l) Ptr Location -> IO ()
deleteLocation

-- multiplied

foreign import capi unsafe "hs_TopLoc_Location.h hs_TopLoc_Location_Multiplied" rawMultiplied :: Ptr Location -> Ptr Location -> IO (Ptr Location)

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


-- divided

foreign import capi unsafe "hs_TopLoc_Location.h hs_TopLoc_Location_Divided" rawDivided :: Ptr Location -> Ptr Location -> IO (Ptr Location)

divided :: Ptr Location -> Ptr Location -> Acquire (Ptr Location)
divided :: Ptr Location -> Ptr Location -> Acquire (Ptr Location)
divided Ptr Location
a Ptr Location
b = IO (Ptr Location)
-> (Ptr Location -> IO ()) -> Acquire (Ptr Location)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Location -> Ptr Location -> IO (Ptr Location)
rawDivided Ptr Location
a Ptr Location
b) Ptr Location -> IO ()
deleteLocation


-- predivided

foreign import capi unsafe "hs_TopLoc_Location.h hs_TopLoc_Location_Predivided" rawPredivided :: Ptr Location -> Ptr Location -> IO (Ptr Location)

predivided :: Ptr Location -> Ptr Location -> Acquire (Ptr Location)
predivided :: Ptr Location -> Ptr Location -> Acquire (Ptr Location)
predivided Ptr Location
a Ptr Location
b = IO (Ptr Location)
-> (Ptr Location -> IO ()) -> Acquire (Ptr Location)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Location -> Ptr Location -> IO (Ptr Location)
rawPredivided Ptr Location
a Ptr Location
b) Ptr Location -> IO ()
deleteLocation

-- powered

foreign import capi unsafe "hs_TopLoc_Location.h hs_TopLoc_Location_Powered" rawPowered :: Ptr Location -> CInt -> IO (Ptr Location)

powered :: Ptr Location -> Int -> Acquire (Ptr Location)
powered :: Ptr Location -> Int -> Acquire (Ptr Location)
powered Ptr Location
l Int
p = IO (Ptr Location)
-> (Ptr Location -> IO ()) -> Acquire (Ptr Location)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Location -> CInt -> IO (Ptr Location)
rawPowered Ptr Location
l (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
p)) Ptr Location -> IO ()
deleteLocation

-- isEqual

foreign import capi unsafe "hs_TopLoc_Location.h hs_TopLoc_Location_IsEqual" rawIsEqual :: Ptr Location -> Ptr Location -> IO (CBool)

isEqual :: Ptr Location -> Ptr Location -> IO Bool
isEqual :: Ptr Location -> Ptr Location -> IO Bool
isEqual Ptr Location
a Ptr Location
b = (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 Location -> Ptr Location -> IO CBool
rawIsEqual Ptr Location
a Ptr Location
b


-- isDifferent

foreign import capi unsafe "hs_TopLoc_Location.h hs_TopLoc_Location_IsDifferent" rawIsDifferent :: Ptr Location -> Ptr Location -> IO (CBool)

isDifferent :: Ptr Location -> Ptr Location -> IO Bool
isDifferent :: Ptr Location -> Ptr Location -> IO Bool
isDifferent Ptr Location
a Ptr Location
b = (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 Location -> Ptr Location -> IO CBool
rawIsDifferent Ptr Location
a Ptr Location
b


-- clear

foreign import capi unsafe "hs_TopLoc_Location.h hs_TopLoc_Location_Clear" clear :: Ptr Location -> IO ()

-- toGPTrsf
--

foreign import capi unsafe "hs_TopLoc_Location.h hs_TopLoc_Location_toGPTrsf" rawToGPTrsf :: Ptr Location -> IO (Ptr GP.Trsf)

toGPTrsf :: Ptr Location -> Acquire (Ptr GP.Trsf)
toGPTrsf :: Ptr Location -> Acquire (Ptr Trsf)
toGPTrsf Ptr Location
l = IO (Ptr Trsf) -> (Ptr Trsf -> IO ()) -> Acquire (Ptr Trsf)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Ptr Location -> IO (Ptr Trsf)
rawToGPTrsf Ptr Location
l) Ptr Trsf -> IO ()
deleteTrsf