{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A structure capable of holding a vector with four dimensions: x, y, z, and w.
-- 
-- The contents of the t'GI.Graphene.Structs.Vec4.Vec4' structure are private and should
-- never be accessed directly.

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

module GI.Graphene.Structs.Vec4
    ( 

-- * Exported types
    Vec4(..)                                ,
    newZeroVec4                             ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [add]("GI.Graphene.Structs.Vec4#g:method:add"), [divide]("GI.Graphene.Structs.Vec4#g:method:divide"), [dot]("GI.Graphene.Structs.Vec4#g:method:dot"), [equal]("GI.Graphene.Structs.Vec4#g:method:equal"), [free]("GI.Graphene.Structs.Vec4#g:method:free"), [init]("GI.Graphene.Structs.Vec4#g:method:init"), [initFromFloat]("GI.Graphene.Structs.Vec4#g:method:initFromFloat"), [initFromVec2]("GI.Graphene.Structs.Vec4#g:method:initFromVec2"), [initFromVec3]("GI.Graphene.Structs.Vec4#g:method:initFromVec3"), [initFromVec4]("GI.Graphene.Structs.Vec4#g:method:initFromVec4"), [interpolate]("GI.Graphene.Structs.Vec4#g:method:interpolate"), [length]("GI.Graphene.Structs.Vec4#g:method:length"), [max]("GI.Graphene.Structs.Vec4#g:method:max"), [min]("GI.Graphene.Structs.Vec4#g:method:min"), [multiply]("GI.Graphene.Structs.Vec4#g:method:multiply"), [near]("GI.Graphene.Structs.Vec4#g:method:near"), [negate]("GI.Graphene.Structs.Vec4#g:method:negate"), [normalize]("GI.Graphene.Structs.Vec4#g:method:normalize"), [scale]("GI.Graphene.Structs.Vec4#g:method:scale"), [subtract]("GI.Graphene.Structs.Vec4#g:method:subtract").
-- 
-- ==== Getters
-- [getW]("GI.Graphene.Structs.Vec4#g:method:getW"), [getX]("GI.Graphene.Structs.Vec4#g:method:getX"), [getXy]("GI.Graphene.Structs.Vec4#g:method:getXy"), [getXyz]("GI.Graphene.Structs.Vec4#g:method:getXyz"), [getY]("GI.Graphene.Structs.Vec4#g:method:getY"), [getZ]("GI.Graphene.Structs.Vec4#g:method:getZ").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveVec4Method                       ,
#endif

-- ** add #method:add#

#if defined(ENABLE_OVERLOADING)
    Vec4AddMethodInfo                       ,
#endif
    vec4Add                                 ,


-- ** alloc #method:alloc#

    vec4Alloc                               ,


-- ** divide #method:divide#

#if defined(ENABLE_OVERLOADING)
    Vec4DivideMethodInfo                    ,
#endif
    vec4Divide                              ,


-- ** dot #method:dot#

#if defined(ENABLE_OVERLOADING)
    Vec4DotMethodInfo                       ,
#endif
    vec4Dot                                 ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    Vec4EqualMethodInfo                     ,
#endif
    vec4Equal                               ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    Vec4FreeMethodInfo                      ,
#endif
    vec4Free                                ,


-- ** getW #method:getW#

#if defined(ENABLE_OVERLOADING)
    Vec4GetWMethodInfo                      ,
#endif
    vec4GetW                                ,


-- ** getX #method:getX#

#if defined(ENABLE_OVERLOADING)
    Vec4GetXMethodInfo                      ,
#endif
    vec4GetX                                ,


-- ** getXy #method:getXy#

#if defined(ENABLE_OVERLOADING)
    Vec4GetXyMethodInfo                     ,
#endif
    vec4GetXy                               ,


-- ** getXyz #method:getXyz#

#if defined(ENABLE_OVERLOADING)
    Vec4GetXyzMethodInfo                    ,
#endif
    vec4GetXyz                              ,


-- ** getY #method:getY#

#if defined(ENABLE_OVERLOADING)
    Vec4GetYMethodInfo                      ,
#endif
    vec4GetY                                ,


-- ** getZ #method:getZ#

#if defined(ENABLE_OVERLOADING)
    Vec4GetZMethodInfo                      ,
#endif
    vec4GetZ                                ,


-- ** init #method:init#

#if defined(ENABLE_OVERLOADING)
    Vec4InitMethodInfo                      ,
#endif
    vec4Init                                ,


-- ** initFromFloat #method:initFromFloat#

#if defined(ENABLE_OVERLOADING)
    Vec4InitFromFloatMethodInfo             ,
#endif
    vec4InitFromFloat                       ,


-- ** initFromVec2 #method:initFromVec2#

#if defined(ENABLE_OVERLOADING)
    Vec4InitFromVec2MethodInfo              ,
#endif
    vec4InitFromVec2                        ,


-- ** initFromVec3 #method:initFromVec3#

#if defined(ENABLE_OVERLOADING)
    Vec4InitFromVec3MethodInfo              ,
#endif
    vec4InitFromVec3                        ,


-- ** initFromVec4 #method:initFromVec4#

#if defined(ENABLE_OVERLOADING)
    Vec4InitFromVec4MethodInfo              ,
#endif
    vec4InitFromVec4                        ,


-- ** interpolate #method:interpolate#

#if defined(ENABLE_OVERLOADING)
    Vec4InterpolateMethodInfo               ,
#endif
    vec4Interpolate                         ,


-- ** length #method:length#

#if defined(ENABLE_OVERLOADING)
    Vec4LengthMethodInfo                    ,
#endif
    vec4Length                              ,


-- ** max #method:max#

#if defined(ENABLE_OVERLOADING)
    Vec4MaxMethodInfo                       ,
#endif
    vec4Max                                 ,


-- ** min #method:min#

#if defined(ENABLE_OVERLOADING)
    Vec4MinMethodInfo                       ,
#endif
    vec4Min                                 ,


-- ** multiply #method:multiply#

#if defined(ENABLE_OVERLOADING)
    Vec4MultiplyMethodInfo                  ,
#endif
    vec4Multiply                            ,


-- ** near #method:near#

#if defined(ENABLE_OVERLOADING)
    Vec4NearMethodInfo                      ,
#endif
    vec4Near                                ,


-- ** negate #method:negate#

#if defined(ENABLE_OVERLOADING)
    Vec4NegateMethodInfo                    ,
#endif
    vec4Negate                              ,


-- ** normalize #method:normalize#

#if defined(ENABLE_OVERLOADING)
    Vec4NormalizeMethodInfo                 ,
#endif
    vec4Normalize                           ,


-- ** one #method:one#

    vec4One                                 ,


-- ** scale #method:scale#

#if defined(ENABLE_OVERLOADING)
    Vec4ScaleMethodInfo                     ,
#endif
    vec4Scale                               ,


-- ** subtract #method:subtract#

#if defined(ENABLE_OVERLOADING)
    Vec4SubtractMethodInfo                  ,
#endif
    vec4Subtract                            ,


-- ** wAxis #method:wAxis#

    vec4WAxis                               ,


-- ** xAxis #method:xAxis#

    vec4XAxis                               ,


-- ** yAxis #method:yAxis#

    vec4YAxis                               ,


-- ** zAxis #method:zAxis#

    vec4ZAxis                               ,


-- ** zero #method:zero#

    vec4Zero                                ,




    ) 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.GArray as B.GArray
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.Coerce as Coerce
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 qualified GHC.Records as R

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

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

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

foreign import ccall "graphene_vec4_get_type" c_graphene_vec4_get_type :: 
    IO GType

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

instance B.Types.TypedObject Vec4 where
    glibType :: IO GType
glibType = IO GType
c_graphene_vec4_get_type

instance B.Types.GBoxed Vec4

-- | Convert 'Vec4' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Vec4) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_graphene_vec4_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Vec4 -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Vec4
P.Nothing = Ptr GValue -> Ptr Vec4 -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr Vec4
forall a. Ptr a
FP.nullPtr :: FP.Ptr Vec4)
    gvalueSet_ Ptr GValue
