{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A CoglMatrix holds a 4x4 transform matrix. This is a single precision,
-- column-major matrix which means it is compatible with what OpenGL expects.
-- 
-- A CoglMatrix can represent transforms such as, rotations, scaling,
-- translation, sheering, and linear projections. You can combine these
-- transforms by multiplying multiple matrices in the order you want them
-- applied.
-- 
-- The transformation of a vertex (x, y, z, w) by a CoglMatrix is given by:
-- 
-- >
-- >  x_new = xx * x + xy * y + xz * z + xw * w
-- >  y_new = yx * x + yy * y + yz * z + yw * w
-- >  z_new = zx * x + zy * y + zz * z + zw * w
-- >  w_new = wx * x + wy * y + wz * z + ww * w
-- 
-- 
-- Where w is normally 1
-- 
-- \<note>You must consider the members of the CoglMatrix structure read only,
-- and all matrix modifications must be done via the cogl_matrix API. This
-- allows Cogl to annotate the matrices internally. Violation of this will give
-- undefined results. If you need to initialize a matrix with a constant other
-- than the identity matrix you can use 'GI.Cogl.Structs.Matrix.matrixInitFromArray'.\<\/note>

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

module GI.Cogl.Structs.Matrix
    ( 

-- * Exported types
    Matrix(..)                              ,
    newZeroMatrix                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [copy]("GI.Cogl.Structs.Matrix#g:method:copy"), [free]("GI.Cogl.Structs.Matrix#g:method:free"), [frustum]("GI.Cogl.Structs.Matrix#g:method:frustum"), [initFromArray]("GI.Cogl.Structs.Matrix#g:method:initFromArray"), [initIdentity]("GI.Cogl.Structs.Matrix#g:method:initIdentity"), [initTranslation]("GI.Cogl.Structs.Matrix#g:method:initTranslation"), [isIdentity]("GI.Cogl.Structs.Matrix#g:method:isIdentity"), [lookAt]("GI.Cogl.Structs.Matrix#g:method:lookAt"), [multiply]("GI.Cogl.Structs.Matrix#g:method:multiply"), [ortho]("GI.Cogl.Structs.Matrix#g:method:ortho"), [perspective]("GI.Cogl.Structs.Matrix#g:method:perspective"), [rotate]("GI.Cogl.Structs.Matrix#g:method:rotate"), [scale]("GI.Cogl.Structs.Matrix#g:method:scale"), [transformPoint]("GI.Cogl.Structs.Matrix#g:method:transformPoint"), [translate]("GI.Cogl.Structs.Matrix#g:method:translate"), [transpose]("GI.Cogl.Structs.Matrix#g:method:transpose").
-- 
-- ==== Getters
-- [getArray]("GI.Cogl.Structs.Matrix#g:method:getArray"), [getInverse]("GI.Cogl.Structs.Matrix#g:method:getInverse").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveMatrixMethod                     ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    MatrixCopyMethodInfo                    ,
#endif
    matrixCopy                              ,


-- ** equal #method:equal#

    matrixEqual                             ,


-- ** free #method:free#

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


-- ** frustum #method:frustum#

#if defined(ENABLE_OVERLOADING)
    MatrixFrustumMethodInfo                 ,
#endif
    matrixFrustum                           ,


-- ** getArray #method:getArray#

#if defined(ENABLE_OVERLOADING)
    MatrixGetArrayMethodInfo                ,
#endif
    matrixGetArray                          ,


-- ** getInverse #method:getInverse#

#if defined(ENABLE_OVERLOADING)
    MatrixGetInverseMethodInfo              ,
#endif
    matrixGetInverse                        ,


-- ** initFromArray #method:initFromArray#

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


-- ** initIdentity #method:initIdentity#

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


-- ** initTranslation #method:initTranslation#

#if defined(ENABLE_OVERLOADING)
    MatrixInitTranslationMethodInfo         ,
#endif
    matrixInitTranslation                   ,


-- ** isIdentity #method:isIdentity#

#if defined(ENABLE_OVERLOADING)
    MatrixIsIdentityMethodInfo              ,
#endif
    matrixIsIdentity                        ,


-- ** lookAt #method:lookAt#

#if defined(ENABLE_OVERLOADING)
    MatrixLookAtMethodInfo                  ,
#endif
    matrixLookAt                            ,


-- ** multiply #method:multiply#

#if defined(ENABLE_OVERLOADING)
    MatrixMultiplyMethodInfo                ,
#endif
    matrixMultiply                          ,


-- ** ortho #method:ortho#

#if defined(ENABLE_OVERLOADING)
    MatrixOrthoMethodInfo                   ,
#endif
    matrixOrtho                             ,


-- ** perspective #method:perspective#

#if defined(ENABLE_OVERLOADING)
    MatrixPerspectiveMethodInfo             ,
#endif
    matrixPerspective                       ,


-- ** rotate #method:rotate#

#if defined(ENABLE_OVERLOADING)
    MatrixRotateMethodInfo                  ,
#endif
    matrixRotate                            ,


-- ** scale #method:scale#

#if defined(ENABLE_OVERLOADING)
    MatrixScaleMethodInfo                   ,
#endif
    matrixScale                             ,


-- ** transformPoint #method:transformPoint#

#if defined(ENABLE_OVERLOADING)
    MatrixTransformPointMethodInfo          ,
#endif
    matrixTransformPoint                    ,


-- ** translate #method:translate#

#if defined(ENABLE_OVERLOADING)
    MatrixTranslateMethodInfo               ,
#endif
    matrixTranslate                         ,


-- ** transpose #method:transpose#

#if defined(ENABLE_OVERLOADING)
    MatrixTransposeMethodInfo               ,
#endif
    matrixTranspose                         ,




 -- * Properties


-- ** ww #attr:ww#
-- | /No description available in the introspection data./

    getMatrixWw                             ,
#if defined(ENABLE_OVERLOADING)
    matrix_ww                               ,
#endif
    setMatrixWw                             ,


-- ** wx #attr:wx#
-- | /No description available in the introspection data./

    getMatrixWx                             ,
#if defined(ENABLE_OVERLOADING)
    matrix_wx                               ,
#endif
    setMatrixWx                             ,


-- ** wy #attr:wy#
-- | /No description available in the introspection data./

    getMatrixWy                             ,
#if defined(ENABLE_OVERLOADING)
    matrix_wy                               ,
#endif
    setMatrixWy                             ,


-- ** wz #attr:wz#
-- | /No description available in the introspection data./

    getMatrixWz                             ,
#if defined(ENABLE_OVERLOADING)
    matrix_wz                               ,
#endif
    setMatrixWz                             ,


-- ** xw #attr:xw#
-- | /No description available in the introspection data./

    getMatrixXw                             ,
#if defined(ENABLE_OVERLOADING)
    matrix_xw                               ,
#endif
    setMatrixXw                             ,


-- ** xx #attr:xx#
-- | /No description available in the introspection data./

    getMatrixXx                             ,
#if defined(ENABLE_OVERLOADING)
    matrix_xx                               ,
#endif
    setMatrixXx                             ,


-- ** xy #attr:xy#
-- | /No description available in the introspection data./

    getMatrixXy                             ,
#if defined(ENABLE_OVERLOADING)
    matrix_xy                               ,
#endif
    setMatrixXy                             ,


-- ** xz #attr:xz#
-- | /No description available in the introspection data./

    getMatrixXz                             ,
#if defined(ENABLE_OVERLOADING)
    matrix_xz                               ,
#endif
    setMatrixXz                             ,


-- ** yw #attr:yw#
-- | /No description available in the introspection data./

    getMatrixYw                             ,
#if defined(ENABLE_OVERLOADING)
    matrix_yw                               ,
#endif
    setMatrixYw                             ,


-- ** yx #attr:yx#
-- | /No description available in the introspection data./

    getMatrixYx                             ,
#if defined(ENABLE_OVERLOADING)
    matrix_yx                               ,
#endif
    setMatrixYx                             ,


-- ** yy #attr:yy#
-- | /No description available in the introspection data./

    getMatrixYy                             ,
#if defined(ENABLE_OVERLOADING)
    matrix_yy                               ,
#endif
    setMatrixYy                             ,


-- ** yz #attr:yz#
-- | /No description available in the introspection data./

    getMatrixYz                             ,
#if defined(ENABLE_OVERLOADING)
    matrix_yz                               ,
#endif
    setMatrixYz                             ,


-- ** zw #attr:zw#
-- | /No description available in the introspection data./

    getMatrixZw                             ,
#if defined(ENABLE_OVERLOADING)
    matrix_zw                               ,
#endif
    setMatrixZw                             ,


-- ** zx #attr:zx#
-- | /No description available in the introspection data./

    getMatrixZx                             ,
#if defined(ENABLE_OVERLOADING)
    matrix_zx                               ,
#endif
    setMatrixZx                             ,


-- ** zy #attr:zy#
-- | /No description available in the introspection data./

    getMatrixZy                             ,
#if defined(ENABLE_OVERLOADING)
    matrix_zy                               ,
#endif
    setMatrixZy                             ,


-- ** zz #attr:zz#
-- | /No description available in the introspection data./

    getMatrixZz                             ,
#if defined(ENABLE_OVERLOADING)
    matrix_zz                               ,
#endif
    setMatrixZz                             ,




    ) 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.Kind as DK
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 "cogl_matrix_get_gtype" c_cogl_matrix_get_gtype :: 
    IO GType

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

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

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_cogl_matrix_get_gtype
    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
        
    

-- | Construct a `Matrix` struct initialized to zero.
newZeroMatrix :: MonadIO m => m Matrix
newZeroMatrix :: forall (m :: * -> *). MonadIO m => m Matrix
newZeroMatrix = 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
$ Int -> IO (Ptr Matrix)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
152 IO (Ptr Matrix) -> (Ptr Matrix -> IO Matrix) -> IO Matrix
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Matrix -> Matrix) -> Ptr Matrix -> IO Matrix
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Matrix -> Matrix
Matrix

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


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

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

