{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A type representing a 4x4 matrix.
-- 
-- It is identicaly to t'GI.Cogl.Structs.Matrix.Matrix'.
-- 
-- /Since: 1.12/

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

module GI.Clutter.Structs.Matrix
    ( 

-- * Exported types
    Matrix(..)                              ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [free]("GI.Clutter.Structs.Matrix#g:method:free"), [initFromArray]("GI.Clutter.Structs.Matrix#g:method:initFromArray"), [initFromMatrix]("GI.Clutter.Structs.Matrix#g:method:initFromMatrix"), [initIdentity]("GI.Clutter.Structs.Matrix#g:method:initIdentity").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveMatrixMethod                     ,
#endif

-- ** alloc #method:alloc#

    matrixAlloc                             ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    MatrixFreeMethodInfo                    ,
#endif
    matrixFree                              ,


-- ** initFromArray #method:initFromArray#

#if defined(ENABLE_OVERLOADING)
    MatrixInitFromArrayMethodInfo           ,
#endif
    matrixInitFromArray                     ,


-- ** initFromMatrix #method:initFromMatrix#

#if defined(ENABLE_OVERLOADING)
    MatrixInitFromMatrixMethodInfo          ,
#endif
    matrixInitFromMatrix                    ,


-- ** initIdentity #method:initIdentity#

#if defined(ENABLE_OVERLOADING)
    MatrixInitIdentityMethodInfo            ,
#endif
    matrixInitIdentity                      ,




    ) 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.GHashTable as B.GHT
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


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

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

foreign import ccall "clutter_matrix_get_type" c_clutter_matrix_get_type :: 
    IO GType

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

instance B.Types.TypedObject Matrix where
    glibType :: IO GType
glibType = IO GType
c_clutter_matrix_get_type

instance B.Types.GBoxed Matrix

-- | Convert 'Matrix' 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 Matrix) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_clutter_matrix_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Matrix -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Matrix
P.Nothing = Ptr GValue -> Ptr Matrix -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr Matrix
forall a. Ptr a
FP.nullPtr :: FP.Ptr Matrix)
    gvalueSet_ Ptr GValue
gv (P.Just Matrix
obj) = Matrix -> (Ptr Matrix -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Matrix
obj (Ptr GValue -> Ptr Matrix -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Matrix)
gvalueGet_ Ptr GValue
gv = do
        Ptr Matrix
ptr <- Ptr GValue -> IO (Ptr Matrix)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr Matrix)
        if Ptr Matrix
ptr Ptr Matrix -> Ptr Matrix -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Matrix
forall a. Ptr a
FP.nullPtr
        then Matrix -> Maybe Matrix
forall a. a -> Maybe a
P.Just (Matrix -> Maybe Matrix) -> IO Matrix -> IO (Maybe Matrix)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Matrix -> Matrix) -> Ptr Matrix -> IO Matrix
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Matrix -> Matrix
Matrix Ptr Matrix
ptr
        else Maybe Matrix -> IO (Maybe Matrix)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Matrix
forall a. Maybe a
P.Nothing
        
    


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

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

foreign import ccall "clutter_matrix_free" clutter_matrix_free :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Clutter", name = "Matrix"})
    IO ()

-- | Frees the memory allocated by 'GI.Clutter.Functions.matrixAlloc'.
-- 
-- /Since: 1.12/
matrixFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: a t'GI.Clutter.Structs.Matrix.Matrix'
    -> m ()
matrixFree :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Matrix -> m ()
matrixFree Matrix
matrix = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Matrix
matrix' <- Matrix -> IO (Ptr Matrix)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Matrix
matrix
    Ptr Matrix -> IO ()
clutter_matrix_free Ptr Matrix
matrix'
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
matrix
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MatrixFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod MatrixFreeMethodInfo Matrix signature where
    overloadedMethod = matrixFree

instance O.OverloadedMethodInfo MatrixFreeMethodInfo Matrix where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Matrix.matrixFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-Matrix.html#v:matrixFree"
        })


#endif

-- method Matrix::init_from_array
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterMatrix" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "values"
--           , argType = TCArray False 16 (-1) (TBasicType TFloat)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a C array of 16 floating point values,\n  representing a 4x4 matrix, with column-major order"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Matrix" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_matrix_init_from_array" clutter_matrix_init_from_array :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Clutter", name = "Matrix"})
    Ptr CFloat ->                           -- values : TCArray False 16 (-1) (TBasicType TFloat)
    IO (Ptr Matrix)