gv (P.Just Vec4
obj) = Vec4 -> (Ptr Vec4 -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Vec4
obj (Ptr GValue -> Ptr Vec4 -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Vec4)
gvalueGet_ Ptr GValue
gv = do
        Ptr Vec4
ptr <- Ptr GValue -> IO (Ptr Vec4)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr Vec4)
        if Ptr Vec4
ptr Ptr Vec4 -> Ptr Vec4 -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Vec4
forall a. Ptr a
FP.nullPtr
        then Vec4 -> Maybe Vec4
forall a. a -> Maybe a
P.Just (Vec4 -> Maybe Vec4) -> IO Vec4 -> IO (Maybe Vec4)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Vec4 -> Vec4) -> Ptr Vec4 -> IO Vec4
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Vec4 -> Vec4
Vec4 Ptr Vec4
ptr
        else Maybe Vec4 -> IO (Maybe Vec4)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Vec4
forall a. Maybe a
P.Nothing
        
    

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

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



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Vec4
type instance O.AttributeList Vec4 = Vec4AttributeList
type Vec4AttributeList = ('[ ] :: [(Symbol, *)])
#endif

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

foreign import ccall "graphene_vec4_alloc" graphene_vec4_alloc :: 
    IO (Ptr Vec4)

-- | Allocates a new t'GI.Graphene.Structs.Vec4.Vec4' structure.
-- 
-- The contents of the returned structure are undefined.
-- 
-- Use 'GI.Graphene.Structs.Vec4.vec4Init' to initialize the vector.
-- 
-- /Since: 1.0/
vec4Alloc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Vec4
    -- ^ __Returns:__ the newly allocated t'GI.Graphene.Structs.Vec4.Vec4'
    --   structure. Use 'GI.Graphene.Structs.Vec4.vec4Free' to free the resources allocated
    --   by this function.
vec4Alloc :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Vec4
vec4Alloc  = IO Vec4 -> m Vec4
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vec4 -> m Vec4) -> IO Vec4 -> m Vec4
forall a b. (a -> b) -> a -> b
$ do
    Ptr Vec4
result <- IO (Ptr Vec4)
graphene_vec4_alloc
    Text -> Ptr Vec4 -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vec4Alloc" Ptr Vec4
result
    Vec4
result' <- ((ManagedPtr Vec4 -> Vec4) -> Ptr Vec4 -> IO Vec4
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Vec4 -> Vec4
Vec4) Ptr Vec4
result
    Vec4 -> IO Vec4
forall (m :: * -> *) a. Monad m => a -> m a
return Vec4
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

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

-- | Adds each component of the two given vectors.
-- 
-- /Since: 1.0/
vec4Add ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vec4
    -- ^ /@a@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> Vec4
    -- ^ /@b@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> m (Vec4)
vec4Add :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Vec4 -> Vec4 -> m Vec4
vec4Add Vec4
a Vec4
b = IO Vec4 -> m Vec4
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vec4 -> m Vec4) -> IO Vec4 -> m Vec4
forall a b. (a -> b) -> a -> b
$ do
    Ptr Vec4
a' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
a
    Ptr Vec4
b' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
b
    Ptr Vec4
res <- Int -> IO (Ptr Vec4)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Vec4)
    Ptr Vec4 -> Ptr Vec4 -> Ptr Vec4 -> IO ()
graphene_vec4_add Ptr Vec4
a' Ptr Vec4
b' Ptr Vec4
res
    Vec4
res' <- ((ManagedPtr Vec4 -> Vec4) -> Ptr Vec4 -> IO Vec4
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Vec4 -> Vec4
Vec4) Ptr Vec4
res
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
a
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
b
    Vec4 -> IO Vec4
forall (m :: * -> *) a. Monad m => a -> m a
return Vec4
res'

#if defined(ENABLE_OVERLOADING)
data Vec4AddMethodInfo
instance (signature ~ (Vec4 -> m (Vec4)), MonadIO m) => O.OverloadedMethod Vec4AddMethodInfo Vec4 signature where
    overloadedMethod = vec4Add

instance O.OverloadedMethodInfo Vec4AddMethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4Add",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4Add"
        })


#endif

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

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

-- | Divides each component of the first operand /@a@/ by the corresponding
-- component of the second operand /@b@/, and places the results into the
-- vector /@res@/.
-- 
-- /Since: 1.0/
vec4Divide ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vec4
    -- ^ /@a@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> Vec4
    -- ^ /@b@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> m (Vec4)
vec4Divide :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Vec4 -> Vec4 -> m Vec4
vec4Divide Vec4
a Vec4
b = IO Vec4 -> m Vec4
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vec4 -> m Vec4) -> IO Vec4 -> m Vec4
forall a b. (a -> b) -> a -> b
$ do
    Ptr Vec4
a' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
a
    Ptr Vec4
b' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
b
    Ptr Vec4
res <- Int -> IO (Ptr Vec4)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Vec4)
    Ptr Vec4 -> Ptr Vec4 -> Ptr Vec4 -> IO ()
graphene_vec4_divide Ptr Vec4
a' Ptr Vec4
b' Ptr Vec4
res
    Vec4
res' <- ((ManagedPtr Vec4 -> Vec4) -> Ptr Vec4 -> IO Vec4
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Vec4 -> Vec4
Vec4) Ptr Vec4
res
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
a
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
b
    Vec4 -> IO Vec4
forall (m :: * -> *) a. Monad m => a -> m a
return Vec4
res'

#if defined(ENABLE_OVERLOADING)
data Vec4DivideMethodInfo
instance (signature ~ (Vec4 -> m (Vec4)), MonadIO m) => O.OverloadedMethod Vec4DivideMethodInfo Vec4 signature where
    overloadedMethod = vec4Divide

instance O.OverloadedMethodInfo Vec4DivideMethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4Divide",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4Divide"
        })


#endif

-- method Vec4::dot
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "a"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec4" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_vec4_t" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "b"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec4" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_vec4_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_vec4_dot" graphene_vec4_dot :: 
    Ptr Vec4 ->                             -- a : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    Ptr Vec4 ->                             -- b : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    IO CFloat

-- | Computes the dot product of the two given vectors.
-- 
-- /Since: 1.0/
vec4Dot ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vec4
    -- ^ /@a@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> Vec4
    -- ^ /@b@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> m Float
    -- ^ __Returns:__ the value of the dot product
vec4Dot :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Vec4 -> Vec4 -> m Float
vec4Dot Vec4
a Vec4
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 Vec4
a' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
a
    Ptr Vec4
b' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
b
    CFloat
result <- Ptr Vec4 -> Ptr Vec4 -> IO CFloat
graphene_vec4_dot Ptr Vec4
a' Ptr Vec4
b'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
a
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
b
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data Vec4DotMethodInfo
instance (signature ~ (Vec4 -> m Float), MonadIO m) => O.OverloadedMethod Vec4DotMethodInfo Vec4 signature where
    overloadedMethod = vec4Dot

instance O.OverloadedMethodInfo Vec4DotMethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4Dot",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4Dot"
        })


#endif

-- method Vec4::equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "v1"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec4" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_vec4_t" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "v2"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec4" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_vec4_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_vec4_equal" graphene_vec4_equal :: 
    Ptr Vec4 ->                             -- v1 : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    Ptr Vec4 ->                             -- v2 : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    IO CInt

-- | Checks whether the two given t'GI.Graphene.Structs.Vec4.Vec4' are equal.
-- 
-- /Since: 1.2/
vec4Equal ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vec4
    -- ^ /@v1@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> Vec4
    -- ^ /@v2@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> m Bool
    -- ^ __Returns:__ @true@ if the two vectors are equal, and false otherwise