#if defined(ENABLE_OVERLOADING)
data MatrixXxFieldInfo
instance AttrInfo MatrixXxFieldInfo where
    type AttrBaseTypeConstraint MatrixXxFieldInfo = (~) Matrix
    type AttrAllowedOps MatrixXxFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MatrixXxFieldInfo = (~) Float
    type AttrTransferTypeConstraint MatrixXxFieldInfo = (~)Float
    type AttrTransferType MatrixXxFieldInfo = Float
    type AttrGetType MatrixXxFieldInfo = Float
    type AttrLabel MatrixXxFieldInfo = "xx"
    type AttrOrigin MatrixXxFieldInfo = Matrix
    attrGet = getMatrixXx
    attrSet = setMatrixXx
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.xx"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#g:attr:xx"
        })

matrix_xx :: AttrLabelProxy "xx"
matrix_xx = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data MatrixYxFieldInfo
instance AttrInfo MatrixYxFieldInfo where
    type AttrBaseTypeConstraint MatrixYxFieldInfo = (~) Matrix
    type AttrAllowedOps MatrixYxFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MatrixYxFieldInfo = (~) Float
    type AttrTransferTypeConstraint MatrixYxFieldInfo = (~)Float
    type AttrTransferType MatrixYxFieldInfo = Float
    type AttrGetType MatrixYxFieldInfo = Float
    type AttrLabel MatrixYxFieldInfo = "yx"
    type AttrOrigin MatrixYxFieldInfo = Matrix
    attrGet = getMatrixYx
    attrSet = setMatrixYx
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.yx"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#g:attr:yx"
        })

matrix_yx :: AttrLabelProxy "yx"
matrix_yx = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data MatrixZxFieldInfo
instance AttrInfo MatrixZxFieldInfo where
    type AttrBaseTypeConstraint MatrixZxFieldInfo = (~) Matrix
    type AttrAllowedOps MatrixZxFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MatrixZxFieldInfo = (~) Float
    type AttrTransferTypeConstraint MatrixZxFieldInfo = (~)Float
    type AttrTransferType MatrixZxFieldInfo = Float
    type AttrGetType MatrixZxFieldInfo = Float
    type AttrLabel MatrixZxFieldInfo = "zx"
    type AttrOrigin MatrixZxFieldInfo = Matrix
    attrGet = getMatrixZx
    attrSet = setMatrixZx
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.zx"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#g:attr:zx"
        })

matrix_zx :: AttrLabelProxy "zx"
matrix_zx = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data MatrixWxFieldInfo
instance AttrInfo MatrixWxFieldInfo where
    type AttrBaseTypeConstraint MatrixWxFieldInfo = (~) Matrix
    type AttrAllowedOps MatrixWxFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MatrixWxFieldInfo = (~) Float
    type AttrTransferTypeConstraint MatrixWxFieldInfo = (~)Float
    type AttrTransferType MatrixWxFieldInfo = Float
    type AttrGetType MatrixWxFieldInfo = Float
    type AttrLabel MatrixWxFieldInfo = "wx"
    type AttrOrigin MatrixWxFieldInfo = Matrix
    attrGet = getMatrixWx
    attrSet = setMatrixWx
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.wx"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#g:attr:wx"
        })

matrix_wx :: AttrLabelProxy "wx"
matrix_wx = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data MatrixXyFieldInfo
instance AttrInfo MatrixXyFieldInfo where
    type AttrBaseTypeConstraint MatrixXyFieldInfo = (~) Matrix
    type AttrAllowedOps MatrixXyFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MatrixXyFieldInfo = (~) Float
    type AttrTransferTypeConstraint MatrixXyFieldInfo = (~)Float
    type AttrTransferType MatrixXyFieldInfo = Float
    type AttrGetType MatrixXyFieldInfo = Float
    type AttrLabel MatrixXyFieldInfo = "xy"
    type AttrOrigin MatrixXyFieldInfo = Matrix
    attrGet = getMatrixXy
    attrSet = setMatrixXy
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.xy"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#g:attr:xy"
        })

matrix_xy :: AttrLabelProxy "xy"
matrix_xy = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data MatrixYyFieldInfo
instance AttrInfo MatrixYyFieldInfo where
    type AttrBaseTypeConstraint MatrixYyFieldInfo = (~) Matrix
    type AttrAllowedOps MatrixYyFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MatrixYyFieldInfo = (~) Float
    type AttrTransferTypeConstraint MatrixYyFieldInfo = (~)Float
    type AttrTransferType MatrixYyFieldInfo = Float
    type AttrGetType MatrixYyFieldInfo = Float
    type AttrLabel MatrixYyFieldInfo = "yy"
    type AttrOrigin MatrixYyFieldInfo = Matrix
    attrGet = getMatrixYy
    attrSet = setMatrixYy
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.yy"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#g:attr:yy"
        })