-- | Initializes /@matrix@/ with the contents of a C array of floating point
-- values.
-- 
-- /Since: 1.12/
matrixInitFromArray ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: a t'GI.Clutter.Structs.Matrix.Matrix'
    -> [Float]
    -- ^ /@values@/: a C array of 16 floating point values,
    --   representing a 4x4 matrix, with column-major order
    -> m Matrix
    -- ^ __Returns:__ the initialzed t'GI.Clutter.Structs.Matrix.Matrix'
matrixInitFromArray :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Matrix -> [Float] -> m Matrix
matrixInitFromArray Matrix
matrix [Float]
values = IO Matrix -> m Matrix
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Matrix -> m Matrix) -> IO Matrix -> m Matrix
forall a b. (a -> b) -> a -> b
$ do
    Ptr Matrix
matrix' <- Matrix -> IO (Ptr Matrix)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Matrix
matrix
    Ptr CFloat
values' <- ((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]
values
    Ptr Matrix
result <- Ptr Matrix -> Ptr CFloat -> IO (Ptr Matrix)
clutter_matrix_init_from_array Ptr Matrix
matrix' Ptr CFloat
values'
    Text -> Ptr Matrix -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"matrixInitFromArray" Ptr Matrix
result
    Matrix
result' <- ((ManagedPtr Matrix -> Matrix) -> Ptr Matrix -> IO Matrix
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Matrix -> Matrix
Matrix) Ptr Matrix
result
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
matrix
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
values'
    Matrix -> IO Matrix
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Matrix
result'

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

instance O.OverloadedMethodInfo MatrixInitFromArrayMethodInfo Matrix where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Matrix.matrixInitFromArray",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-Matrix.html#v:matrixInitFromArray"
        })


#endif

-- method Matrix::init_from_matrix
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "a"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #ClutterMatrix to initialize"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "b"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #ClutterMatrix to copy"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Matrix" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_matrix_init_from_matrix" clutter_matrix_init_from_matrix :: 
    Ptr Matrix ->                           -- a : TInterface (Name {namespace = "Clutter", name = "Matrix"})
    Ptr Matrix ->                           -- b : TInterface (Name {namespace = "Clutter", name = "Matrix"})
    IO (Ptr Matrix)

-- | Initializes the t'GI.Clutter.Structs.Matrix.Matrix' /@a@/ with the contents of the
-- t'GI.Clutter.Structs.Matrix.Matrix' /@b@/.
-- 
-- /Since: 1.12/
matrixInitFromMatrix ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@a@/: the t'GI.Clutter.Structs.Matrix.Matrix' to initialize
    -> Matrix
    -- ^ /@b@/: the t'GI.Clutter.Structs.Matrix.Matrix' to copy
    -> m Matrix
    -- ^ __Returns:__ the initialized t'GI.Clutter.Structs.Matrix.Matrix'
matrixInitFromMatrix :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Matrix -> Matrix -> m Matrix
matrixInitFromMatrix Matrix
a Matrix
b = IO Matrix -> m Matrix
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Matrix -> m Matrix) -> IO Matrix -> m Matrix
forall a b. (a -> b) -> a -> b
$ do
    Ptr Matrix
a' <- Matrix -> IO (Ptr Matrix)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Matrix
a
    Ptr Matrix
b' <- Matrix -> IO (Ptr Matrix)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Matrix
b
    Ptr Matrix
result <- Ptr Matrix -> Ptr Matrix -> IO (Ptr Matrix)
clutter_matrix_init_from_matrix Ptr Matrix
a' Ptr Matrix
b'
    Text -> Ptr Matrix -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"matrixInitFromMatrix" Ptr Matrix
result
    Matrix
result' <- ((ManagedPtr Matrix -> Matrix) -> Ptr Matrix -> IO Matrix
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Matrix -> Matrix
Matrix) Ptr Matrix
result
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
a
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
b
    Matrix -> IO Matrix
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Matrix
result'

#if defined(ENABLE_OVERLOADING)
data MatrixInitFromMatrixMethodInfo
instance (signature ~ (Matrix -> m Matrix), MonadIO m) => O.OverloadedMethod MatrixInitFromMatrixMethodInfo Matrix signature where
    overloadedMethod = matrixInitFromMatrix