vec4Equal :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Vec4 -> Vec4 -> m Bool
vec4Equal Vec4
v1 Vec4
v2 = 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 Vec4
v1' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
v1
    Ptr Vec4
v2' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
v2
    CInt
result <- Ptr Vec4 -> Ptr Vec4 -> IO CInt
graphene_vec4_equal Ptr Vec4
v1' Ptr Vec4
v2'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
v1
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
v2
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data Vec4EqualMethodInfo
instance (signature ~ (Vec4 -> m Bool), MonadIO m) => O.OverloadedMethod Vec4EqualMethodInfo Vec4 signature where
    overloadedMethod = vec4Equal

instance O.OverloadedMethodInfo Vec4EqualMethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4Equal",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4Equal"
        })


#endif

-- method Vec4::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "v"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec4" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_vec4_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_vec4_free" graphene_vec4_free :: 
    Ptr Vec4 ->                             -- v : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    IO ()

-- | Frees the resources allocated by /@v@/
-- 
-- /Since: 1.0/
vec4Free ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vec4
    -- ^ /@v@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> m ()
vec4Free :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Vec4 -> m ()
vec4Free Vec4
v = 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 Vec4
v' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
v
    Ptr Vec4 -> IO ()
graphene_vec4_free Ptr Vec4
v'
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
v
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data Vec4FreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod Vec4FreeMethodInfo Vec4 signature where
    overloadedMethod = vec4Free

instance O.OverloadedMethodInfo Vec4FreeMethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4Free",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4Free"
        })


#endif

-- method Vec4::get_w
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "v"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec4" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_vec4_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_vec4_get_w" graphene_vec4_get_w :: 
    Ptr Vec4 ->                             -- v : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    IO CFloat

-- | Retrieves the value of the fourth component of the given t'GI.Graphene.Structs.Vec4.Vec4'.
-- 
-- /Since: 1.0/
vec4GetW ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vec4
    -- ^ /@v@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> m Float
    -- ^ __Returns:__ the value of the fourth component
vec4GetW :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Vec4 -> m Float
vec4GetW Vec4
v = 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 Vec4
v' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
v
    CFloat
result <- Ptr Vec4 -> IO CFloat
graphene_vec4_get_w Ptr Vec4
v'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
v
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data Vec4GetWMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.OverloadedMethod Vec4GetWMethodInfo Vec4 signature where
    overloadedMethod = vec4GetW

instance O.OverloadedMethodInfo Vec4GetWMethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4GetW",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4GetW"
        })


#endif

-- method Vec4::get_x
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "v"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec4" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_vec4_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_vec4_get_x" graphene_vec4_get_x :: 
    Ptr Vec4 ->                             -- v : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    IO CFloat

-- | Retrieves the value of the first component of the given t'GI.Graphene.Structs.Vec4.Vec4'.
-- 
-- /Since: 1.0/
vec4GetX ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vec4
    -- ^ /@v@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> m Float
    -- ^ __Returns:__ the value of the first component
vec4GetX :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Vec4 -> m Float
vec4GetX Vec4
v = 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 Vec4
v' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
v
    CFloat
result <- Ptr Vec4 -> IO CFloat
graphene_vec4_get_x Ptr Vec4
v'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
v
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data Vec4GetXMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.OverloadedMethod Vec4GetXMethodInfo Vec4 signature where
    overloadedMethod = vec4GetX

instance O.OverloadedMethodInfo Vec4GetXMethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4GetX",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4GetX"
        })


#endif

-- method Vec4::get_xy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "v"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec4" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_vec4_t" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec2" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for a #graphene_vec2_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_vec4_get_xy" graphene_vec4_get_xy :: 
    Ptr Vec4 ->                             -- v : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    Ptr Graphene.Vec2.Vec2 ->               -- res : TInterface (Name {namespace = "Graphene", name = "Vec2"})
    IO ()

-- | Creates a t'GI.Graphene.Structs.Vec2.Vec2' that contains the first two components
-- of the given t'GI.Graphene.Structs.Vec4.Vec4'.
-- 
-- /Since: 1.0/
vec4GetXy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vec4
    -- ^ /@v@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> m (Graphene.Vec2.Vec2)
vec4GetXy :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Vec4 -> m Vec2
vec4GetXy Vec4
v = IO Vec2 -> m Vec2
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vec2 -> m Vec2) -> IO Vec2 -> m Vec2
forall a b. (a -> b) -> a -> b
$ do
    Ptr Vec4
v' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
v
    Ptr Vec2
res <- Int -> IO (Ptr Vec2)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Graphene.Vec2.Vec2)
    Ptr Vec4 -> Ptr Vec2 -> IO ()
graphene_vec4_get_xy Ptr Vec4
v' Ptr Vec2
res
    Vec2
res' <- ((ManagedPtr Vec2 -> Vec2) -> Ptr Vec2 -> IO Vec2
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Vec2 -> Vec2
Graphene.Vec2.Vec2) Ptr Vec2
res
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
v
    Vec2 -> IO Vec2
forall (m :: * -> *) a. Monad m => a -> m a
return Vec2
res'

#if defined(ENABLE_OVERLOADING)
data Vec4GetXyMethodInfo
instance (signature ~ (m (Graphene.Vec2.Vec2)), MonadIO m) => O.OverloadedMethod Vec4GetXyMethodInfo Vec4 signature where
    overloadedMethod = vec4GetXy

instance O.OverloadedMethodInfo Vec4GetXyMethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4GetXy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4GetXy"
        })


#endif

-- method Vec4::get_xyz
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "v"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec4" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_vec4_t" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , 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_vec4_get_xyz" graphene_vec4_get_xyz :: 
    Ptr Vec4 ->                             -- v : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    Ptr Graphene.Vec3.Vec3 ->               -- res : TInterface (Name {namespace = "Graphene", name = "Vec3"})
    IO ()

-- | Creates a t'GI.Graphene.Structs.Vec3.Vec3' that contains the first three components
-- of the given t'GI.Graphene.Structs.Vec4.Vec4'.
-- 
-- /Since: 1.0/
vec4GetXyz ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vec4
    -- ^ /@v@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> m (Graphene.Vec3.Vec3)
vec4GetXyz :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Vec4 -> m Vec3
vec4GetXyz Vec4
v = 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 Vec4
v' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
v
    Ptr Vec3
res <- Int -> IO (Ptr Vec3)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Graphene.Vec3.Vec3)
    Ptr Vec4 -> Ptr Vec3 -> IO ()
graphene_vec4_get_xyz Ptr Vec4
v' Ptr Vec3
res
    Vec3
res' <- ((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
res
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
v
    Vec3 -> IO Vec3
forall (m :: * -> *) a. Monad m => a -> m a
return Vec3
res'

#if defined(ENABLE_OVERLOADING)
data Vec4GetXyzMethodInfo
instance (signature ~ (m (Graphene.Vec3.Vec3)), MonadIO m) => O.OverloadedMethod Vec4GetXyzMethodInfo Vec4 signature where
    overloadedMethod = vec4GetXyz

instance O.OverloadedMethodInfo Vec4GetXyzMethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4GetXyz",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4GetXyz"
        })


#endif

-- method Vec4::get_y
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "v"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec4" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_vec4_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_vec4_get_y" graphene_vec4_get_y :: 
    Ptr Vec4 ->                             -- v : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    IO CFloat

-- | Retrieves the value of the second component of the given t'GI.Graphene.Structs.Vec4.Vec4'.
-- 
-- /Since: 1.0/
vec4GetY ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vec4
    -- ^ /@v@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> m Float
    -- ^ __Returns:__ the value of the second component
vec4GetY :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Vec4 -> m Float
vec4GetY Vec4
v = 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 Vec4
v' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
v
    CFloat
result <- Ptr Vec4 -> IO CFloat
graphene_vec4_get_y Ptr Vec4
v'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
v
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data Vec4GetYMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.OverloadedMethod Vec4GetYMethodInfo Vec4 signature where
    overloadedMethod = vec4GetY