matrix_yy :: AttrLabelProxy "yy"
matrix_yy = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data MatrixZyFieldInfo
instance AttrInfo MatrixZyFieldInfo where
    type AttrBaseTypeConstraint MatrixZyFieldInfo = (~) Matrix
    type AttrAllowedOps MatrixZyFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MatrixZyFieldInfo = (~) Float
    type AttrTransferTypeConstraint MatrixZyFieldInfo = (~)Float
    type AttrTransferType MatrixZyFieldInfo = Float
    type AttrGetType MatrixZyFieldInfo = Float
    type AttrLabel MatrixZyFieldInfo = "zy"
    type AttrOrigin MatrixZyFieldInfo = Matrix
    attrGet = getMatrixZy
    attrSet = setMatrixZy
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.zy"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#g:attr:zy"
        })

matrix_zy :: AttrLabelProxy "zy"
matrix_zy = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data MatrixWyFieldInfo
instance AttrInfo MatrixWyFieldInfo where
    type AttrBaseTypeConstraint MatrixWyFieldInfo = (~) Matrix
    type AttrAllowedOps MatrixWyFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MatrixWyFieldInfo = (~) Float
    type AttrTransferTypeConstraint MatrixWyFieldInfo = (~)Float
    type AttrTransferType MatrixWyFieldInfo = Float
    type AttrGetType MatrixWyFieldInfo = Float
    type AttrLabel MatrixWyFieldInfo = "wy"
    type AttrOrigin MatrixWyFieldInfo = Matrix
    attrGet = getMatrixWy
    attrSet = setMatrixWy
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.wy"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#g:attr:wy"
        })

matrix_wy :: AttrLabelProxy "wy"
matrix_wy = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data MatrixXzFieldInfo
instance AttrInfo MatrixXzFieldInfo where
    type AttrBaseTypeConstraint MatrixXzFieldInfo = (~) Matrix
    type AttrAllowedOps MatrixXzFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MatrixXzFieldInfo = (~) Float
    type AttrTransferTypeConstraint MatrixXzFieldInfo = (~)Float
    type AttrTransferType MatrixXzFieldInfo = Float
    type AttrGetType MatrixXzFieldInfo = Float
    type AttrLabel MatrixXzFieldInfo = "xz"
    type AttrOrigin MatrixXzFieldInfo = Matrix
    attrGet = getMatrixXz
    attrSet = setMatrixXz
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.xz"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#g:attr:xz"
        })

matrix_xz :: AttrLabelProxy "xz"
matrix_xz = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data MatrixYzFieldInfo
instance AttrInfo MatrixYzFieldInfo where
    type AttrBaseTypeConstraint MatrixYzFieldInfo = (~) Matrix
    type AttrAllowedOps MatrixYzFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MatrixYzFieldInfo = (~) Float
    type AttrTransferTypeConstraint MatrixYzFieldInfo = (~)Float
    type AttrTransferType MatrixYzFieldInfo = Float
    type AttrGetType MatrixYzFieldInfo = Float
    type AttrLabel MatrixYzFieldInfo = "yz"
    type AttrOrigin MatrixYzFieldInfo = Matrix
    attrGet = getMatrixYz
    attrSet = setMatrixYz
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.yz"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#g:attr:yz"
        })

matrix_yz :: AttrLabelProxy "yz"
matrix_yz = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data MatrixZzFieldInfo
instance AttrInfo MatrixZzFieldInfo where
    type AttrBaseTypeConstraint MatrixZzFieldInfo = (~) Matrix
    type AttrAllowedOps MatrixZzFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MatrixZzFieldInfo = (~) Float
    type AttrTransferTypeConstraint MatrixZzFieldInfo = (~)Float
    type AttrTransferType MatrixZzFieldInfo = Float
    type AttrGetType MatrixZzFieldInfo = Float
    type AttrLabel MatrixZzFieldInfo = "zz"
    type AttrOrigin MatrixZzFieldInfo = Matrix
    attrGet = getMatrixZz
    attrSet = setMatrixZz
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.zz"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#g:attr:zz"
        })

matrix_zz :: AttrLabelProxy "zz"
matrix_zz = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data MatrixWzFieldInfo
instance AttrInfo MatrixWzFieldInfo where
    type AttrBaseTypeConstraint MatrixWzFieldInfo = (~) Matrix
    type AttrAllowedOps MatrixWzFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MatrixWzFieldInfo = (~) Float
    type AttrTransferTypeConstraint MatrixWzFieldInfo = (~)Float
    type AttrTransferType MatrixWzFieldInfo = Float
    type AttrGetType MatrixWzFieldInfo = Float
    type AttrLabel MatrixWzFieldInfo = "wz"
    type AttrOrigin MatrixWzFieldInfo = Matrix
    attrGet = getMatrixWz
    attrSet = setMatrixWz
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.wz"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#g:attr:wz"
        })

matrix_wz :: AttrLabelProxy "wz"
matrix_wz = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data MatrixXwFieldInfo
instance AttrInfo MatrixXwFieldInfo where
    type AttrBaseTypeConstraint MatrixXwFieldInfo = (~) Matrix
    type AttrAllowedOps MatrixXwFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MatrixXwFieldInfo = (~) Float
    type AttrTransferTypeConstraint MatrixXwFieldInfo = (~)Float
    type AttrTransferType MatrixXwFieldInfo = Float
    type AttrGetType MatrixXwFieldInfo = Float
    type AttrLabel MatrixXwFieldInfo = "xw"
    type AttrOrigin MatrixXwFieldInfo = Matrix
    attrGet = getMatrixXw
    attrSet = setMatrixXw
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.xw"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#g:attr:xw"
        })

matrix_xw :: AttrLabelProxy "xw"
matrix_xw = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data MatrixYwFieldInfo
instance AttrInfo MatrixYwFieldInfo where
    type AttrBaseTypeConstraint MatrixYwFieldInfo = (~) Matrix
    type AttrAllowedOps MatrixYwFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MatrixYwFieldInfo = (~) Float
    type AttrTransferTypeConstraint MatrixYwFieldInfo = (~)Float
    type AttrTransferType MatrixYwFieldInfo = Float
    type AttrGetType MatrixYwFieldInfo = Float
    type AttrLabel MatrixYwFieldInfo = "yw"
    type AttrOrigin MatrixYwFieldInfo = Matrix
    attrGet = getMatrixYw
    attrSet = setMatrixYw
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.yw"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#g:attr:yw"
        })

matrix_yw :: AttrLabelProxy "yw"
matrix_yw = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data MatrixZwFieldInfo
instance AttrInfo MatrixZwFieldInfo where
    type AttrBaseTypeConstraint MatrixZwFieldInfo = (~) Matrix
    type AttrAllowedOps MatrixZwFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MatrixZwFieldInfo = (~) Float
    type AttrTransferTypeConstraint MatrixZwFieldInfo = (~)Float
    type AttrTransferType MatrixZwFieldInfo = Float
    type AttrGetType MatrixZwFieldInfo = Float
    type AttrLabel MatrixZwFieldInfo = "zw"
    type AttrOrigin MatrixZwFieldInfo = Matrix
    attrGet = getMatrixZw
    attrSet = setMatrixZw
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.zw"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#g:attr:zw"
        })

matrix_zw :: AttrLabelProxy "zw"
matrix_zw = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data MatrixWwFieldInfo
instance AttrInfo MatrixWwFieldInfo where
    type AttrBaseTypeConstraint MatrixWwFieldInfo = (~) Matrix
    type AttrAllowedOps MatrixWwFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MatrixWwFieldInfo = (~) Float
    type AttrTransferTypeConstraint MatrixWwFieldInfo = (~)Float
    type AttrTransferType MatrixWwFieldInfo = Float
    type AttrGetType MatrixWwFieldInfo = Float
    type AttrLabel MatrixWwFieldInfo = "ww"
    type AttrOrigin MatrixWwFieldInfo = Matrix
    attrGet = getMatrixWw
    attrSet = setMatrixWw
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.ww"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#g:attr:ww"
        })

matrix_ww :: AttrLabelProxy "ww"
matrix_ww = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Matrix
type instance O.AttributeList Matrix = MatrixAttributeList
type MatrixAttributeList = ('[ '("xx", MatrixXxFieldInfo), '("yx", MatrixYxFieldInfo), '("zx", MatrixZxFieldInfo), '("wx", MatrixWxFieldInfo), '("xy", MatrixXyFieldInfo), '("yy", MatrixYyFieldInfo), '("zy", MatrixZyFieldInfo), '("wy", MatrixWyFieldInfo), '("xz", MatrixXzFieldInfo), '("yz", MatrixYzFieldInfo), '("zz", MatrixZzFieldInfo), '("wz", MatrixWzFieldInfo), '("xw", MatrixXwFieldInfo), '("yw", MatrixYwFieldInfo), '("zw", MatrixZwFieldInfo), '("ww", MatrixWwFieldInfo)] :: [(Symbol, DK.Type)])
#endif

-- method Matrix::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A 4x4 transformation matrix you want to copy"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Cogl" , name = "Matrix" })
-- throws : False
-- Skip return : False

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

-- | Allocates a new t'GI.Cogl.Structs.Matrix.Matrix' on the heap and initializes it with
-- the same values as /@matrix@/.
-- 
-- /Since: 1.6/
matrixCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: A 4x4 transformation matrix you want to copy
    -> m Matrix
    -- ^ __Returns:__ A newly allocated t'GI.Cogl.Structs.Matrix.Matrix' which
    -- should be freed using 'GI.Cogl.Structs.Matrix.matrixFree'
matrixCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Matrix -> m Matrix
matrixCopy 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)
cogl_matrix_copy Ptr Matrix
matrix'
    Text -> Ptr Matrix -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"matrixCopy" 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 ()
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 MatrixCopyMethodInfo
instance (signature ~ (m Matrix), MonadIO m) => O.OverloadedMethod MatrixCopyMethodInfo Matrix signature where
    overloadedMethod = matrixCopy

instance O.OverloadedMethodInfo MatrixCopyMethodInfo Matrix where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.matrixCopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#v:matrixCopy"
        })


#endif

-- method Matrix::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A 4x4 transformation matrix you want to free"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Frees a t'GI.Cogl.Structs.Matrix.Matrix' that was previously allocated via a call to
-- 'GI.Cogl.Structs.Matrix.matrixCopy'.
-- 
-- /Since: 1.6/
matrixFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: A 4x4 transformation matrix you want to free
    -> 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 ()
cogl_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.Cogl.Structs.Matrix.matrixFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#v:matrixFree"
        })


#endif

-- method Matrix::frustum
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A 4x4 transformation matrix"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "left"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "X position of the left clipping plane where it\n  intersects the near clipping plane"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "right"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "X position of the right clipping plane where it\n  intersects the near clipping plane"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bottom"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Y position of the bottom clipping plane where it\n  intersects the near clipping plane"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "top"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Y position of the top clipping plane where it intersects\n  the near clipping plane"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "z_near"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The distance to the near clipping plane (Must be positive)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "z_far"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The distance to the far clipping plane (Must be positive)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_matrix_frustum" cogl_matrix_frustum :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Cogl", name = "Matrix"})
    CFloat ->                               -- left : TBasicType TFloat
    CFloat ->                               -- right : TBasicType TFloat
    CFloat ->                               -- bottom : TBasicType TFloat
    CFloat ->                               -- top : TBasicType TFloat
    CFloat ->                               -- z_near : TBasicType TFloat
    CFloat ->                               -- z_far : TBasicType TFloat
    IO ()

-- | Multiplies /@matrix@/ by the given frustum perspective matrix.
matrixFrustum ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: A 4x4 transformation matrix
    -> Float
    -- ^ /@left@/: X position of the left clipping plane where it
    --   intersects the near clipping plane
    -> Float
    -- ^ /@right@/: X position of the right clipping plane where it
    --   intersects the near clipping plane
    -> Float
    -- ^ /@bottom@/: Y position of the bottom clipping plane where it
    --   intersects the near clipping plane
    -> Float
    -- ^ /@top@/: Y position of the top clipping plane where it intersects
    --   the near clipping plane
    -> Float
    -- ^ /@zNear@/: The distance to the near clipping plane (Must be positive)
    -> Float
    -- ^ /@zFar@/: The distance to the far clipping plane (Must be positive)
    -> m ()
matrixFrustum :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Matrix
-> Float -> Float -> Float -> Float -> Float -> Float -> m ()
matrixFrustum Matrix
matrix Float
left Float
right Float
bottom Float
top Float
zNear Float
zFar = 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
    let left' :: CFloat
left' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
left
    let right' :: CFloat
right' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
right
    let bottom' :: CFloat
bottom' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
bottom
    let top' :: CFloat
top' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
top
    let zNear' :: CFloat
zNear' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
zNear
    let zFar' :: CFloat
zFar' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
zFar
    Ptr Matrix
-> CFloat
-> CFloat
-> CFloat
-> CFloat
-> CFloat
-> CFloat
-> IO ()
cogl_matrix_frustum Ptr Matrix
matrix' CFloat
left' CFloat
right' CFloat
bottom' CFloat
top' CFloat
zNear' CFloat
zFar'
    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 MatrixFrustumMethodInfo
instance (signature ~ (Float -> Float -> Float -> Float -> Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod MatrixFrustumMethodInfo Matrix signature where
    overloadedMethod = matrixFrustum

instance O.OverloadedMethodInfo MatrixFrustumMethodInfo Matrix where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.matrixFrustum",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#v:matrixFrustum"
        })


#endif

-- method Matrix::get_array
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A 4x4 transformation matrix"
--                 , 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 "cogl_matrix_get_array" cogl_matrix_get_array :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Cogl", name = "Matrix"})
    IO CFloat

-- | Casts /@matrix@/ to a float array which can be directly passed to OpenGL.
matrixGetArray ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: A 4x4 transformation matrix
    -> m Float
    -- ^ __Returns:__ a pointer to the float array
matrixGetArray :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Matrix -> m Float
matrixGetArray Matrix
matrix = IO Float -> m Float
forall a. IO a -> m a
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 Matrix
matrix' <- Matrix -> IO (Ptr Matrix)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Matrix
matrix
    CFloat
result <- Ptr Matrix -> IO CFloat
cogl_matrix_get_array Ptr Matrix
matrix'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
matrix
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

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

instance O.OverloadedMethodInfo MatrixGetArrayMethodInfo Matrix where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.matrixGetArray",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#v:matrixGetArray"
        })


#endif

-- method Matrix::get_inverse
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A 4x4 transformation matrix"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "inverse"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Matrix" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The destination for a 4x4 inverse transformation matrix"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "cogl_matrix_get_inverse" cogl_matrix_get_inverse :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Cogl", name = "Matrix"})
    Ptr Matrix ->                           -- inverse : TInterface (Name {namespace = "Cogl", name = "Matrix"})
    IO Int32

-- | Gets the inverse transform of a given matrix and uses it to initialize
-- a new t'GI.Cogl.Structs.Matrix.Matrix'.
-- 
-- \<note>Although the first parameter is annotated as const to indicate
-- that the transform it represents isn\'t modified this function may
-- technically save a copy of the inverse transform within the given
-- t'GI.Cogl.Structs.Matrix.Matrix' so that subsequent requests for the inverse transform may
-- avoid costly inversion calculations.\<\/note>
-- 
-- /Since: 1.2/
matrixGetInverse ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: A 4x4 transformation matrix
    -> m ((Int32, Matrix))
    -- ^ __Returns:__ 'P.True' if the inverse was successfully calculated or 'P.False'
    --   for degenerate transformations that can\'t be inverted (in this case the
    --   /@inverse@/ matrix will simply be initialized with the identity matrix)
matrixGetInverse :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Matrix -> m (Int32, Matrix)
matrixGetInverse Matrix
matrix = IO (Int32, Matrix) -> m (Int32, Matrix)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Matrix) -> m (Int32, Matrix))
-> IO (Int32, Matrix) -> m (Int32, 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
inverse <- Int -> IO (Ptr Matrix)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
152 :: IO (Ptr Matrix)
    Int32
result <- Ptr Matrix -> Ptr Matrix -> IO Int32
cogl_matrix_get_inverse Ptr Matrix
matrix' Ptr Matrix
inverse
    Matrix
inverse' <- ((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
inverse
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
matrix
    (Int32, Matrix) -> IO (Int32, Matrix)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, Matrix
inverse')

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

instance O.OverloadedMethodInfo MatrixGetInverseMethodInfo Matrix where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.matrixGetInverse",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#v:matrixGetInverse"
        })


#endif

-- method Matrix::init_from_array
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A 4x4 transformation matrix"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "array"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A linear array of 16 floats (column-major order)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_matrix_init_from_array" cogl_matrix_init_from_array :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Cogl", name = "Matrix"})
    CFloat ->                               -- array : TBasicType TFloat
    IO ()

-- | Initializes /@matrix@/ with the contents of /@array@/
matrixInitFromArray ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: A 4x4 transformation matrix
    -> Float
    -- ^ /@array@/: A linear array of 16 floats (column-major order)
    -> m ()
matrixInitFromArray :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Matrix -> Float -> m ()
matrixInitFromArray Matrix
matrix Float
array = 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
    let array' :: CFloat
array' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
array
    Ptr Matrix -> CFloat -> IO ()
cogl_matrix_init_from_array Ptr Matrix
matrix' CFloat
array'
    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 MatrixInitFromArrayMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m) => O.OverloadedMethod MatrixInitFromArrayMethodInfo Matrix signature where
    overloadedMethod = matrixInitFromArray

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


#endif

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

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

-- | Resets matrix to the identity matrix:
-- 
-- >
-- >  .xx=1; .xy=0; .xz=0; .xw=0;
-- >  .yx=0; .yy=1; .yz=0; .yw=0;
-- >  .zx=0; .zy=0; .zz=1; .zw=0;
-- >  .wx=0; .wy=0; .wz=0; .ww=1;
matrixInitIdentity ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: A 4x4 transformation matrix
    -> m ()
matrixInitIdentity :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Matrix -> m ()
matrixInitIdentity 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 ()
cogl_matrix_init_identity 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 MatrixInitIdentityMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod MatrixInitIdentityMethodInfo Matrix signature where
    overloadedMethod = matrixInitIdentity

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


#endif

-- method Matrix::init_translation
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A 4x4 transformation matrix"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tx"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "x coordinate of the translation vector"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ty"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "y coordinate of the translation vector"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tz"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "z coordinate of the translation vector"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_matrix_init_translation" cogl_matrix_init_translation :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Cogl", name = "Matrix"})
    CFloat ->                               -- tx : TBasicType TFloat
    CFloat ->                               -- ty : TBasicType TFloat
    CFloat ->                               -- tz : TBasicType TFloat
    IO ()

-- | Resets matrix to the (tx, ty, tz) translation matrix:
-- 
-- >
-- >  .xx=1; .xy=0; .xz=0; .xw=tx;
-- >  .yx=0; .yy=1; .yz=0; .yw=ty;
-- >  .zx=0; .zy=0; .zz=1; .zw=tz;
-- >  .wx=0; .wy=0; .wz=0; .ww=1;
-- 
-- 
-- /Since: 2.0/
matrixInitTranslation ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: A 4x4 transformation matrix
    -> Float
    -- ^ /@tx@/: x coordinate of the translation vector
    -> Float
    -- ^ /@ty@/: y coordinate of the translation vector
    -> Float
    -- ^ /@tz@/: z coordinate of the translation vector
    -> m ()
matrixInitTranslation :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Matrix -> Float -> Float -> Float -> m ()
matrixInitTranslation Matrix
matrix Float
tx Float
ty Float
tz = 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
    let tx' :: CFloat
tx' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
tx
    let ty' :: CFloat
ty' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
ty
    let tz' :: CFloat
tz' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
tz
    Ptr Matrix -> CFloat -> CFloat -> CFloat -> IO ()
cogl_matrix_init_translation Ptr Matrix
matrix' CFloat
tx' CFloat
ty' CFloat
tz'
    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 MatrixInitTranslationMethodInfo
instance (signature ~ (Float -> Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod MatrixInitTranslationMethodInfo Matrix signature where
    overloadedMethod = matrixInitTranslation

instance O.OverloadedMethodInfo MatrixInitTranslationMethodInfo Matrix where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.matrixInitTranslation",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#v:matrixInitTranslation"
        })


#endif

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

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

-- | Determines if the given matrix is an identity matrix.
-- 
-- /Since: 1.8/
matrixIsIdentity ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: A t'GI.Cogl.Structs.Matrix.Matrix'
    -> m Int32
    -- ^ __Returns:__ 'P.True' if /@matrix@/ is an identity matrix else 'P.False'
matrixIsIdentity :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Matrix -> m Int32
matrixIsIdentity Matrix
matrix = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
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
    Int32
result <- Ptr Matrix -> IO Int32
cogl_matrix_is_identity Ptr Matrix
matrix'
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
matrix
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

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

instance O.OverloadedMethodInfo MatrixIsIdentityMethodInfo Matrix where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.matrixIsIdentity",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#v:matrixIsIdentity"
        })


#endif

-- method Matrix::look_at
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A 4x4 transformation matrix"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "eye_position_x"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The X coordinate to look from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "eye_position_y"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The Y coordinate to look from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "eye_position_z"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The Z coordinate to look from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object_x"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The X coordinate of the object to look at"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object_y"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The Y coordinate of the object to look at"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object_z"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The Z coordinate of the object to look at"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "world_up_x"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The X component of the world's up direction vector"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "world_up_y"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The Y component of the world's up direction vector"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "world_up_z"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The Z component of the world's up direction vector"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_matrix_look_at" cogl_matrix_look_at :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Cogl", name = "Matrix"})
    CFloat ->                               -- eye_position_x : TBasicType TFloat
    CFloat ->                               -- eye_position_y : TBasicType TFloat
    CFloat ->                               -- eye_position_z : TBasicType TFloat
    CFloat ->                               -- object_x : TBasicType TFloat
    CFloat ->                               -- object_y : TBasicType TFloat
    CFloat ->                               -- object_z : TBasicType TFloat
    CFloat ->                               -- world_up_x : TBasicType TFloat
    CFloat ->                               -- world_up_y : TBasicType TFloat
    CFloat ->                               -- world_up_z : TBasicType TFloat
    IO ()

-- | Applies a view transform /@matrix@/ that positions the camera at
-- the coordinate (/@eyePositionX@/, /@eyePositionY@/, /@eyePositionZ@/)
-- looking towards an object at the coordinate (/@objectX@/, /@objectY@/,
-- /@objectZ@/). The top of the camera is aligned to the given world up
-- vector, which is normally simply (0, 1, 0) to map up to the
-- positive direction of the y axis.
-- 
-- Because there is a lot of missleading documentation online for
-- gluLookAt regarding the up vector we want to try and be a bit
-- clearer here.
-- 
-- The up vector should simply be relative to your world coordinates
-- and does not need to change as you move the eye and object
-- positions.  Many online sources may claim that the up vector needs
-- to be perpendicular to the vector between the eye and object
-- position (partly because the man page is somewhat missleading) but
-- that is not necessary for this function.
-- 
-- \<note>You should never look directly along the world-up
-- vector.\<\/note>
-- 
-- \<note>It is assumed you are using a typical projection matrix where
-- your origin maps to the center of your viewport.\<\/note>
-- 
-- \<note>Almost always when you use this function it should be the first
-- transform applied to a new modelview transform\<\/note>
-- 
-- /Since: 1.8/
matrixLookAt ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: A 4x4 transformation matrix
    -> Float
    -- ^ /@eyePositionX@/: The X coordinate to look from
    -> Float
    -- ^ /@eyePositionY@/: The Y coordinate to look from
    -> Float
    -- ^ /@eyePositionZ@/: The Z coordinate to look from
    -> Float
    -- ^ /@objectX@/: The X coordinate of the object to look at
    -> Float
    -- ^ /@objectY@/: The Y coordinate of the object to look at
    -> Float
    -- ^ /@objectZ@/: The Z coordinate of the object to look at
    -> Float
    -- ^ /@worldUpX@/: The X component of the world\'s up direction vector
    -> Float
    -- ^ /@worldUpY@/: The Y component of the world\'s up direction vector
    -> Float
    -- ^ /@worldUpZ@/: The Z component of the world\'s up direction vector
    -> m ()
matrixLookAt :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Matrix
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> m ()
matrixLookAt Matrix
matrix Float
eyePositionX Float
eyePositionY Float
eyePositionZ Float
objectX Float
objectY Float
objectZ Float
worldUpX Float
worldUpY Float
worldUpZ = 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
    let eyePositionX' :: CFloat
eyePositionX' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
eyePositionX
    let eyePositionY' :: CFloat
eyePositionY' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
eyePositionY
    let eyePositionZ' :: CFloat
eyePositionZ' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
eyePositionZ
    let objectX' :: CFloat
objectX' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
objectX
    let objectY' :: CFloat
objectY' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
objectY
    let objectZ' :: CFloat
objectZ' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
objectZ
    let worldUpX' :: CFloat
worldUpX' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
worldUpX
    let worldUpY' :: CFloat
worldUpY' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
worldUpY
    let worldUpZ' :: CFloat
worldUpZ' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
worldUpZ
    Ptr Matrix
-> CFloat
-> CFloat
-> CFloat
-> CFloat
-> CFloat
-> CFloat
-> CFloat
-> CFloat
-> CFloat
-> IO ()
cogl_matrix_look_at Ptr Matrix
matrix' CFloat
eyePositionX' CFloat
eyePositionY' CFloat
eyePositionZ' CFloat
objectX' CFloat
objectY' CFloat
objectZ' CFloat
worldUpX' CFloat
worldUpY' CFloat
worldUpZ'
    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 MatrixLookAtMethodInfo
instance (signature ~ (Float -> Float -> Float -> Float -> Float -> Float -> Float -> Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod MatrixLookAtMethodInfo Matrix signature where
    overloadedMethod = matrixLookAt

instance O.OverloadedMethodInfo MatrixLookAtMethodInfo Matrix where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.matrixLookAt",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#v:matrixLookAt"
        })


#endif

-- method Matrix::multiply
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The address of a 4x4 matrix to store the result in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "a"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A 4x4 transformation matrix"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "b"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A 4x4 transformation matrix"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Multiplies the two supplied matrices together and stores
-- the resulting matrix inside /@result@/.
-- 
-- \<note>It is possible to multiply the /@a@/ matrix in-place, so
-- /@result@/ can be equal to /@a@/ but can\'t be equal to /@b@/.\<\/note>
matrixMultiply ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@result@/: The address of a 4x4 matrix to store the result in
    -> Matrix
    -- ^ /@a@/: A 4x4 transformation matrix
    -> Matrix
    -- ^ /@b@/: A 4x4 transformation matrix
    -> m ()
matrixMultiply :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Matrix -> Matrix -> Matrix -> m ()
matrixMultiply Matrix
result_ Matrix
a Matrix
b = 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
result_' <- Matrix -> IO (Ptr Matrix)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Matrix
result_
    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 -> Ptr Matrix -> Ptr Matrix -> IO ()
cogl_matrix_multiply Ptr Matrix
result_' Ptr Matrix
a' Ptr Matrix
b'
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
result_
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
a
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
b
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo MatrixMultiplyMethodInfo Matrix where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.matrixMultiply",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#v:matrixMultiply"
        })


#endif

-- method Matrix::ortho
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A 4x4 transformation matrix"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "left"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The coordinate for the left clipping plane"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "right"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The coordinate for the right clipping plane"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bottom"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The coordinate for the bottom clipping plane"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "top"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The coordinate for the top clipping plane"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "near"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The <emphasis>distance</emphasis> to the near clipping\n  plane (will be <emphasis>negative</emphasis> if the plane is\n  behind the viewer)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "far"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The <emphasis>distance</emphasis> to the far clipping\n  plane (will be <emphasis>negative</emphasis> if the plane is\n  behind the viewer)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_matrix_ortho" cogl_matrix_ortho :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Cogl", name = "Matrix"})
    CFloat ->                               -- left : TBasicType TFloat
    CFloat ->                               -- right : TBasicType TFloat
    CFloat ->                               -- bottom : TBasicType TFloat
    CFloat ->                               -- top : TBasicType TFloat
    CFloat ->                               -- near : TBasicType TFloat
    CFloat ->                               -- far : TBasicType TFloat
    IO ()

{-# DEPRECATED matrixOrtho ["(Since version 1.10)","Use @/cogl_matrix_orthographic()/@"] #-}
-- | Multiplies /@matrix@/ by a parallel projection matrix.
matrixOrtho ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: A 4x4 transformation matrix
    -> Float
    -- ^ /@left@/: The coordinate for the left clipping plane
    -> Float
    -- ^ /@right@/: The coordinate for the right clipping plane
    -> Float
    -- ^ /@bottom@/: The coordinate for the bottom clipping plane
    -> Float
    -- ^ /@top@/: The coordinate for the top clipping plane
    -> Float
    -- ^ /@near@/: The \<emphasis>distance\<\/emphasis> to the near clipping
    --   plane (will be \<emphasis>negative\<\/emphasis> if the plane is
    --   behind the viewer)
    -> Float
    -- ^ /@far@/: The \<emphasis>distance\<\/emphasis> to the far clipping
    --   plane (will be \<emphasis>negative\<\/emphasis> if the plane is
    --   behind the viewer)
    -> m ()
matrixOrtho :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Matrix
-> Float -> Float -> Float -> Float -> Float -> Float -> m ()
matrixOrtho Matrix
matrix Float
left Float
right Float
bottom Float
top Float
near Float
far = 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
    let left' :: CFloat
left' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
left
    let right' :: CFloat
right' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
right
    let bottom' :: CFloat
bottom' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
bottom
    let top' :: CFloat
top' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
top
    let near' :: CFloat
near' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
near
    let far' :: CFloat
far' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
far
    Ptr Matrix
-> CFloat
-> CFloat
-> CFloat
-> CFloat
-> CFloat
-> CFloat
-> IO ()
cogl_matrix_ortho Ptr Matrix
matrix' CFloat
left' CFloat
right' CFloat
bottom' CFloat
top' CFloat
near' CFloat
far'
    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 MatrixOrthoMethodInfo
instance (signature ~ (Float -> Float -> Float -> Float -> Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod MatrixOrthoMethodInfo Matrix signature where
    overloadedMethod = matrixOrtho

instance O.OverloadedMethodInfo MatrixOrthoMethodInfo Matrix where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.matrixOrtho",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#v:matrixOrtho"
        })


#endif

-- method Matrix::perspective
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A 4x4 transformation matrix"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fov_y"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Vertical field of view angle in degrees."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "aspect"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The (width over height) aspect ratio for display"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "z_near"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The distance to the near clipping plane (Must be positive,\n  and must not be 0)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "z_far"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The distance to the far clipping plane (Must be positive)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_matrix_perspective" cogl_matrix_perspective :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Cogl", name = "Matrix"})
    CFloat ->                               -- fov_y : TBasicType TFloat
    CFloat ->                               -- aspect : TBasicType TFloat
    CFloat ->                               -- z_near : TBasicType TFloat
    CFloat ->                               -- z_far : TBasicType TFloat
    IO ()

-- | Multiplies /@matrix@/ by the described perspective matrix
-- 
-- \<note>You should be careful not to have to great a /@zFar@/ \/ /@zNear@/
-- ratio since that will reduce the effectiveness of depth testing
-- since there wont be enough precision to identify the depth of
-- objects near to each other.\<\/note>
matrixPerspective ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: A 4x4 transformation matrix
    -> Float
    -- ^ /@fovY@/: Vertical field of view angle in degrees.
    -> Float
    -- ^ /@aspect@/: The (width over height) aspect ratio for display
    -> Float
    -- ^ /@zNear@/: The distance to the near clipping plane (Must be positive,
    --   and must not be 0)
    -> Float
    -- ^ /@zFar@/: The distance to the far clipping plane (Must be positive)
    -> m ()
matrixPerspective :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Matrix -> Float -> Float -> Float -> Float -> m ()
matrixPerspective Matrix
matrix Float
fovY Float
aspect Float
zNear Float
zFar = 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
    let fovY' :: CFloat
fovY' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
fovY
    let aspect' :: CFloat
aspect' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
aspect
    let zNear' :: CFloat
zNear' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
zNear
    let zFar' :: CFloat
zFar' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
zFar
    Ptr Matrix -> CFloat -> CFloat -> CFloat -> CFloat -> IO ()
cogl_matrix_perspective Ptr Matrix
matrix' CFloat
fovY' CFloat
aspect' CFloat
zNear' CFloat
zFar'
    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 MatrixPerspectiveMethodInfo
instance (signature ~ (Float -> Float -> Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod MatrixPerspectiveMethodInfo Matrix signature where
    overloadedMethod = matrixPerspective

instance O.OverloadedMethodInfo MatrixPerspectiveMethodInfo Matrix where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.matrixPerspective",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#v:matrixPerspective"
        })


#endif

-- method Matrix::rotate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A 4x4 transformation matrix"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "angle"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The angle you want to rotate in degrees"
--                 , 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 "X component of your rotation 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 "Y component of your rotation 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 "Z component of your rotation vector"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_matrix_rotate" cogl_matrix_rotate :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Cogl", name = "Matrix"})
    CFloat ->                               -- angle : TBasicType TFloat
    CFloat ->                               -- x : TBasicType TFloat
    CFloat ->                               -- y : TBasicType TFloat
    CFloat ->                               -- z : TBasicType TFloat
    IO ()

-- | Multiplies /@matrix@/ with a rotation matrix that applies a rotation
-- of /@angle@/ degrees around the specified 3D vector.
matrixRotate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: A 4x4 transformation matrix
    -> Float
    -- ^ /@angle@/: The angle you want to rotate in degrees
    -> Float
    -- ^ /@x@/: X component of your rotation vector
    -> Float
    -- ^ /@y@/: Y component of your rotation vector
    -> Float
    -- ^ /@z@/: Z component of your rotation vector
    -> m ()
matrixRotate :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Matrix -> Float -> Float -> Float -> Float -> m ()
matrixRotate Matrix
matrix Float
angle Float
x Float
y Float
z = 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
    let angle' :: CFloat
angle' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
angle
    let x' :: CFloat
x' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x
    let y' :: CFloat
y' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y
    let z' :: CFloat
z' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
z
    Ptr Matrix -> CFloat -> CFloat -> CFloat -> CFloat -> IO ()
cogl_matrix_rotate Ptr Matrix
matrix' CFloat
angle' CFloat
x' CFloat
y' CFloat
z'
    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 MatrixRotateMethodInfo
instance (signature ~ (Float -> Float -> Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod MatrixRotateMethodInfo Matrix signature where
    overloadedMethod = matrixRotate

instance O.OverloadedMethodInfo MatrixRotateMethodInfo Matrix where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.matrixRotate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#v:matrixRotate"
        })


#endif

-- method Matrix::scale
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A 4x4 transformation matrix"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sx"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The X scale factor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sy"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The Y scale factor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sz"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The Z scale factor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_matrix_scale" cogl_matrix_scale :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Cogl", name = "Matrix"})
    CFloat ->                               -- sx : TBasicType TFloat
    CFloat ->                               -- sy : TBasicType TFloat
    CFloat ->                               -- sz : TBasicType TFloat
    IO ()

-- | Multiplies /@matrix@/ with a transform matrix that scales along the X,
-- Y and Z axis.
matrixScale ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: A 4x4 transformation matrix
    -> Float
    -- ^ /@sx@/: The X scale factor
    -> Float
    -- ^ /@sy@/: The Y scale factor
    -> Float
    -- ^ /@sz@/: The Z scale factor
    -> m ()
matrixScale :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Matrix -> Float -> Float -> Float -> m ()
matrixScale Matrix
matrix Float
sx Float
sy Float
sz = 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
    let sx' :: CFloat
sx' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
sx
    let sy' :: CFloat
sy' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
sy
    let sz' :: CFloat
sz' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
sz
    Ptr Matrix -> CFloat -> CFloat -> CFloat -> IO ()
cogl_matrix_scale Ptr Matrix
matrix' CFloat
sx' CFloat
sy' CFloat
sz'
    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 MatrixScaleMethodInfo
instance (signature ~ (Float -> Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod MatrixScaleMethodInfo Matrix signature where
    overloadedMethod = matrixScale

instance O.OverloadedMethodInfo MatrixScaleMethodInfo Matrix where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.matrixScale",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#v:matrixScale"
        })


#endif

-- method Matrix::transform_point
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A 4x4 transformation matrix"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TFloat
--           , direction = DirectionInout
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The X component of your points position"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TFloat
--           , direction = DirectionInout
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The Y component of your points position"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "z"
--           , argType = TBasicType TFloat
--           , direction = DirectionInout
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The Z component of your points position"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "w"
--           , argType = TBasicType TFloat
--           , direction = DirectionInout
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The W component of your points position"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_matrix_transform_point" cogl_matrix_transform_point :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Cogl", name = "Matrix"})
    Ptr CFloat ->                           -- x : TBasicType TFloat
    Ptr CFloat ->                           -- y : TBasicType TFloat
    Ptr CFloat ->                           -- z : TBasicType TFloat
    Ptr CFloat ->                           -- w : TBasicType TFloat
    IO ()

-- | Transforms a point whos position is given and returned as four float
-- components.
matrixTransformPoint ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: A 4x4 transformation matrix
    -> Float
    -- ^ /@x@/: The X component of your points position
    -> Float
    -- ^ /@y@/: The Y component of your points position
    -> Float
    -- ^ /@z@/: The Z component of your points position
    -> Float
    -- ^ /@w@/: The W component of your points position
    -> m ((Float, Float, Float, Float))
matrixTransformPoint :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Matrix
-> Float
-> Float
-> Float
-> Float
-> m (Float, Float, Float, Float)
matrixTransformPoint Matrix
matrix Float
x Float
y Float
z Float
w = IO (Float, Float, Float, Float) -> m (Float, Float, Float, Float)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Float, Float, Float, Float) -> m (Float, Float, Float, Float))
-> IO (Float, Float, Float, Float)
-> m (Float, Float, Float, Float)
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
    let x' :: CFloat
x' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x
    Ptr CFloat
x'' <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CFloat
x'' CFloat
x'
    let y' :: CFloat
y' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y
    Ptr CFloat
y'' <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CFloat
y'' CFloat
y'
    let z' :: CFloat
z' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
z
    Ptr CFloat
z'' <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CFloat
z'' CFloat
z'
    let w' :: CFloat
w' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
w
    Ptr CFloat
w'' <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CFloat
w'' CFloat
w'
    Ptr Matrix
-> Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> IO ()
cogl_matrix_transform_point Ptr Matrix
matrix' Ptr CFloat
x'' Ptr CFloat
y'' Ptr CFloat
z'' Ptr CFloat
w''
    CFloat
x''' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
x''
    let x'''' :: Float
x'''' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
x'''
    CFloat
y''' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
y''
    let y'''' :: Float
y'''' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
y'''
    CFloat
z''' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
z''
    let z'''' :: Float
z'''' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
z'''
    CFloat
w''' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
w''
    let w'''' :: Float
w'''' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
w'''
    Matrix -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Matrix
matrix
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
x''
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
y''
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
z''
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
w''
    (Float, Float, Float, Float) -> IO (Float, Float, Float, Float)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
x'''', Float
y'''', Float
z'''', Float
w'''')

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

instance O.OverloadedMethodInfo MatrixTransformPointMethodInfo Matrix where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.matrixTransformPoint",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#v:matrixTransformPoint"
        })


#endif

-- method Matrix::translate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A 4x4 transformation matrix"
--                 , 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 translation you want to apply"
--                 , 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 translation you want to apply"
--                 , 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 translation you want to apply"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_matrix_translate" cogl_matrix_translate :: 
    Ptr Matrix ->                           -- matrix : TInterface (Name {namespace = "Cogl", name = "Matrix"})
    CFloat ->                               -- x : TBasicType TFloat
    CFloat ->                               -- y : TBasicType TFloat
    CFloat ->                               -- z : TBasicType TFloat
    IO ()

-- | Multiplies /@matrix@/ with a transform matrix that translates along
-- the X, Y and Z axis.
matrixTranslate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: A 4x4 transformation matrix
    -> Float
    -- ^ /@x@/: The X translation you want to apply
    -> Float
    -- ^ /@y@/: The Y translation you want to apply
    -> Float
    -- ^ /@z@/: The Z translation you want to apply
    -> m ()
matrixTranslate :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Matrix -> Float -> Float -> Float -> m ()
matrixTranslate Matrix
matrix Float
x Float
y Float
z = 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
    let x' :: CFloat
x' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x
    let y' :: CFloat
y' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y
    let z' :: CFloat
z' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
z
    Ptr Matrix -> CFloat -> CFloat -> CFloat -> IO ()
cogl_matrix_translate Ptr Matrix
matrix' CFloat
x' CFloat
y' CFloat
z'
    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 MatrixTranslateMethodInfo
instance (signature ~ (Float -> Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod MatrixTranslateMethodInfo Matrix signature where
    overloadedMethod = matrixTranslate

instance O.OverloadedMethodInfo MatrixTranslateMethodInfo Matrix where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.matrixTranslate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#v:matrixTranslate"
        })


#endif

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

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

-- | Replaces /@matrix@/ with its transpose. Ie, every element (i,j) in the
-- new matrix is taken from element (j,i) in the old matrix.
-- 
-- /Since: 1.10/
matrixTranspose ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Matrix
    -- ^ /@matrix@/: A t'GI.Cogl.Structs.Matrix.Matrix'
    -> m ()
matrixTranspose :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Matrix -> m ()
matrixTranspose 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 ()
cogl_matrix_transpose 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 MatrixTransposeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod MatrixTransposeMethodInfo Matrix signature where
    overloadedMethod = matrixTranspose

instance O.OverloadedMethodInfo MatrixTransposeMethodInfo Matrix where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Structs.Matrix.matrixTranspose",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Structs-Matrix.html#v:matrixTranspose"
        })


#endif

-- method Matrix::equal
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "v1"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A 4x4 transformation matrix"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "v2"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A 4x4 transformation matrix"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "cogl_matrix_equal" cogl_matrix_equal :: 
    Ptr () ->                               -- v1 : TBasicType TPtr
    Ptr () ->                               -- v2 : TBasicType TPtr
    IO Int32

-- | Compares two matrices to see if they represent the same
-- transformation. Although internally the matrices may have different
-- annotations associated with them and may potentially have a cached
-- inverse matrix these are not considered in the comparison.
-- 
-- /Since: 1.4/
matrixEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ptr ()
    -- ^ /@v1@/: A 4x4 transformation matrix
    -> Ptr ()
    -- ^ /@v2@/: A 4x4 transformation matrix
    -> m Int32
matrixEqual :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Ptr () -> Ptr () -> m Int32
matrixEqual Ptr ()
v1 Ptr ()
v2 = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Int32
result <- Ptr () -> Ptr () -> IO Int32
cogl_matrix_equal Ptr ()
v1 Ptr ()
v2
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveMatrixMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveMatrixMethod "copy" o = MatrixCopyMethodInfo
    ResolveMatrixMethod "free" o = MatrixFreeMethodInfo
    ResolveMatrixMethod "frustum" o = MatrixFrustumMethodInfo
    ResolveMatrixMethod "initFromArray" o = MatrixInitFromArrayMethodInfo
    ResolveMatrixMethod "initIdentity" o = MatrixInitIdentityMethodInfo
    ResolveMatrixMethod "initTranslation" o = MatrixInitTranslationMethodInfo
    ResolveMatrixMethod "isIdentity" o = MatrixIsIdentityMethodInfo
    ResolveMatrixMethod "lookAt" o = MatrixLookAtMethodInfo
    ResolveMatrixMethod "multiply" o = MatrixMultiplyMethodInfo
    ResolveMatrixMethod "ortho" o = MatrixOrthoMethodInfo
    ResolveMatrixMethod "perspective" o = MatrixPerspectiveMethodInfo
    ResolveMatrixMethod "rotate" o = MatrixRotateMethodInfo
    ResolveMatrixMethod "scale" o = MatrixScaleMethodInfo
    ResolveMatrixMethod "transformPoint" o = MatrixTransformPointMethodInfo
    ResolveMatrixMethod "translate" o = MatrixTranslateMethodInfo
    ResolveMatrixMethod "transpose" o = MatrixTransposeMethodInfo
    ResolveMatrixMethod "getArray" o = MatrixGetArrayMethodInfo
    ResolveMatrixMethod "getInverse" o = MatrixGetInverseMethodInfo
    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