instance O.OverloadedMethodInfo MatrixInitFromMatrixMethodInfo Matrix where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Matrix.matrixInitFromMatrix",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-Matrix.html#v:matrixInitFromMatrix"
        })


#endif

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

foreign import ccall "clutter_matrix_init_identity" clutter_matrix_init_identity :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Clutter", name = "Matrix"})
    IO (Ptr Matrix)

-- | Initializes /@matrix@/ with the identity matrix, i.e.:
-- 
-- >
-- >  .xx = 1.0, .xy = 0.0, .xz = 0.0, .xw = 0.0
-- >  .yx = 0.0, .yy = 1.0, .yz = 0.0, .yw = 0.0
-- >  .zx = 0.0, .zy = 0.0, .zz = 1.0, .zw = 0.0
-- >  .wx = 0.0, .wy = 0.0, .wz = 0.0, .ww = 1.0
-- 
-- 
-- /Since: 1.12/
matrixInitIdentity ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: a t'GI.Clutter.Structs.Matrix.Matrix'
    -> m Matrix
    -- ^ __Returns:__ the initialized t'GI.Clutter.Structs.Matrix.Matrix'
matrixInitIdentity :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Matrix -> m Matrix
matrixInitIdentity Matrix
matrix = IO Matrix -> m Matrix
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Matrix -> m Matrix) -> IO Matrix -> m Matrix
forall a b. (a -> b) -> a -> b
$ do
    Ptr Matrix
matrix' <- Matrix -> IO (Ptr Matrix)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Matrix
matrix
    Ptr Matrix
result <- Ptr Matrix -> IO (Ptr Matrix)
clutter_matrix_init_identity Ptr Matrix
matrix'
    Text -> Ptr Matrix -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"matrixInitIdentity" Ptr Matrix
result
    Matrix
result' <- ((ManagedPtr Matrix -> Matrix) -> Ptr Matrix -> IO Matrix
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Matrix -> Matrix
Matrix) Ptr Matrix
result
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
matrix
    Matrix -> IO Matrix
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Matrix
result'

#if defined(ENABLE_OVERLOADING)
data MatrixInitIdentityMethodInfo
instance (signature ~ (m Matrix), MonadIO m) => O.OverloadedMethod MatrixInitIdentityMethodInfo Matrix signature where
    overloadedMethod = matrixInitIdentity

instance O.OverloadedMethodInfo MatrixInitIdentityMethodInfo Matrix where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.Matrix.matrixInitIdentity",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-Matrix.html#v:matrixInitIdentity"
        })


#endif

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

foreign import ccall "clutter_matrix_alloc" clutter_matrix_alloc :: 
    IO (Ptr Matrix)

-- | Allocates enough memory to hold a t'GI.Clutter.Structs.Matrix.Matrix'.
-- 
-- /Since: 1.12/
matrixAlloc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Matrix
    -- ^ __Returns:__ the newly allocated t'GI.Clutter.Structs.Matrix.Matrix'
matrixAlloc :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Matrix
matrixAlloc  = IO Matrix -> m Matrix
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Matrix -> m Matrix) -> IO Matrix -> m Matrix
forall a b. (a -> b) -> a -> b
$ do
    Ptr Matrix
result <- IO (Ptr Matrix)
clutter_matrix_alloc
    Text -> Ptr Matrix -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"matrixAlloc" Ptr Matrix
result
    Matrix
result' <- ((ManagedPtr Matrix -> Matrix) -> Ptr Matrix -> IO Matrix
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Matrix -> Matrix
Matrix) Ptr Matrix
result
    Matrix -> IO Matrix
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Matrix
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveMatrixMethod (t :: Symbol) (o :: *) :: * where
    ResolveMatrixMethod "free" o = MatrixFreeMethodInfo
    ResolveMatrixMethod "initFromArray" o = MatrixInitFromArrayMethodInfo
    ResolveMatrixMethod "initFromMatrix" o = MatrixInitFromMatrixMethodInfo
    ResolveMatrixMethod "initIdentity" o = MatrixInitIdentityMethodInfo
    ResolveMatrixMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveMatrixMethod t Matrix, O.OverloadedMethod info Matrix p) => OL.IsLabel t (Matrix -> 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 ~ ResolveMatrixMethod t Matrix, O.OverloadedMethod info Matrix p, R.HasField t Matrix p) => R.HasField t Matrix p where
    getField = O.overloadedMethod @info

#endif

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

#endif