instance O.OverloadedMethodInfo Vec4GetYMethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4GetY",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4GetY"
        })


#endif

-- method Vec4::get_z
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "v"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec4" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_vec4_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_vec4_get_z" graphene_vec4_get_z :: 
    Ptr Vec4 ->                             -- v : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    IO CFloat

-- | Retrieves the value of the third component of the given t'GI.Graphene.Structs.Vec4.Vec4'.
-- 
-- /Since: 1.0/
vec4GetZ ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vec4
    -- ^ /@v@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> m Float
    -- ^ __Returns:__ the value of the third component
vec4GetZ :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Vec4 -> m Float
vec4GetZ Vec4
v = 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 Vec4
v' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
v
    CFloat
result <- Ptr Vec4 -> IO CFloat
graphene_vec4_get_z Ptr Vec4
v'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
v
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data Vec4GetZMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.OverloadedMethod Vec4GetZMethodInfo Vec4 signature where
    overloadedMethod = vec4GetZ

instance O.OverloadedMethodInfo Vec4GetZMethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4GetZ",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4GetZ"
        })


#endif

-- method Vec4::init
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "v"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec4" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_vec4_t" , 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 field of the vector"
--                 , 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 field of the vector"
--                 , 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 field of the vector"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "w"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the W field of the vector"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Graphene" , name = "Vec4" })
-- throws : False
-- Skip return : False

foreign import ccall "graphene_vec4_init" graphene_vec4_init :: 
    Ptr Vec4 ->                             -- v : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    CFloat ->                               -- x : TBasicType TFloat
    CFloat ->                               -- y : TBasicType TFloat
    CFloat ->                               -- z : TBasicType TFloat
    CFloat ->                               -- w : TBasicType TFloat
    IO (Ptr Vec4)

-- | Initializes a t'GI.Graphene.Structs.Vec4.Vec4' using the given values.
-- 
-- This function can be called multiple times.
-- 
-- /Since: 1.0/
vec4Init ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vec4
    -- ^ /@v@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> Float
    -- ^ /@x@/: the X field of the vector
    -> Float
    -- ^ /@y@/: the Y field of the vector
    -> Float
    -- ^ /@z@/: the Z field of the vector
    -> Float
    -- ^ /@w@/: the W field of the vector
    -> m Vec4
    -- ^ __Returns:__ a pointer to the initialized
    --   vector
vec4Init :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Vec4 -> Float -> Float -> Float -> Float -> m Vec4
vec4Init Vec4
v Float
x Float
y Float
z Float
w = IO Vec4 -> m Vec4
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vec4 -> m Vec4) -> IO Vec4 -> m Vec4
forall a b. (a -> b) -> a -> b
$ do
    Ptr Vec4
v' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
v
    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
    let w' :: CFloat
w' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
w
    Ptr Vec4
result <- Ptr Vec4 -> CFloat -> CFloat -> CFloat -> CFloat -> IO (Ptr Vec4)
graphene_vec4_init Ptr Vec4
v' CFloat
x' CFloat
y' CFloat
z' CFloat
w'
    Text -> Ptr Vec4 -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vec4Init" Ptr Vec4
result
    Vec4
result' <- ((ManagedPtr Vec4 -> Vec4) -> Ptr Vec4 -> IO Vec4
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Vec4 -> Vec4
Vec4) Ptr Vec4
result
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
v
    Vec4 -> IO Vec4
forall (m :: * -> *) a. Monad m => a -> m a
return Vec4
result'

#if defined(ENABLE_OVERLOADING)
data Vec4InitMethodInfo
instance (signature ~ (Float -> Float -> Float -> Float -> m Vec4), MonadIO m) => O.OverloadedMethod Vec4InitMethodInfo Vec4 signature where
    overloadedMethod = vec4Init

instance O.OverloadedMethodInfo Vec4InitMethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4Init",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4Init"
        })


#endif

-- method Vec4::init_from_float
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "v"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec4" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_vec4_t" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src"
--           , argType = TCArray False 4 (-1) (TBasicType TFloat)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an array of four floating point values"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Graphene" , name = "Vec4" })
-- throws : False
-- Skip return : False

foreign import ccall "graphene_vec4_init_from_float" graphene_vec4_init_from_float :: 
    Ptr Vec4 ->                             -- v : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    Ptr CFloat ->                           -- src : TCArray False 4 (-1) (TBasicType TFloat)
    IO (Ptr Vec4)

-- | Initializes a t'GI.Graphene.Structs.Vec4.Vec4' with the values inside the given array.
-- 
-- /Since: 1.0/
vec4InitFromFloat ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vec4
    -- ^ /@v@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> [Float]
    -- ^ /@src@/: an array of four floating point values
    -> m Vec4
    -- ^ __Returns:__ the initialized vector
vec4InitFromFloat :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Vec4 -> [Float] -> m Vec4
vec4InitFromFloat Vec4
v [Float]
src = IO Vec4 -> m Vec4
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vec4 -> m Vec4) -> IO Vec4 -> m Vec4
forall a b. (a -> b) -> a -> b
$ do
    Ptr Vec4
v' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
v
    Ptr CFloat
src' <- ((Float -> CFloat) -> [Float] -> IO (Ptr CFloat)
forall a b. Storable b => (a -> b) -> [a] -> IO (Ptr b)
packMapStorableArray Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac) [Float]
src
    Ptr Vec4
result <- Ptr Vec4 -> Ptr CFloat -> IO (Ptr Vec4)
graphene_vec4_init_from_float Ptr Vec4
v' Ptr CFloat
src'
    Text -> Ptr Vec4 -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vec4InitFromFloat" Ptr Vec4
result
    Vec4
result' <- ((ManagedPtr Vec4 -> Vec4) -> Ptr Vec4 -> IO Vec4
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Vec4 -> Vec4
Vec4) Ptr Vec4
result
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
v
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
src'
    Vec4 -> IO Vec4
forall (m :: * -> *) a. Monad m => a -> m a
return Vec4
result'

#if defined(ENABLE_OVERLOADING)
data Vec4InitFromFloatMethodInfo
instance (signature ~ ([Float] -> m Vec4), MonadIO m) => O.OverloadedMethod Vec4InitFromFloatMethodInfo Vec4 signature where
    overloadedMethod = vec4InitFromFloat

instance O.OverloadedMethodInfo Vec4InitFromFloatMethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4InitFromFloat",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4InitFromFloat"
        })


#endif

-- method Vec4::init_from_vec2
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "v"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec4" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_vec4_t" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec2" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_vec2_t" , 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 value for the third component of @v"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "w"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value for the fourth component of @v"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Graphene" , name = "Vec4" })
-- throws : False
-- Skip return : False

foreign import ccall "graphene_vec4_init_from_vec2" graphene_vec4_init_from_vec2 :: 
    Ptr Vec4 ->                             -- v : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    Ptr Graphene.Vec2.Vec2 ->               -- src : TInterface (Name {namespace = "Graphene", name = "Vec2"})
    CFloat ->                               -- z : TBasicType TFloat
    CFloat ->                               -- w : TBasicType TFloat
    IO (Ptr Vec4)

-- | Initializes a t'GI.Graphene.Structs.Vec4.Vec4' using the components of a
-- t'GI.Graphene.Structs.Vec2.Vec2' and the values of /@z@/ and /@w@/.
-- 
-- /Since: 1.0/
vec4InitFromVec2 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vec4
    -- ^ /@v@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> Graphene.Vec2.Vec2
    -- ^ /@src@/: a t'GI.Graphene.Structs.Vec2.Vec2'
    -> Float
    -- ^ /@z@/: the value for the third component of /@v@/
    -> Float
    -- ^ /@w@/: the value for the fourth component of /@v@/
    -> m Vec4
    -- ^ __Returns:__ the initialized vector
vec4InitFromVec2 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Vec4 -> Vec2 -> Float -> Float -> m Vec4
vec4InitFromVec2 Vec4
v Vec2
src Float
z Float
w = IO Vec4 -> m Vec4
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vec4 -> m Vec4) -> IO Vec4 -> m Vec4
forall a b. (a -> b) -> a -> b
$ do
    Ptr Vec4
v' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
v
    Ptr Vec2
src' <- Vec2 -> IO (Ptr Vec2)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec2
src
    let z' :: CFloat
z' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
z
    let w' :: CFloat
w' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
w
    Ptr Vec4
result <- Ptr Vec4 -> Ptr Vec2 -> CFloat -> CFloat -> IO (Ptr Vec4)
graphene_vec4_init_from_vec2 Ptr Vec4
v' Ptr Vec2
src' CFloat
z' CFloat
w'
    Text -> Ptr Vec4 -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vec4InitFromVec2" Ptr Vec4
result
    Vec4
result' <- ((ManagedPtr Vec4 -> Vec4) -> Ptr Vec4 -> IO Vec4
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Vec4 -> Vec4
Vec4) Ptr Vec4
result
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
v
    Vec2 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec2
src
    Vec4 -> IO Vec4
forall (m :: * -> *) a. Monad m => a -> m a
return Vec4
result'

#if defined(ENABLE_OVERLOADING)
data Vec4InitFromVec2MethodInfo
instance (signature ~ (Graphene.Vec2.Vec2 -> Float -> Float -> m Vec4), MonadIO m) => O.OverloadedMethod Vec4InitFromVec2MethodInfo Vec4 signature where
    overloadedMethod = vec4InitFromVec2

instance O.OverloadedMethodInfo Vec4InitFromVec2MethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4InitFromVec2",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4InitFromVec2"
        })


#endif

-- method Vec4::init_from_vec3
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "v"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec4" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_vec4_t" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src"
--           , 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
--           }
--       , Arg
--           { argCName = "w"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value for the fourth component of @v"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Graphene" , name = "Vec4" })
-- throws : False
-- Skip return : False

foreign import ccall "graphene_vec4_init_from_vec3" graphene_vec4_init_from_vec3 :: 
    Ptr Vec4 ->                             -- v : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    Ptr Graphene.Vec3.Vec3 ->               -- src : TInterface (Name {namespace = "Graphene", name = "Vec3"})
    CFloat ->                               -- w : TBasicType TFloat
    IO (Ptr Vec4)

-- | Initializes a t'GI.Graphene.Structs.Vec4.Vec4' using the components of a
-- t'GI.Graphene.Structs.Vec3.Vec3' and the value of /@w@/.
-- 
-- /Since: 1.0/
vec4InitFromVec3 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vec4
    -- ^ /@v@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> Graphene.Vec3.Vec3
    -- ^ /@src@/: a t'GI.Graphene.Structs.Vec3.Vec3'
    -> Float
    -- ^ /@w@/: the value for the fourth component of /@v@/
    -> m Vec4
    -- ^ __Returns:__ the initialized vector
vec4InitFromVec3 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Vec4 -> Vec3 -> Float -> m Vec4
vec4InitFromVec3 Vec4
v Vec3
src Float
w = IO Vec4 -> m Vec4
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vec4 -> m Vec4) -> IO Vec4 -> m Vec4
forall a b. (a -> b) -> a -> b
$ do
    Ptr Vec4
v' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
v
    Ptr Vec3
src' <- Vec3 -> IO (Ptr Vec3)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec3
src
    let w' :: CFloat
w' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
w
    Ptr Vec4
result <- Ptr Vec4 -> Ptr Vec3 -> CFloat -> IO (Ptr Vec4)
graphene_vec4_init_from_vec3 Ptr Vec4
v' Ptr Vec3
src' CFloat
w'
    Text -> Ptr Vec4 -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vec4InitFromVec3" Ptr Vec4
result
    Vec4
result' <- ((ManagedPtr Vec4 -> Vec4) -> Ptr Vec4 -> IO Vec4
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Vec4 -> Vec4
Vec4) Ptr Vec4
result
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
v
    Vec3 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec3
src
    Vec4 -> IO Vec4
forall (m :: * -> *) a. Monad m => a -> m a
return Vec4
result'

#if defined(ENABLE_OVERLOADING)
data Vec4InitFromVec3MethodInfo
instance (signature ~ (Graphene.Vec3.Vec3 -> Float -> m Vec4), MonadIO m) => O.OverloadedMethod Vec4InitFromVec3MethodInfo Vec4 signature where
    overloadedMethod = vec4InitFromVec3

instance O.OverloadedMethodInfo Vec4InitFromVec3MethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4InitFromVec3",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4InitFromVec3"
        })


#endif

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

foreign import ccall "graphene_vec4_init_from_vec4" graphene_vec4_init_from_vec4 :: 
    Ptr Vec4 ->                             -- v : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    Ptr Vec4 ->                             -- src : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    IO (Ptr Vec4)

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

#if defined(ENABLE_OVERLOADING)
data Vec4InitFromVec4MethodInfo
instance (signature ~ (Vec4 -> m Vec4), MonadIO m) => O.OverloadedMethod Vec4InitFromVec4MethodInfo Vec4 signature where
    overloadedMethod = vec4InitFromVec4

instance O.OverloadedMethodInfo Vec4InitFromVec4MethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4InitFromVec4",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4InitFromVec4"
        })


#endif

-- method Vec4::interpolate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "v1"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec4" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_vec4_t" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "v2"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec4" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_vec4_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 = "Vec4" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the interpolated vector"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "graphene_vec4_interpolate" graphene_vec4_interpolate :: 
    Ptr Vec4 ->                             -- v1 : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    Ptr Vec4 ->                             -- v2 : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    CDouble ->                              -- factor : TBasicType TDouble
    Ptr Vec4 ->                             -- res : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    IO ()

-- | Linearly interpolates /@v1@/ and /@v2@/ using the given /@factor@/.
-- 
-- /Since: 1.10/
vec4Interpolate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vec4
    -- ^ /@v1@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> Vec4
    -- ^ /@v2@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> Double
    -- ^ /@factor@/: the interpolation factor
    -> m (Vec4)
vec4Interpolate :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Vec4 -> Vec4 -> Double -> m Vec4
vec4Interpolate Vec4
v1 Vec4
v2 Double
factor = IO Vec4 -> m Vec4
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vec4 -> m Vec4) -> IO Vec4 -> m Vec4
forall a b. (a -> b) -> a -> b
$ do
    Ptr Vec4
v1' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
v1
    Ptr Vec4
v2' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
v2
    let factor' :: CDouble
factor' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
factor
    Ptr Vec4
res <- Int -> IO (Ptr Vec4)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Vec4)
    Ptr Vec4 -> Ptr Vec4 -> CDouble -> Ptr Vec4 -> IO ()
graphene_vec4_interpolate Ptr Vec4
v1' Ptr Vec4
v2' CDouble
factor' Ptr Vec4
res
    Vec4
res' <- ((ManagedPtr Vec4 -> Vec4) -> Ptr Vec4 -> IO Vec4
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Vec4 -> Vec4
Vec4) Ptr Vec4
res
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
v1
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
v2
    Vec4 -> IO Vec4
forall (m :: * -> *) a. Monad m => a -> m a
return Vec4
res'

#if defined(ENABLE_OVERLOADING)
data Vec4InterpolateMethodInfo
instance (signature ~ (Vec4 -> Double -> m (Vec4)), MonadIO m) => O.OverloadedMethod Vec4InterpolateMethodInfo Vec4 signature where
    overloadedMethod = vec4Interpolate

instance O.OverloadedMethodInfo Vec4InterpolateMethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4Interpolate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4Interpolate"
        })


#endif

-- method Vec4::length
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "v"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec4" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_vec4_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_vec4_length" graphene_vec4_length :: 
    Ptr Vec4 ->                             -- v : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    IO CFloat

-- | Computes the length of the given t'GI.Graphene.Structs.Vec4.Vec4'.
-- 
-- /Since: 1.0/
vec4Length ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vec4
    -- ^ /@v@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> m Float
    -- ^ __Returns:__ the length of the vector
vec4Length :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Vec4 -> m Float
vec4Length Vec4
v = 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 Vec4
v' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
v
    CFloat
result <- Ptr Vec4 -> IO CFloat
graphene_vec4_length Ptr Vec4
v'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
v
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data Vec4LengthMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.OverloadedMethod Vec4LengthMethodInfo Vec4 signature where
    overloadedMethod = vec4Length

instance O.OverloadedMethodInfo Vec4LengthMethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4Length",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4Length"
        })


#endif

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

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

-- | Compares each component of the two given vectors and creates a
-- vector that contains the maximum values.
-- 
-- /Since: 1.0/
vec4Max ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vec4
    -- ^ /@a@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> Vec4
    -- ^ /@b@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> m (Vec4)
vec4Max :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Vec4 -> Vec4 -> m Vec4
vec4Max Vec4
a Vec4
b = IO Vec4 -> m Vec4
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vec4 -> m Vec4) -> IO Vec4 -> m Vec4
forall a b. (a -> b) -> a -> b
$ do
    Ptr Vec4
a' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
a
    Ptr Vec4
b' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
b
    Ptr Vec4
res <- Int -> IO (Ptr Vec4)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Vec4)
    Ptr Vec4 -> Ptr Vec4 -> Ptr Vec4 -> IO ()
graphene_vec4_max Ptr Vec4
a' Ptr Vec4
b' Ptr Vec4
res
    Vec4
res' <- ((ManagedPtr Vec4 -> Vec4) -> Ptr Vec4 -> IO Vec4
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Vec4 -> Vec4
Vec4) Ptr Vec4
res
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
a
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
b
    Vec4 -> IO Vec4
forall (m :: * -> *) a. Monad m => a -> m a
return Vec4
res'

#if defined(ENABLE_OVERLOADING)
data Vec4MaxMethodInfo
instance (signature ~ (Vec4 -> m (Vec4)), MonadIO m) => O.OverloadedMethod Vec4MaxMethodInfo Vec4 signature where
    overloadedMethod = vec4Max

instance O.OverloadedMethodInfo Vec4MaxMethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4Max",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4Max"
        })


#endif

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

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

-- | Compares each component of the two given vectors and creates a
-- vector that contains the minimum values.
-- 
-- /Since: 1.0/
vec4Min ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vec4
    -- ^ /@a@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> Vec4
    -- ^ /@b@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> m (Vec4)
vec4Min :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Vec4 -> Vec4 -> m Vec4
vec4Min Vec4
a Vec4
b = IO Vec4 -> m Vec4
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vec4 -> m Vec4) -> IO Vec4 -> m Vec4
forall a b. (a -> b) -> a -> b
$ do
    Ptr Vec4
a' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
a
    Ptr Vec4
b' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
b
    Ptr Vec4
res <- Int -> IO (Ptr Vec4)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Vec4)
    Ptr Vec4 -> Ptr Vec4 -> Ptr Vec4 -> IO ()
graphene_vec4_min Ptr Vec4
a' Ptr Vec4
b' Ptr Vec4
res
    Vec4
res' <- ((ManagedPtr Vec4 -> Vec4) -> Ptr Vec4 -> IO Vec4
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Vec4 -> Vec4
Vec4) Ptr Vec4
res
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
a
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
b
    Vec4 -> IO Vec4
forall (m :: * -> *) a. Monad m => a -> m a
return Vec4
res'

#if defined(ENABLE_OVERLOADING)
data Vec4MinMethodInfo
instance (signature ~ (Vec4 -> m (Vec4)), MonadIO m) => O.OverloadedMethod Vec4MinMethodInfo Vec4 signature where
    overloadedMethod = vec4Min

instance O.OverloadedMethodInfo Vec4MinMethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4Min",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4Min"
        })


#endif

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

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

-- | Multiplies each component of the two given vectors.
-- 
-- /Since: 1.0/
vec4Multiply ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vec4
    -- ^ /@a@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> Vec4
    -- ^ /@b@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> m (Vec4)
vec4Multiply :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Vec4 -> Vec4 -> m Vec4
vec4Multiply Vec4
a Vec4
b = IO Vec4 -> m Vec4
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vec4 -> m Vec4) -> IO Vec4 -> m Vec4
forall a b. (a -> b) -> a -> b
$ do
    Ptr Vec4
a' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
a
    Ptr Vec4
b' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
b
    Ptr Vec4
res <- Int -> IO (Ptr Vec4)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Vec4)
    Ptr Vec4 -> Ptr Vec4 -> Ptr Vec4 -> IO ()
graphene_vec4_multiply Ptr Vec4
a' Ptr Vec4
b' Ptr Vec4
res
    Vec4
res' <- ((ManagedPtr Vec4 -> Vec4) -> Ptr Vec4 -> IO Vec4
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Vec4 -> Vec4
Vec4) Ptr Vec4
res
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
a
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
b
    Vec4 -> IO Vec4
forall (m :: * -> *) a. Monad m => a -> m a
return Vec4
res'

#if defined(ENABLE_OVERLOADING)
data Vec4MultiplyMethodInfo
instance (signature ~ (Vec4 -> m (Vec4)), MonadIO m) => O.OverloadedMethod Vec4MultiplyMethodInfo Vec4 signature where
    overloadedMethod = vec4Multiply

instance O.OverloadedMethodInfo Vec4MultiplyMethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4Multiply",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4Multiply"
        })


#endif

-- method Vec4::near
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "v1"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec4" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_vec4_t" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "v2"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec4" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_vec4_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 "the threshold between the two vectors"
--                 , 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_vec4_near" graphene_vec4_near :: 
    Ptr Vec4 ->                             -- v1 : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    Ptr Vec4 ->                             -- v2 : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    CFloat ->                               -- epsilon : TBasicType TFloat
    IO CInt

-- | Compares the two given t'GI.Graphene.Structs.Vec4.Vec4' vectors and checks
-- whether their values are within the given /@epsilon@/.
-- 
-- /Since: 1.2/
vec4Near ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vec4
    -- ^ /@v1@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> Vec4
    -- ^ /@v2@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> Float
    -- ^ /@epsilon@/: the threshold between the two vectors
    -> m Bool
    -- ^ __Returns:__ @true@ if the two vectors are near each other
vec4Near :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Vec4 -> Vec4 -> Float -> m Bool
vec4Near Vec4
v1 Vec4
v2 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 Vec4
v1' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
v1
    Ptr Vec4
v2' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
v2
    let epsilon' :: CFloat
epsilon' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
epsilon
    CInt
result <- Ptr Vec4 -> Ptr Vec4 -> CFloat -> IO CInt
graphene_vec4_near Ptr Vec4
v1' Ptr Vec4
v2' CFloat
epsilon'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
v1
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
v2
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data Vec4NearMethodInfo
instance (signature ~ (Vec4 -> Float -> m Bool), MonadIO m) => O.OverloadedMethod Vec4NearMethodInfo Vec4 signature where
    overloadedMethod = vec4Near

instance O.OverloadedMethodInfo Vec4NearMethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4Near",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4Near"
        })


#endif

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

foreign import ccall "graphene_vec4_negate" graphene_vec4_negate :: 
    Ptr Vec4 ->                             -- v : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    Ptr Vec4 ->                             -- res : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    IO ()

-- | Negates the given t'GI.Graphene.Structs.Vec4.Vec4'.
-- 
-- /Since: 1.2/
vec4Negate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vec4
    -- ^ /@v@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> m (Vec4)
vec4Negate :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Vec4 -> m Vec4
vec4Negate Vec4
v = IO Vec4 -> m Vec4
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vec4 -> m Vec4) -> IO Vec4 -> m Vec4
forall a b. (a -> b) -> a -> b
$ do
    Ptr Vec4
v' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
v
    Ptr Vec4
res <- Int -> IO (Ptr Vec4)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Vec4)
    Ptr Vec4 -> Ptr Vec4 -> IO ()
graphene_vec4_negate Ptr Vec4
v' Ptr Vec4
res
    Vec4
res' <- ((ManagedPtr Vec4 -> Vec4) -> Ptr Vec4 -> IO Vec4
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Vec4 -> Vec4
Vec4) Ptr Vec4
res
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
v
    Vec4 -> IO Vec4
forall (m :: * -> *) a. Monad m => a -> m a
return Vec4
res'

#if defined(ENABLE_OVERLOADING)
data Vec4NegateMethodInfo
instance (signature ~ (m (Vec4)), MonadIO m) => O.OverloadedMethod Vec4NegateMethodInfo Vec4 signature where
    overloadedMethod = vec4Negate

instance O.OverloadedMethodInfo Vec4NegateMethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4Negate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4Negate"
        })


#endif

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

foreign import ccall "graphene_vec4_normalize" graphene_vec4_normalize :: 
    Ptr Vec4 ->                             -- v : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    Ptr Vec4 ->                             -- res : TInterface (Name {namespace = "Graphene", name = "Vec4"})
    IO ()

-- | Normalizes the given t'GI.Graphene.Structs.Vec4.Vec4'.
-- 
-- /Since: 1.0/
vec4Normalize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vec4
    -- ^ /@v@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> m (Vec4)
vec4Normalize :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Vec4 -> m Vec4
vec4Normalize Vec4
v = IO Vec4 -> m Vec4
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vec4 -> m Vec4) -> IO Vec4 -> m Vec4
forall a b. (a -> b) -> a -> b
$ do
    Ptr Vec4
v' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
v
    Ptr Vec4
res <- Int -> IO (Ptr Vec4)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Vec4)
    Ptr Vec4 -> Ptr Vec4 -> IO ()
graphene_vec4_normalize Ptr Vec4
v' Ptr Vec4
res
    Vec4
res' <- ((ManagedPtr Vec4 -> Vec4) -> Ptr Vec4 -> IO Vec4
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Vec4 -> Vec4
Vec4) Ptr Vec4
res
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
v
    Vec4 -> IO Vec4
forall (m :: * -> *) a. Monad m => a -> m a
return Vec4
res'

#if defined(ENABLE_OVERLOADING)
data Vec4NormalizeMethodInfo
instance (signature ~ (m (Vec4)), MonadIO m) => O.OverloadedMethod Vec4NormalizeMethodInfo Vec4 signature where
    overloadedMethod = vec4Normalize

instance O.OverloadedMethodInfo Vec4NormalizeMethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4Normalize",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4Normalize"
        })


#endif

-- method Vec4::scale
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "v"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec4" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #graphene_vec4_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 scalar factor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Graphene" , name = "Vec4" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the result vector"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Multiplies all components of the given vector with the given scalar /@factor@/.
-- 
-- /Since: 1.2/
vec4Scale ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vec4
    -- ^ /@v@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> Float
    -- ^ /@factor@/: the scalar factor
    -> m (Vec4)
vec4Scale :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Vec4 -> Float -> m Vec4
vec4Scale Vec4
v Float
factor = IO Vec4 -> m Vec4
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vec4 -> m Vec4) -> IO Vec4 -> m Vec4
forall a b. (a -> b) -> a -> b
$ do
    Ptr Vec4
v' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
v
    let factor' :: CFloat
factor' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
factor
    Ptr Vec4
res <- Int -> IO (Ptr Vec4)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Vec4)
    Ptr Vec4 -> CFloat -> Ptr Vec4 -> IO ()
graphene_vec4_scale Ptr Vec4
v' CFloat
factor' Ptr Vec4
res
    Vec4
res' <- ((ManagedPtr Vec4 -> Vec4) -> Ptr Vec4 -> IO Vec4
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Vec4 -> Vec4
Vec4) Ptr Vec4
res
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
v
    Vec4 -> IO Vec4
forall (m :: * -> *) a. Monad m => a -> m a
return Vec4
res'

#if defined(ENABLE_OVERLOADING)
data Vec4ScaleMethodInfo
instance (signature ~ (Float -> m (Vec4)), MonadIO m) => O.OverloadedMethod Vec4ScaleMethodInfo Vec4 signature where
    overloadedMethod = vec4Scale

instance O.OverloadedMethodInfo Vec4ScaleMethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4Scale",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4Scale"
        })


#endif

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

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

-- | Subtracts from each component of the first operand /@a@/ the
-- corresponding component of the second operand /@b@/ and places
-- each result into the components of /@res@/.
-- 
-- /Since: 1.0/
vec4Subtract ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Vec4
    -- ^ /@a@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> Vec4
    -- ^ /@b@/: a t'GI.Graphene.Structs.Vec4.Vec4'
    -> m (Vec4)
vec4Subtract :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Vec4 -> Vec4 -> m Vec4
vec4Subtract Vec4
a Vec4
b = IO Vec4 -> m Vec4
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vec4 -> m Vec4) -> IO Vec4 -> m Vec4
forall a b. (a -> b) -> a -> b
$ do
    Ptr Vec4
a' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
a
    Ptr Vec4
b' <- Vec4 -> IO (Ptr Vec4)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Vec4
b
    Ptr Vec4
res <- Int -> IO (Ptr Vec4)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Vec4)
    Ptr Vec4 -> Ptr Vec4 -> Ptr Vec4 -> IO ()
graphene_vec4_subtract Ptr Vec4
a' Ptr Vec4
b' Ptr Vec4
res
    Vec4
res' <- ((ManagedPtr Vec4 -> Vec4) -> Ptr Vec4 -> IO Vec4
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Vec4 -> Vec4
Vec4) Ptr Vec4
res
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
a
    Vec4 -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Vec4
b
    Vec4 -> IO Vec4
forall (m :: * -> *) a. Monad m => a -> m a
return Vec4
res'

#if defined(ENABLE_OVERLOADING)
data Vec4SubtractMethodInfo
instance (signature ~ (Vec4 -> m (Vec4)), MonadIO m) => O.OverloadedMethod Vec4SubtractMethodInfo Vec4 signature where
    overloadedMethod = vec4Subtract

instance O.OverloadedMethodInfo Vec4SubtractMethodInfo Vec4 where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Graphene.Structs.Vec4.vec4Subtract",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-graphene-1.0.4/docs/GI-Graphene-Structs-Vec4.html#v:vec4Subtract"
        })


#endif

-- XXX Could not generate method Vec4::to_float
-- Not implemented: Don't know how to allocate "dest" of type TCArray False 4 (-1) (TBasicType TFloat)
-- method Vec4::one
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Graphene" , name = "Vec4" })
-- throws : False
-- Skip return : False

foreign import ccall "graphene_vec4_one" graphene_vec4_one :: 
    IO (Ptr Vec4)

-- | Retrieves a pointer to a t'GI.Graphene.Structs.Vec4.Vec4' with all its
-- components set to 1.
-- 
-- /Since: 1.0/
vec4One ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Vec4
    -- ^ __Returns:__ a constant vector
vec4One :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Vec4
vec4One  = IO Vec4 -> m Vec4
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vec4 -> m Vec4) -> IO Vec4 -> m Vec4
forall a b. (a -> b) -> a -> b
$ do
    Ptr Vec4
result <- IO (Ptr Vec4)
graphene_vec4_one
    Text -> Ptr Vec4 -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vec4One" Ptr Vec4
result
    Vec4
result' <- ((ManagedPtr Vec4 -> Vec4) -> Ptr Vec4 -> IO Vec4
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Vec4 -> Vec4
Vec4) Ptr Vec4
result
    Vec4 -> IO Vec4
forall (m :: * -> *) a. Monad m => a -> m a
return Vec4
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "graphene_vec4_w_axis" graphene_vec4_w_axis :: 
    IO (Ptr Vec4)

-- | Retrieves a pointer to a t'GI.Graphene.Structs.Vec4.Vec4' with its
-- components set to (0, 0, 0, 1).
-- 
-- /Since: 1.0/
vec4WAxis ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Vec4
    -- ^ __Returns:__ a constant vector
vec4WAxis :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Vec4
vec4WAxis  = IO Vec4 -> m Vec4
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vec4 -> m Vec4) -> IO Vec4 -> m Vec4
forall a b. (a -> b) -> a -> b
$ do
    Ptr Vec4
result <- IO (Ptr Vec4)
graphene_vec4_w_axis
    Text -> Ptr Vec4 -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vec4WAxis" Ptr Vec4
result
    Vec4
result' <- ((ManagedPtr Vec4 -> Vec4) -> Ptr Vec4 -> IO Vec4
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Vec4 -> Vec4
Vec4) Ptr Vec4
result
    Vec4 -> IO Vec4
forall (m :: * -> *) a. Monad m => a -> m a
return Vec4
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "graphene_vec4_x_axis" graphene_vec4_x_axis :: 
    IO (Ptr Vec4)

-- | Retrieves a pointer to a t'GI.Graphene.Structs.Vec4.Vec4' with its
-- components set to (1, 0, 0, 0).
-- 
-- /Since: 1.0/
vec4XAxis ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Vec4
    -- ^ __Returns:__ a constant vector
vec4XAxis :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Vec4
vec4XAxis  = IO Vec4 -> m Vec4
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vec4 -> m Vec4) -> IO Vec4 -> m Vec4
forall a b. (a -> b) -> a -> b
$ do
    Ptr Vec4
result <- IO (Ptr Vec4)
graphene_vec4_x_axis
    Text -> Ptr Vec4 -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vec4XAxis" Ptr Vec4
result
    Vec4
result' <- ((ManagedPtr Vec4 -> Vec4) -> Ptr Vec4 -> IO Vec4
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Vec4 -> Vec4
Vec4) Ptr Vec4
result
    Vec4 -> IO Vec4
forall (m :: * -> *) a. Monad m => a -> m a
return Vec4
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "graphene_vec4_y_axis" graphene_vec4_y_axis :: 
    IO (Ptr Vec4)

-- | Retrieves a pointer to a t'GI.Graphene.Structs.Vec4.Vec4' with its
-- components set to (0, 1, 0, 0).
-- 
-- /Since: 1.0/
vec4YAxis ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Vec4
    -- ^ __Returns:__ a constant vector
vec4YAxis :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Vec4
vec4YAxis  = IO Vec4 -> m Vec4
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vec4 -> m Vec4) -> IO Vec4 -> m Vec4
forall a b. (a -> b) -> a -> b
$ do
    Ptr Vec4
result <- IO (Ptr Vec4)
graphene_vec4_y_axis
    Text -> Ptr Vec4 -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vec4YAxis" Ptr Vec4
result
    Vec4
result' <- ((ManagedPtr Vec4 -> Vec4) -> Ptr Vec4 -> IO Vec4
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Vec4 -> Vec4
Vec4) Ptr Vec4
result
    Vec4 -> IO Vec4
forall (m :: * -> *) a. Monad m => a -> m a
return Vec4
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "graphene_vec4_z_axis" graphene_vec4_z_axis :: 
    IO (Ptr Vec4)

-- | Retrieves a pointer to a t'GI.Graphene.Structs.Vec4.Vec4' with its
-- components set to (0, 0, 1, 0).
-- 
-- /Since: 1.0/
vec4ZAxis ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Vec4
    -- ^ __Returns:__ a constant vector
vec4ZAxis :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Vec4
vec4ZAxis  = IO Vec4 -> m Vec4
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vec4 -> m Vec4) -> IO Vec4 -> m Vec4
forall a b. (a -> b) -> a -> b
$ do
    Ptr Vec4
result <- IO (Ptr Vec4)
graphene_vec4_z_axis
    Text -> Ptr Vec4 -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vec4ZAxis" Ptr Vec4
result
    Vec4
result' <- ((ManagedPtr Vec4 -> Vec4) -> Ptr Vec4 -> IO Vec4
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Vec4 -> Vec4
Vec4) Ptr Vec4
result
    Vec4 -> IO Vec4
forall (m :: * -> *) a. Monad m => a -> m a
return Vec4
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "graphene_vec4_zero" graphene_vec4_zero :: 
    IO (Ptr Vec4)

-- | Retrieves a pointer to a t'GI.Graphene.Structs.Vec4.Vec4' with all its
-- components set to 0.
-- 
-- /Since: 1.0/
vec4Zero ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Vec4
    -- ^ __Returns:__ a constant vector
vec4Zero :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Vec4
vec4Zero  = IO Vec4 -> m Vec4
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vec4 -> m Vec4) -> IO Vec4 -> m Vec4
forall a b. (a -> b) -> a -> b
$ do
    Ptr Vec4
result <- IO (Ptr Vec4)
graphene_vec4_zero
    Text -> Ptr Vec4 -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vec4Zero" Ptr Vec4
result
    Vec4
result' <- ((ManagedPtr Vec4 -> Vec4) -> Ptr Vec4 -> IO Vec4
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Vec4 -> Vec4
Vec4) Ptr Vec4
result
    Vec4 -> IO Vec4
forall (m :: * -> *) a. Monad m => a -> m a
return Vec4
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveVec4Method (t :: Symbol) (o :: *) :: * where
    ResolveVec4Method "add" o = Vec4AddMethodInfo
    ResolveVec4Method "divide" o = Vec4DivideMethodInfo
    ResolveVec4Method "dot" o = Vec4DotMethodInfo
    ResolveVec4Method "equal" o = Vec4EqualMethodInfo
    ResolveVec4Method "free" o = Vec4FreeMethodInfo
    ResolveVec4Method "init" o = Vec4InitMethodInfo
    ResolveVec4Method "initFromFloat" o = Vec4InitFromFloatMethodInfo
    ResolveVec4Method "initFromVec2" o = Vec4InitFromVec2MethodInfo
    ResolveVec4Method "initFromVec3" o = Vec4InitFromVec3MethodInfo
    ResolveVec4Method "initFromVec4" o = Vec4InitFromVec4MethodInfo
    ResolveVec4Method "interpolate" o = Vec4InterpolateMethodInfo
    ResolveVec4Method "length" o = Vec4LengthMethodInfo
    ResolveVec4Method "max" o = Vec4MaxMethodInfo
    ResolveVec4Method "min" o = Vec4MinMethodInfo
    ResolveVec4Method "multiply" o = Vec4MultiplyMethodInfo
    ResolveVec4Method "near" o = Vec4NearMethodInfo
    ResolveVec4Method "negate" o = Vec4NegateMethodInfo
    ResolveVec4Method "normalize" o = Vec4NormalizeMethodInfo
    ResolveVec4Method "scale" o = Vec4ScaleMethodInfo
    ResolveVec4Method "subtract" o = Vec4SubtractMethodInfo
    ResolveVec4Method "getW" o = Vec4GetWMethodInfo
    ResolveVec4Method "getX" o = Vec4GetXMethodInfo
    ResolveVec4Method "getXy" o = Vec4GetXyMethodInfo
    ResolveVec4Method "getXyz" o = Vec4GetXyzMethodInfo
    ResolveVec4Method "getY" o = Vec4GetYMethodInfo
    ResolveVec4Method "getZ" o = Vec4GetZMethodInfo
    ResolveVec4Method l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveVec4Method t Vec4, O.OverloadedMethod info Vec4 p, R.HasField t Vec4 p) => R.HasField t Vec4 p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveVec4Method t Vec4, O.OverloadedMethodInfo info Vec4) => OL.IsLabel t (O.MethodProxy info Vec4) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif