{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A point with three components: X, Y, and Z.
-- 
-- /Since: 1.0/

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.Graphene.Structs.Point3D
    ( 

-- * Exported types
    Point3D(..)                             ,
    newZeroPoint3D                          ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolvePoint3DMethod                    ,
#endif


-- ** alloc #method:alloc#

    point3DAlloc                            ,


-- ** cross #method:cross#

#if defined(ENABLE_OVERLOADING)
    Point3DCrossMethodInfo                  ,
#endif
    point3DCross                            ,


-- ** distance #method:distance#

#if defined(ENABLE_OVERLOADING)
    Point3DDistanceMethodInfo               ,
#endif
    point3DDistance                         ,


-- ** dot #method:dot#

#if defined(ENABLE_OVERLOADING)
    Point3DDotMethodInfo                    ,
#endif
    point3DDot                              ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    Point3DEqualMethodInfo                  ,
#endif
    point3DEqual                            ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    Point3DFreeMethodInfo                   ,
#endif
    point3DFree                             ,


-- ** init #method:init#

#if defined(ENABLE_OVERLOADING)
    Point3DInitMethodInfo                   ,
#endif
    point3DInit                             ,


-- ** initFromPoint #method:initFromPoint#

#if defined(ENABLE_OVERLOADING)
    Point3DInitFromPointMethodInfo          ,
#endif
    point3DInitFromPoint                    ,


-- ** initFromVec3 #method:initFromVec3#

#if defined(ENABLE_OVERLOADING)
    Point3DInitFromVec3MethodInfo           ,
#endif
    point3DInitFromVec3                     ,


-- ** interpolate #method:interpolate#

#if defined(ENABLE_OVERLOADING)
    Point3DInterpolateMethodInfo            ,
#endif
    point3DInterpolate                      ,


-- ** length #method:length#

#if defined(ENABLE_OVERLOADING)
    Point3DLengthMethodInfo                 ,
#endif
    point3DLength                           ,


-- ** near #method:near#

#if defined(ENABLE_OVERLOADING)
    Point3DNearMethodInfo                   ,
#endif
    point3DNear                             ,


-- ** normalize #method:normalize#

#if defined(ENABLE_OVERLOADING)
    Point3DNormalizeMethodInfo              ,
#endif
    point3DNormalize                        ,


-- ** normalizeViewport #method:normalizeViewport#

#if defined(ENABLE_OVERLOADING)
    Point3DNormalizeViewportMethodInfo      ,
#endif
    point3DNormalizeViewport                ,


-- ** scale #method:scale#

#if defined(ENABLE_OVERLOADING)
    Point3DScaleMethodInfo                  ,
#endif
    point3DScale                            ,


-- ** toVec3 #method:toVec3#

#if defined(ENABLE_OVERLOADING)
    Point3DToVec3MethodInfo                 ,
#endif
    point3DToVec3                           ,


-- ** zero #method:zero#

    point3DZero                             ,




 -- * Properties
-- ** x #attr:x#
-- | the X coordinate

    getPoint3DX                             ,
#if defined(ENABLE_OVERLOADING)
    point3D_x                               ,
#endif
    setPoint3DX                             ,


-- ** y #attr:y#
-- | the Y coordinate

    getPoint3DY                             ,
#if defined(ENABLE_OVERLOADING)
    point3D_y                               ,
#endif
    setPoint3DY                             ,


-- ** z #attr:z#
-- | the Z coordinate

    getPoint3DZ                             ,
#if defined(ENABLE_OVERLOADING)
    point3D_z                               ,
#endif
    setPoint3DZ                             ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import {-# SOURCE #-} qualified GI.Graphene.Structs.Rect as Graphene.Rect
import {-# SOURCE #-} qualified GI.Graphene.Structs.Vec3 as Graphene.Vec3

-- | Memory-managed wrapper type.
newtype Point3D = Point3D (SP.ManagedPtr Point3D)
    deriving (Point3D -> Point3D -> Bool
(Point3D -> Point3D -> Bool)
-> (Point3D -> Point3D -> Bool) -> Eq Point3D
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Point3D -> Point3D -> Bool
$c/= :: Point3D -> Point3D -> Bool
== :: Point3D -> Point3D -> Bool
$c== :: Point3D -> Point3D -> Bool
Eq)

instance SP.ManagedPtrNewtype Point3D where
    toManagedPtr :: Point3D -> ManagedPtr Point3D
toManagedPtr (Point3D ManagedPtr Point3D
p) = ManagedPtr Point3D
p

foreign import ccall "graphene_point3d_get_type" c_graphene_point3d_get_type :: 
    IO GType

type instance O.ParentTypes Point3D = '[]
instance O.HasParentTypes Point3D

instance B.Types.TypedObject Point3D where
    glibType :: IO GType
glibType = IO GType
c_graphene_point3d_get_type

instance B.Types.GBoxed Point3D

-- | Convert 'Point3D' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Point3D where
    toGValue :: Point3D -> IO GValue
toGValue Point3D
o = do
        GType
gtype <- IO GType
c_graphene_point3d_get_type
        Point3D -> (Ptr Point3D -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Point3D
o (GType
-> (GValue -> Ptr Point3D -> IO ()) -> Ptr Point3D -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Point3D -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO Point3D
fromGValue GValue
gv = do
        Ptr Point3D
ptr <- GValue -> IO (Ptr Point3D)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr Point3D)
        (ManagedPtr Point3D -> Point3D) -> Ptr Point3D -> IO Point3D
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Point3D -> Point3D
Point3D Ptr Point3D
ptr
        
    

-- | Construct a `Point3D` struct initialized to zero.
newZeroPoint3D :: MonadIO m => m Point3D
newZeroPoint3D :: m Point3D
newZeroPoint3D = IO Point3D -> m Point3D
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Point3D -> m Point3D) -> IO Point3D -> m Point3D
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr Point3D)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
12 IO (Ptr Point3D) -> (Ptr Point3D -> IO Point3D) -> IO Point3D
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Point3D -> Point3D) -> Ptr Point3D -> IO Point3D
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Point3D -> Point3D
Point3D

instance tag ~ 'AttrSet => Constructible Point3D tag where
    new :: (ManagedPtr Point3D -> Point3D)
-> [AttrOp Point3D tag] -> m Point3D
new ManagedPtr Point3D -> Point3D
_ [AttrOp Point3D tag]
attrs = do
        Point3D
o <- m Point3D
forall (m :: * -> *). MonadIO m => m Point3D
newZeroPoint3D
        Point3D -> [AttrOp Point3D 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set Point3D
o [AttrOp Point3D tag]
[AttrOp Point3D 'AttrSet]
attrs
        Point3D -> m Point3D
forall (m :: * -> *) a. Monad m => a -> m a
return Point3D
o


-- | Get the value of the “@x@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' point3D #x
-- @
getPoint3DX :: MonadIO m => Point3D -> m Float
getPoint3DX :: Point3D -> m Float
getPoint3DX Point3D
s = IO Float -> m Float
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ Point3D -> (Ptr Point3D -> IO Float) -> IO Float
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Point3D
s ((Ptr Point3D -> IO Float) -> IO Float)
-> (Ptr Point3D -> IO Float) -> IO Float
forall a b. (a -> b) -> a -> b
$ \Ptr Point3D
ptr -> do
    CFloat
val <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek (Ptr Point3D
ptr Ptr Point3D -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO CFloat
    let val' :: Float
val' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
val
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
val'

-- | Set the value of the “@x@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' point3D [ #x 'Data.GI.Base.Attributes.:=' value ]
-- @
setPoint3DX :: MonadIO m => Point3D -> Float -> m ()
setPoint3DX :: Point3D -> Float -> m ()
setPoint3DX Point3D
s Float
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Point3D -> (Ptr Point3D -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Point3D
s ((Ptr Point3D -> IO ()) -> IO ())
-> (Ptr Point3D -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Point3D
ptr -> do
    let val' :: CFloat
val' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
val
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Point3D
ptr Ptr Point3D -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CFloat
val' :: CFloat)

#if defined(ENABLE_OVERLOADING)
data Point3DXFieldInfo
instance AttrInfo Point3DXFieldInfo where
    type AttrBaseTypeConstraint Point3DXFieldInfo = (~) Point3D
    type AttrAllowedOps Point3DXFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint Point3DXFieldInfo = (~) Float
    type AttrTransferTypeConstraint Point3DXFieldInfo = (~)Float
    type AttrTransferType Point3DXFieldInfo = Float
    type AttrGetType Point3DXFieldInfo = Float
    type AttrLabel Point3DXFieldInfo = "x"
    type AttrOrigin Point3DXFieldInfo = Point3D
    attrGet = getPoint3DX
    attrSet = setPoint3DX
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

point3D_x :: AttrLabelProxy "x"
point3D_x = AttrLabelProxy

#endif


-- | Get the value of the “@y@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' point3D #y
-- @
getPoint3DY :: MonadIO m => Point3D -> m Float
getPoint3DY :: Point3D -> m Float
getPoint3DY Point3D
s = IO Float -> m Float
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ Point3D -> (Ptr Point3D -> IO Float) -> IO Float
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Point3D
s ((Ptr Point3D -> IO Float) -> IO Float)
-> (Ptr Point3D -> IO Float) -> IO Float
forall a b. (a -> b) -> a -> b
$ \Ptr Point3D
ptr -> do
    CFloat
val <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek (Ptr Point3D
ptr Ptr Point3D -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) :: IO CFloat
    let val' :: Float
val' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
val
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
val'

-- | Set the value of the “@y@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' point3D [ #y 'Data.GI.Base.Attributes.:=' value ]
-- @
setPoint3DY :: MonadIO m => Point3D -> Float -> m ()
setPoint3DY :: Point3D -> Float -> m ()
setPoint3DY Point3D
s Float
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Point3D -> (Ptr Point3D -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Point3D
s ((Ptr Point3D -> IO ()) -> IO ())
-> (Ptr Point3D -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Point3D
ptr -> do
    let val' :: CFloat
val' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
val
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Point3D
ptr Ptr Point3D -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4) (CFloat
val' :: CFloat)

#if defined(ENABLE_OVERLOADING)
data Point3DYFieldInfo
instance AttrInfo Point3DYFieldInfo where
    type AttrBaseTypeConstraint Point3DYFieldInfo = (~) Point3D
    type AttrAllowedOps Point3DYFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint Point3DYFieldInfo = (~) Float
    type AttrTransferTypeConstraint Point3DYFieldInfo = (~)Float
    type AttrTransferType Point3DYFieldInfo = Float
    type AttrGetType Point3DYFieldInfo = Float
    type AttrLabel Point3DYFieldInfo = "y"
    type AttrOrigin Point3DYFieldInfo = Point3D
    attrGet = getPoint3DY
    attrSet = setPoint3DY
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

point3D_y :: AttrLabelProxy "y"
point3D_y = AttrLabelProxy

#endif


-- | Get the value of the “@z@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' point3D #z
-- @
getPoint3DZ :: MonadIO m => Point3D -> m Float
getPoint3DZ :: Point3D -> m Float
getPoint3DZ Point3D
s = IO Float -> m Float
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ Point3D -> (Ptr Point3D -> IO Float) -> IO Float
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Point3D
s ((Ptr Point3D -> IO Float) -> IO Float)
-> (Ptr Point3D -> IO Float) -> IO Float
forall a b. (a -> b) -> a -> b
$ \Ptr Point3D
ptr -> do
    CFloat
val <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek (Ptr Point3D
ptr Ptr Point3D -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO CFloat
    let val' :: Float
val' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
val
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
val'

-- | Set the value of the “@z@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' point3D [ #z 'Data.GI.Base.Attributes.:=' value ]
-- @
setPoint3DZ :: MonadIO m => Point3D -> Float -> m ()
setPoint3DZ :: Point3D -> Float -> m ()
setPoint3DZ Point3D
s Float
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Point3D -> (Ptr Point3D -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Point3D
s ((Ptr Point3D -> IO ()) -> IO ())
-> (Ptr Point3D -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Point3D
ptr -> do
    let val' :: CFloat
val' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
val
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Point3D
ptr Ptr Point3D -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CFloat
val' :: CFloat)

#if defined(ENABLE_OVERLOADING)
data Point3DZFieldInfo
instance AttrInfo Point3DZFieldInfo where
    type AttrBaseTypeConstraint Point3DZFieldInfo = (~) Point3D
    type AttrAllowedOps Point3DZFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint Point3DZFieldInfo = (~) Float
    type AttrTransferTypeConstraint Point3DZFieldInfo = (~)Float
    type AttrTransferType Point3DZFieldInfo = Float
    type AttrGetType Point3DZFieldInfo = Float
    type AttrLabel Point3DZFieldInfo = "z"
    type AttrOrigin Point3DZFieldInfo = Point3D
    attrGet = getPoint3DZ
    attrSet = setPoint3DZ
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

point3D_z :: AttrLabelProxy "z"
point3D_z = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Point3D
type instance O.AttributeList Point3D = Point3DAttributeList
type Point3DAttributeList = ('[ '("x", Point3DXFieldInfo), '("y", Point3DYFieldInfo), '("z", Point3DZFieldInfo)] :: [(Symbol, *)])
#endif

-- method Point3D::alloc
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Graphene" , name = "Point3D" })
-- throws : False
-- Skip return : False

foreign import ccall "graphene_point3d_alloc" graphene_point3d_alloc :: 
    IO (Ptr Point3D)

-- | Allocates a t'GI.Graphene.Structs.Point3D.Point3D' structure.
-- 
-- /Since: 1.0/
point3DAlloc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Point3D
    -- ^ __Returns:__ the newly allocated structure.
    --   Use 'GI.Graphene.Structs.Point3D.point3DFree' to free the resources
    --   allocated by this function.
point3DAlloc :: m Point3D
point3DAlloc  = IO Point3D -> m Point3D
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Point3D -> m Point3D) -> IO Point3D -> m Point3D
forall a b. (a -> b) -> a -> b
$ do
    Ptr Point3D
result <- IO (Ptr Point3D)
graphene_point3d_alloc
    Text -> Ptr Point3D -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"point3DAlloc" Ptr Point3D
result
    Point3D
result' <- ((ManagedPtr Point3D -> Point3D) -> Ptr Point3D -> IO Point3D
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Point3D -> Point3D
Point3D) Ptr Point3D
result
    Point3D -> IO Point3D
forall (m :: * -> *) a. Monad m => a -> m a
return Point3D
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Point3D::cross
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "a"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_point3d_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "b"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_point3d_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the cross\n  product"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "graphene_point3d_cross" graphene_point3d_cross :: 
    Ptr Point3D ->                          -- a : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    Ptr Point3D ->                          -- b : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    Ptr Point3D ->                          -- res : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    IO ()

-- | Computes the cross product of the two given t'GI.Graphene.Structs.Point3D.Point3D'.
-- 
-- /Since: 1.0/
point3DCross ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Point3D
    -- ^ /@a@/: a t'GI.Graphene.Structs.Point3D.Point3D'
    -> Point3D
    -- ^ /@b@/: a t'GI.Graphene.Structs.Point3D.Point3D'
    -> m (Point3D)
point3DCross :: Point3D -> Point3D -> m Point3D
point3DCross Point3D
a Point3D
b = IO Point3D -> m Point3D
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Point3D -> m Point3D) -> IO Point3D -> m Point3D
forall a b. (a -> b) -> a -> b
$ do
    Ptr Point3D
a' <- Point3D -> IO (Ptr Point3D)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point3D
a
    Ptr Point3D
b' <- Point3D -> IO (Ptr Point3D)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point3D
b
    Ptr Point3D
res <- Int -> IO (Ptr Point3D)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
12 :: IO (Ptr Point3D)
    Ptr Point3D -> Ptr Point3D -> Ptr Point3D -> IO ()
graphene_point3d_cross Ptr Point3D
a' Ptr Point3D
b' Ptr Point3D
res
    Point3D
res' <- ((ManagedPtr Point3D -> Point3D) -> Ptr Point3D -> IO Point3D
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Point3D -> Point3D
Point3D) Ptr Point3D
res
    Point3D -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point3D
a
    Point3D -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point3D
b
    Point3D -> IO Point3D
forall (m :: * -> *) a. Monad m => a -> m a
return Point3D
res'

#if defined(ENABLE_OVERLOADING)
data Point3DCrossMethodInfo
instance (signature ~ (Point3D -> m (Point3D)), MonadIO m) => O.MethodInfo Point3DCrossMethodInfo Point3D signature where
    overloadedMethod = point3DCross

#endif

-- method Point3D::distance
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "a"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_point3d_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "b"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_point3d_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "delta"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec3" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the distance\n  components on the X, Y, and Z axis"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFloat)
-- throws : False
-- Skip return : False

foreign import ccall "graphene_point3d_distance" graphene_point3d_distance :: 
    Ptr Point3D ->                          -- a : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    Ptr Point3D ->                          -- b : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    Ptr Graphene.Vec3.Vec3 ->               -- delta : TInterface (Name {namespace = "Graphene", name = "Vec3"})
    IO CFloat

-- | Computes the distance between the two given t'GI.Graphene.Structs.Point3D.Point3D'.
-- 
-- /Since: 1.4/
point3DDistance ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Point3D
    -- ^ /@a@/: a t'GI.Graphene.Structs.Point3D.Point3D'
    -> Point3D
    -- ^ /@b@/: a t'GI.Graphene.Structs.Point3D.Point3D'
    -> m ((Float, Graphene.Vec3.Vec3))
    -- ^ __Returns:__ the distance between two points
point3DDistance :: Point3D -> Point3D -> m (Float, Vec3)
point3DDistance Point3D
a Point3D
b = IO (Float, Vec3) -> m (Float, Vec3)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Float, Vec3) -> m (Float, Vec3))
-> IO (Float, Vec3) -> m (Float, Vec3)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Point3D
a' <- Point3D -> IO (Ptr Point3D)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point3D
a
    Ptr Point3D
b' <- Point3D -> IO (Ptr Point3D)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point3D
b
    Ptr Vec3
delta <- Int -> IO (Ptr Vec3)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Graphene.Vec3.Vec3)
    CFloat
result <- Ptr Point3D -> Ptr Point3D -> Ptr Vec3 -> IO CFloat
graphene_point3d_distance Ptr Point3D
a' Ptr Point3D
b' Ptr Vec3
delta
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Vec3
delta' <- ((ManagedPtr Vec3 -> Vec3) -> Ptr Vec3 -> IO Vec3
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Vec3 -> Vec3
Graphene.Vec3.Vec3) Ptr Vec3
delta
    Point3D -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point3D
a
    Point3D -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point3D
b
    (Float, Vec3) -> IO (Float, Vec3)
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
result', Vec3
delta')

#if defined(ENABLE_OVERLOADING)
data Point3DDistanceMethodInfo
instance (signature ~ (Point3D -> m ((Float, Graphene.Vec3.Vec3))), MonadIO m) => O.MethodInfo Point3DDistanceMethodInfo Point3D signature where
    overloadedMethod = point3DDistance

#endif

-- method Point3D::dot
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "a"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_point3d_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "b"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_point3d_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFloat)
-- throws : False
-- Skip return : False

foreign import ccall "graphene_point3d_dot" graphene_point3d_dot :: 
    Ptr Point3D ->                          -- a : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    Ptr Point3D ->                          -- b : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    IO CFloat

-- | Computes the dot product of the two given t'GI.Graphene.Structs.Point3D.Point3D'.
-- 
-- /Since: 1.0/
point3DDot ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Point3D
    -- ^ /@a@/: a t'GI.Graphene.Structs.Point3D.Point3D'
    -> Point3D
    -- ^ /@b@/: a t'GI.Graphene.Structs.Point3D.Point3D'
    -> m Float
    -- ^ __Returns:__ the value of the dot product
point3DDot :: Point3D -> Point3D -> m Float
point3DDot Point3D
a Point3D
b = IO Float -> m Float
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr Point3D
a' <- Point3D -> IO (Ptr Point3D)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point3D
a
    Ptr Point3D
b' <- Point3D -> IO (Ptr Point3D)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point3D
b
    CFloat
result <- Ptr Point3D -> Ptr Point3D -> IO CFloat
graphene_point3d_dot Ptr Point3D
a' Ptr Point3D
b'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Point3D -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point3D
a
    Point3D -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point3D
b
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data Point3DDotMethodInfo
instance (signature ~ (Point3D -> m Float), MonadIO m) => O.MethodInfo Point3DDotMethodInfo Point3D signature where
    overloadedMethod = point3DDot

#endif

-- method Point3D::equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "a"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_point3d_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "b"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_point3d_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "graphene_point3d_equal" graphene_point3d_equal :: 
    Ptr Point3D ->                          -- a : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    Ptr Point3D ->                          -- b : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    IO CInt

-- | Checks whether two given points are equal.
-- 
-- /Since: 1.0/
point3DEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Point3D
    -- ^ /@a@/: a t'GI.Graphene.Structs.Point3D.Point3D'
    -> Point3D
    -- ^ /@b@/: a t'GI.Graphene.Structs.Point3D.Point3D'
    -> m Bool
    -- ^ __Returns:__ @true@ if the points are equal
point3DEqual :: Point3D -> Point3D -> m Bool
point3DEqual Point3D
a Point3D
b = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Point3D
a' <- Point3D -> IO (Ptr Point3D)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point3D
a
    Ptr Point3D
b' <- Point3D -> IO (Ptr Point3D)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point3D
b
    CInt
result <- Ptr Point3D -> Ptr Point3D -> IO CInt
graphene_point3d_equal Ptr Point3D
a' Ptr Point3D
b'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Point3D -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point3D
a
    Point3D -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point3D
b
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data Point3DEqualMethodInfo
instance (signature ~ (Point3D -> m Bool), MonadIO m) => O.MethodInfo Point3DEqualMethodInfo Point3D signature where
    overloadedMethod = point3DEqual

#endif

-- method Point3D::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "p"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_point3d_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "graphene_point3d_free" graphene_point3d_free :: 
    Ptr Point3D ->                          -- p : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    IO ()

-- | Frees the resources allocated via 'GI.Graphene.Structs.Point3D.point3DAlloc'.
-- 
-- /Since: 1.0/
point3DFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Point3D
    -- ^ /@p@/: a t'GI.Graphene.Structs.Point3D.Point3D'
    -> m ()
point3DFree :: Point3D -> m ()
point3DFree Point3D
p = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Point3D
p' <- Point3D -> IO (Ptr Point3D)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point3D
p
    Ptr Point3D -> IO ()
graphene_point3d_free Ptr Point3D
p'
    Point3D -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point3D
p
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data Point3DFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo Point3DFreeMethodInfo Point3D signature where
    overloadedMethod = point3DFree

#endif

-- method Point3D::init
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "p"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #graphene_point3d_t to initialize"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the X coordinate of the point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the Y coordinate of the point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "z"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the Z coordinate of the point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Graphene" , name = "Point3D" })
-- throws : False
-- Skip return : False

foreign import ccall "graphene_point3d_init" graphene_point3d_init :: 
    Ptr Point3D ->                          -- p : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    CFloat ->                               -- x : TBasicType TFloat
    CFloat ->                               -- y : TBasicType TFloat
    CFloat ->                               -- z : TBasicType TFloat
    IO (Ptr Point3D)

-- | Initializes a t'GI.Graphene.Structs.Point3D.Point3D' with the given coordinates.
-- 
-- /Since: 1.0/
point3DInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Point3D
    -- ^ /@p@/: the t'GI.Graphene.Structs.Point3D.Point3D' to initialize
    -> Float
    -- ^ /@x@/: the X coordinate of the point
    -> Float
    -- ^ /@y@/: the Y coordinate of the point
    -> Float
    -- ^ /@z@/: the Z coordinate of the point
    -> m Point3D
    -- ^ __Returns:__ the initialized t'GI.Graphene.Structs.Point3D.Point3D'
point3DInit :: Point3D -> Float -> Float -> Float -> m Point3D
point3DInit Point3D
p Float
x Float
y Float
z = IO Point3D -> m Point3D
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Point3D -> m Point3D) -> IO Point3D -> m Point3D
forall a b. (a -> b) -> a -> b
$ do
    Ptr Point3D
p' <- Point3D -> IO (Ptr Point3D)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point3D
p
    let x' :: CFloat
x' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x
    let y' :: CFloat
y' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y
    let z' :: CFloat
z' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
z
    Ptr Point3D
result <- Ptr Point3D -> CFloat -> CFloat -> CFloat -> IO (Ptr Point3D)
graphene_point3d_init Ptr Point3D
p' CFloat
x' CFloat
y' CFloat
z'
    Text -> Ptr Point3D -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"point3DInit" Ptr Point3D
result
    Point3D
result' <- ((ManagedPtr Point3D -> Point3D) -> Ptr Point3D -> IO Point3D
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Point3D -> Point3D
Point3D) Ptr Point3D
result
    Point3D -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point3D
p
    Point3D -> IO Point3D
forall (m :: * -> *) a. Monad m => a -> m a
return Point3D
result'

#if defined(ENABLE_OVERLOADING)
data Point3DInitMethodInfo
instance (signature ~ (Float -> Float -> Float -> m Point3D), MonadIO m) => O.MethodInfo Point3DInitMethodInfo Point3D signature where
    overloadedMethod = point3DInit

#endif

-- method Point3D::init_from_point
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "p"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_point3d_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_point3d_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Graphene" , name = "Point3D" })
-- throws : False
-- Skip return : False

foreign import ccall "graphene_point3d_init_from_point" graphene_point3d_init_from_point :: 
    Ptr Point3D ->                          -- p : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    Ptr Point3D ->                          -- src : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    IO (Ptr Point3D)

-- | Initializes a t'GI.Graphene.Structs.Point3D.Point3D' using the coordinates of
-- another t'GI.Graphene.Structs.Point3D.Point3D'.
-- 
-- /Since: 1.0/
point3DInitFromPoint ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Point3D
    -- ^ /@p@/: a t'GI.Graphene.Structs.Point3D.Point3D'
    -> Point3D
    -- ^ /@src@/: a t'GI.Graphene.Structs.Point3D.Point3D'
    -> m Point3D
    -- ^ __Returns:__ the initialized point
point3DInitFromPoint :: Point3D -> Point3D -> m Point3D
point3DInitFromPoint Point3D
p Point3D
src = IO Point3D -> m Point3D
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Point3D -> m Point3D) -> IO Point3D -> m Point3D
forall a b. (a -> b) -> a -> b
$ do
    Ptr Point3D
p' <- Point3D -> IO (Ptr Point3D)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point3D
p
    Ptr Point3D
src' <- Point3D -> IO (Ptr Point3D)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point3D
src
    Ptr Point3D
result <- Ptr Point3D -> Ptr Point3D -> IO (Ptr Point3D)
graphene_point3d_init_from_point Ptr Point3D
p' Ptr Point3D
src'
    Text -> Ptr Point3D -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"point3DInitFromPoint" Ptr Point3D
result
    Point3D
result' <- ((ManagedPtr Point3D -> Point3D) -> Ptr Point3D -> IO Point3D
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Point3D -> Point3D
Point3D) Ptr Point3D
result
    Point3D -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point3D
p
    Point3D -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point3D
src
    Point3D -> IO Point3D
forall (m :: * -> *) a. Monad m => a -> m a
return Point3D
result'

#if defined(ENABLE_OVERLOADING)
data Point3DInitFromPointMethodInfo
instance (signature ~ (Point3D -> m Point3D), MonadIO m) => O.MethodInfo Point3DInitFromPointMethodInfo Point3D signature where
    overloadedMethod = point3DInitFromPoint

#endif

-- method Point3D::init_from_vec3
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "p"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_point3d_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "v"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec3" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_vec3_t" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Graphene" , name = "Point3D" })
-- throws : False
-- Skip return : False

foreign import ccall "graphene_point3d_init_from_vec3" graphene_point3d_init_from_vec3 :: 
    Ptr Point3D ->                          -- p : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    Ptr Graphene.Vec3.Vec3 ->               -- v : TInterface (Name {namespace = "Graphene", name = "Vec3"})
    IO (Ptr Point3D)

-- | Initializes a t'GI.Graphene.Structs.Point3D.Point3D' using the components
-- of a t'GI.Graphene.Structs.Vec3.Vec3'.
-- 
-- /Since: 1.0/
point3DInitFromVec3 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Point3D
    -- ^ /@p@/: a t'GI.Graphene.Structs.Point3D.Point3D'
    -> Graphene.Vec3.Vec3
    -- ^ /@v@/: a t'GI.Graphene.Structs.Vec3.Vec3'
    -> m Point3D
    -- ^ __Returns:__ the initialized t'GI.Graphene.Structs.Point3D.Point3D'
point3DInitFromVec3 :: Point3D -> Vec3 -> m Point3D
point3DInitFromVec3 Point3D
p Vec3
v = IO Point3D -> m Point3D
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Point3D -> m Point3D) -> IO Point3D -> m Point3D
forall a b. (a -> b) -> a -> b
$ do
    Ptr Point3D
p' <- Point3D -> IO (Ptr Point3D)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point3D
p
    Ptr Vec3
v' <- Vec3 -> IO (Ptr Vec3)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec3
v
    Ptr Point3D
result <- Ptr Point3D -> Ptr Vec3 -> IO (Ptr Point3D)
graphene_point3d_init_from_vec3 Ptr Point3D
p' Ptr Vec3
v'
    Text -> Ptr Point3D -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"point3DInitFromVec3" Ptr Point3D
result
    Point3D
result' <- ((ManagedPtr Point3D -> Point3D) -> Ptr Point3D -> IO Point3D
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Point3D -> Point3D
Point3D) Ptr Point3D
result
    Point3D -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point3D
p
    Vec3 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec3
v
    Point3D -> IO Point3D
forall (m :: * -> *) a. Monad m => a -> m a
return Point3D
result'

#if defined(ENABLE_OVERLOADING)
data Point3DInitFromVec3MethodInfo
instance (signature ~ (Graphene.Vec3.Vec3 -> m Point3D), MonadIO m) => O.MethodInfo Point3DInitFromVec3MethodInfo Point3D signature where
    overloadedMethod = point3DInitFromVec3

#endif

-- method Point3D::interpolate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "a"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_point3d_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "b"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_point3d_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "factor"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the interpolation factor"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the return location for the\n  interpolated #graphene_point3d_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "graphene_point3d_interpolate" graphene_point3d_interpolate :: 
    Ptr Point3D ->                          -- a : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    Ptr Point3D ->                          -- b : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    CDouble ->                              -- factor : TBasicType TDouble
    Ptr Point3D ->                          -- res : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    IO ()

-- | Linearly interpolates each component of /@a@/ and /@b@/ using the
-- provided /@factor@/, and places the result in /@res@/.
-- 
-- /Since: 1.0/
point3DInterpolate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Point3D
    -- ^ /@a@/: a t'GI.Graphene.Structs.Point3D.Point3D'
    -> Point3D
    -- ^ /@b@/: a t'GI.Graphene.Structs.Point3D.Point3D'
    -> Double
    -- ^ /@factor@/: the interpolation factor
    -> m (Point3D)
point3DInterpolate :: Point3D -> Point3D -> Double -> m Point3D
point3DInterpolate Point3D
a Point3D
b Double
factor = IO Point3D -> m Point3D
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Point3D -> m Point3D) -> IO Point3D -> m Point3D
forall a b. (a -> b) -> a -> b
$ do
    Ptr Point3D
a' <- Point3D -> IO (Ptr Point3D)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point3D
a
    Ptr Point3D
b' <- Point3D -> IO (Ptr Point3D)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point3D
b
    let factor' :: CDouble
factor' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
factor
    Ptr Point3D
res <- Int -> IO (Ptr Point3D)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
12 :: IO (Ptr Point3D)
    Ptr Point3D -> Ptr Point3D -> CDouble -> Ptr Point3D -> IO ()
graphene_point3d_interpolate Ptr Point3D
a' Ptr Point3D
b' CDouble
factor' Ptr Point3D
res
    Point3D
res' <- ((ManagedPtr Point3D -> Point3D) -> Ptr Point3D -> IO Point3D
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Point3D -> Point3D
Point3D) Ptr Point3D
res
    Point3D -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point3D
a
    Point3D -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point3D
b
    Point3D -> IO Point3D
forall (m :: * -> *) a. Monad m => a -> m a
return Point3D
res'

#if defined(ENABLE_OVERLOADING)
data Point3DInterpolateMethodInfo
instance (signature ~ (Point3D -> Double -> m (Point3D)), MonadIO m) => O.MethodInfo Point3DInterpolateMethodInfo Point3D signature where
    overloadedMethod = point3DInterpolate

#endif

-- method Point3D::length
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "p"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_point3d_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFloat)
-- throws : False
-- Skip return : False

foreign import ccall "graphene_point3d_length" graphene_point3d_length :: 
    Ptr Point3D ->                          -- p : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    IO CFloat

-- | Computes the length of the vector represented by the
-- coordinates of the given t'GI.Graphene.Structs.Point3D.Point3D'.
-- 
-- /Since: 1.0/
point3DLength ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Point3D
    -- ^ /@p@/: a t'GI.Graphene.Structs.Point3D.Point3D'
    -> m Float
    -- ^ __Returns:__ the length of the vector represented by the point
point3DLength :: Point3D -> m Float
point3DLength Point3D
p = IO Float -> m Float
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr Point3D
p' <- Point3D -> IO (Ptr Point3D)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point3D
p
    CFloat
result <- Ptr Point3D -> IO CFloat
graphene_point3d_length Ptr Point3D
p'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Point3D -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point3D
p
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data Point3DLengthMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.MethodInfo Point3DLengthMethodInfo Point3D signature where
    overloadedMethod = point3DLength

#endif

-- method Point3D::near
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "a"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_point3d_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "b"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_point3d_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "epsilon"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "fuzzyness factor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "graphene_point3d_near" graphene_point3d_near :: 
    Ptr Point3D ->                          -- a : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    Ptr Point3D ->                          -- b : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    CFloat ->                               -- epsilon : TBasicType TFloat
    IO CInt

-- | Checks whether the two points are near each other, within
-- an /@epsilon@/ factor.
-- 
-- /Since: 1.0/
point3DNear ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Point3D
    -- ^ /@a@/: a t'GI.Graphene.Structs.Point3D.Point3D'
    -> Point3D
    -- ^ /@b@/: a t'GI.Graphene.Structs.Point3D.Point3D'
    -> Float
    -- ^ /@epsilon@/: fuzzyness factor
    -> m Bool
    -- ^ __Returns:__ @true@ if the points are near each other
point3DNear :: Point3D -> Point3D -> Float -> m Bool
point3DNear Point3D
a Point3D
b Float
epsilon = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Point3D
a' <- Point3D -> IO (Ptr Point3D)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point3D
a
    Ptr Point3D
b' <- Point3D -> IO (Ptr Point3D)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point3D
b
    let epsilon' :: CFloat
epsilon' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
epsilon
    CInt
result <- Ptr Point3D -> Ptr Point3D -> CFloat -> IO CInt
graphene_point3d_near Ptr Point3D
a' Ptr Point3D
b' CFloat
epsilon'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Point3D -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point3D
a
    Point3D -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point3D
b
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data Point3DNearMethodInfo
instance (signature ~ (Point3D -> Float -> m Bool), MonadIO m) => O.MethodInfo Point3DNearMethodInfo Point3D signature where
    overloadedMethod = point3DNear

#endif

-- method Point3D::normalize
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "p"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_point3d_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the normalized\n  #graphene_point3d_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "graphene_point3d_normalize" graphene_point3d_normalize :: 
    Ptr Point3D ->                          -- p : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    Ptr Point3D ->                          -- res : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    IO ()

-- | Computes the normalization of the vector represented by the
-- coordinates of the given t'GI.Graphene.Structs.Point3D.Point3D'.
-- 
-- /Since: 1.0/
point3DNormalize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Point3D
    -- ^ /@p@/: a t'GI.Graphene.Structs.Point3D.Point3D'
    -> m (Point3D)
point3DNormalize :: Point3D -> m Point3D
point3DNormalize Point3D
p = IO Point3D -> m Point3D
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Point3D -> m Point3D) -> IO Point3D -> m Point3D
forall a b. (a -> b) -> a -> b
$ do
    Ptr Point3D
p' <- Point3D -> IO (Ptr Point3D)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point3D
p
    Ptr Point3D
res <- Int -> IO (Ptr Point3D)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
12 :: IO (Ptr Point3D)
    Ptr Point3D -> Ptr Point3D -> IO ()
graphene_point3d_normalize Ptr Point3D
p' Ptr Point3D
res
    Point3D
res' <- ((ManagedPtr Point3D -> Point3D) -> Ptr Point3D -> IO Point3D
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Point3D -> Point3D
Point3D) Ptr Point3D
res
    Point3D -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point3D
p
    Point3D -> IO Point3D
forall (m :: * -> *) a. Monad m => a -> m a
return Point3D
res'

#if defined(ENABLE_OVERLOADING)
data Point3DNormalizeMethodInfo
instance (signature ~ (m (Point3D)), MonadIO m) => O.MethodInfo Point3DNormalizeMethodInfo Point3D signature where
    overloadedMethod = point3DNormalize

#endif

-- method Point3D::normalize_viewport
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "p"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_point3d_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "viewport"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_rect_t representing a viewport"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "z_near"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the coordinate of the near clipping plane, or 0 for\n  the default near clipping plane"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "z_far"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the coordinate of the far clipping plane, or 1 for the\n  default far clipping plane"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the return location for the\n  normalized #graphene_point3d_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "graphene_point3d_normalize_viewport" graphene_point3d_normalize_viewport :: 
    Ptr Point3D ->                          -- p : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    Ptr Graphene.Rect.Rect ->               -- viewport : TInterface (Name {namespace = "Graphene", name = "Rect"})
    CFloat ->                               -- z_near : TBasicType TFloat
    CFloat ->                               -- z_far : TBasicType TFloat
    Ptr Point3D ->                          -- res : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    IO ()

-- | Normalizes the coordinates of a t'GI.Graphene.Structs.Point3D.Point3D' using the
-- given viewport and clipping planes.
-- 
-- The coordinates of the resulting t'GI.Graphene.Structs.Point3D.Point3D' will be
-- in the [ -1, 1 ] range.
-- 
-- /Since: 1.4/
point3DNormalizeViewport ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Point3D
    -- ^ /@p@/: a t'GI.Graphene.Structs.Point3D.Point3D'
    -> Graphene.Rect.Rect
    -- ^ /@viewport@/: a t'GI.Graphene.Structs.Rect.Rect' representing a viewport
    -> Float
    -- ^ /@zNear@/: the coordinate of the near clipping plane, or 0 for
    --   the default near clipping plane
    -> Float
    -- ^ /@zFar@/: the coordinate of the far clipping plane, or 1 for the
    --   default far clipping plane
    -> m (Point3D)
point3DNormalizeViewport :: Point3D -> Rect -> Float -> Float -> m Point3D
point3DNormalizeViewport Point3D
p Rect
viewport Float
zNear Float
zFar = IO Point3D -> m Point3D
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Point3D -> m Point3D) -> IO Point3D -> m Point3D
forall a b. (a -> b) -> a -> b
$ do
    Ptr Point3D
p' <- Point3D -> IO (Ptr Point3D)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point3D
p
    Ptr Rect
viewport' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
viewport
    let zNear' :: CFloat
zNear' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
zNear
    let zFar' :: CFloat
zFar' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
zFar
    Ptr Point3D
res <- Int -> IO (Ptr Point3D)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
12 :: IO (Ptr Point3D)
    Ptr Point3D -> Ptr Rect -> CFloat -> CFloat -> Ptr Point3D -> IO ()
graphene_point3d_normalize_viewport Ptr Point3D
p' Ptr Rect
viewport' CFloat
zNear' CFloat
zFar' Ptr Point3D
res
    Point3D
res' <- ((ManagedPtr Point3D -> Point3D) -> Ptr Point3D -> IO Point3D
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Point3D -> Point3D
Point3D) Ptr Point3D
res
    Point3D -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point3D
p
    Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rect
viewport
    Point3D -> IO Point3D
forall (m :: * -> *) a. Monad m => a -> m a
return Point3D
res'

#if defined(ENABLE_OVERLOADING)
data Point3DNormalizeViewportMethodInfo
instance (signature ~ (Graphene.Rect.Rect -> Float -> Float -> m (Point3D)), MonadIO m) => O.MethodInfo Point3DNormalizeViewportMethodInfo Point3D signature where
    overloadedMethod = point3DNormalizeViewport

#endif

-- method Point3D::scale
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "p"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_point3d_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "factor"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the scaling factor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the scaled point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "graphene_point3d_scale" graphene_point3d_scale :: 
    Ptr Point3D ->                          -- p : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    CFloat ->                               -- factor : TBasicType TFloat
    Ptr Point3D ->                          -- res : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    IO ()

-- | Scales the coordinates of the given t'GI.Graphene.Structs.Point3D.Point3D' by
-- the given /@factor@/.
-- 
-- /Since: 1.0/
point3DScale ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Point3D
    -- ^ /@p@/: a t'GI.Graphene.Structs.Point3D.Point3D'
    -> Float
    -- ^ /@factor@/: the scaling factor
    -> m (Point3D)
point3DScale :: Point3D -> Float -> m Point3D
point3DScale Point3D
p Float
factor = IO Point3D -> m Point3D
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Point3D -> m Point3D) -> IO Point3D -> m Point3D
forall a b. (a -> b) -> a -> b
$ do
    Ptr Point3D
p' <- Point3D -> IO (Ptr Point3D)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point3D
p
    let factor' :: CFloat
factor' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
factor
    Ptr Point3D
res <- Int -> IO (Ptr Point3D)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
12 :: IO (Ptr Point3D)
    Ptr Point3D -> CFloat -> Ptr Point3D -> IO ()
graphene_point3d_scale Ptr Point3D
p' CFloat
factor' Ptr Point3D
res
    Point3D
res' <- ((ManagedPtr Point3D -> Point3D) -> Ptr Point3D -> IO Point3D
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Point3D -> Point3D
Point3D) Ptr Point3D
res
    Point3D -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point3D
p
    Point3D -> IO Point3D
forall (m :: * -> *) a. Monad m => a -> m a
return Point3D
res'

#if defined(ENABLE_OVERLOADING)
data Point3DScaleMethodInfo
instance (signature ~ (Float -> m (Point3D)), MonadIO m) => O.MethodInfo Point3DScaleMethodInfo Point3D signature where
    overloadedMethod = point3DScale

#endif

-- method Point3D::to_vec3
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "p"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Point3D" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_point3d_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "v"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec3" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for a #graphene_vec3_t"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "graphene_point3d_to_vec3" graphene_point3d_to_vec3 :: 
    Ptr Point3D ->                          -- p : TInterface (Name {namespace = "Graphene", name = "Point3D"})
    Ptr Graphene.Vec3.Vec3 ->               -- v : TInterface (Name {namespace = "Graphene", name = "Vec3"})
    IO ()

-- | Stores the coordinates of a t'GI.Graphene.Structs.Point3D.Point3D' into a
-- t'GI.Graphene.Structs.Vec3.Vec3'.
-- 
-- /Since: 1.0/
point3DToVec3 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Point3D
    -- ^ /@p@/: a t'GI.Graphene.Structs.Point3D.Point3D'
    -> m (Graphene.Vec3.Vec3)
point3DToVec3 :: Point3D -> m Vec3
point3DToVec3 Point3D
p = IO Vec3 -> m Vec3
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vec3 -> m Vec3) -> IO Vec3 -> m Vec3
forall a b. (a -> b) -> a -> b
$ do
    Ptr Point3D
p' <- Point3D -> IO (Ptr Point3D)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point3D
p
    Ptr Vec3
v <- Int -> IO (Ptr Vec3)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Graphene.Vec3.Vec3)
    Ptr Point3D -> Ptr Vec3 -> IO ()
graphene_point3d_to_vec3 Ptr Point3D
p' Ptr Vec3
v
    Vec3
v' <- ((ManagedPtr Vec3 -> Vec3) -> Ptr Vec3 -> IO Vec3
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Vec3 -> Vec3
Graphene.Vec3.Vec3) Ptr Vec3
v
    Point3D -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point3D
p
    Vec3 -> IO Vec3
forall (m :: * -> *) a. Monad m => a -> m a
return Vec3
v'

#if defined(ENABLE_OVERLOADING)
data Point3DToVec3MethodInfo
instance (signature ~ (m (Graphene.Vec3.Vec3)), MonadIO m) => O.MethodInfo Point3DToVec3MethodInfo Point3D signature where
    overloadedMethod = point3DToVec3

#endif

-- method Point3D::zero
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Graphene" , name = "Point3D" })
-- throws : False
-- Skip return : False

foreign import ccall "graphene_point3d_zero" graphene_point3d_zero :: 
    IO (Ptr Point3D)

-- | Retrieves a constant point with all three coordinates set to 0.
-- 
-- /Since: 1.0/
point3DZero ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Point3D
    -- ^ __Returns:__ a zero point
point3DZero :: m Point3D
point3DZero  = IO Point3D -> m Point3D
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Point3D -> m Point3D) -> IO Point3D -> m Point3D
forall a b. (a -> b) -> a -> b
$ do
    Ptr Point3D
result <- IO (Ptr Point3D)
graphene_point3d_zero
    Text -> Ptr Point3D -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"point3DZero" Ptr Point3D
result
    Point3D
result' <- ((ManagedPtr Point3D -> Point3D) -> Ptr Point3D -> IO Point3D
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Point3D -> Point3D
Point3D) Ptr Point3D
result
    Point3D -> IO Point3D
forall (m :: * -> *) a. Monad m => a -> m a
return Point3D
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolvePoint3DMethod (t :: Symbol) (o :: *) :: * where
    ResolvePoint3DMethod "cross" o = Point3DCrossMethodInfo
    ResolvePoint3DMethod "distance" o = Point3DDistanceMethodInfo
    ResolvePoint3DMethod "dot" o = Point3DDotMethodInfo
    ResolvePoint3DMethod "equal" o = Point3DEqualMethodInfo
    ResolvePoint3DMethod "free" o = Point3DFreeMethodInfo
    ResolvePoint3DMethod "init" o = Point3DInitMethodInfo
    ResolvePoint3DMethod "initFromPoint" o = Point3DInitFromPointMethodInfo
    ResolvePoint3DMethod "initFromVec3" o = Point3DInitFromVec3MethodInfo
    ResolvePoint3DMethod "interpolate" o = Point3DInterpolateMethodInfo
    ResolvePoint3DMethod "length" o = Point3DLengthMethodInfo
    ResolvePoint3DMethod "near" o = Point3DNearMethodInfo
    ResolvePoint3DMethod "normalize" o = Point3DNormalizeMethodInfo
    ResolvePoint3DMethod "normalizeViewport" o = Point3DNormalizeViewportMethodInfo
    ResolvePoint3DMethod "scale" o = Point3DScaleMethodInfo
    ResolvePoint3DMethod "toVec3" o = Point3DToVec3MethodInfo
    ResolvePoint3DMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolvePoint3DMethod t Point3D, O.MethodInfo info Point3D p) => OL.IsLabel t (Point3D -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif