{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Cogl.Structs.Material
    ( 

-- * Exported types
    Material(..)                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [removeLayer]("GI.Cogl.Structs.Material#g:method:removeLayer").
-- 
-- ==== Getters
-- [getAmbient]("GI.Cogl.Structs.Material#g:method:getAmbient"), [getColor]("GI.Cogl.Structs.Material#g:method:getColor"), [getDiffuse]("GI.Cogl.Structs.Material#g:method:getDiffuse"), [getEmission]("GI.Cogl.Structs.Material#g:method:getEmission"), [getLayerPointSpriteCoordsEnabled]("GI.Cogl.Structs.Material#g:method:getLayerPointSpriteCoordsEnabled"), [getLayerWrapModeP]("GI.Cogl.Structs.Material#g:method:getLayerWrapModeP"), [getLayerWrapModeS]("GI.Cogl.Structs.Material#g:method:getLayerWrapModeS"), [getLayerWrapModeT]("GI.Cogl.Structs.Material#g:method:getLayerWrapModeT"), [getLayers]("GI.Cogl.Structs.Material#g:method:getLayers"), [getNLayers]("GI.Cogl.Structs.Material#g:method:getNLayers"), [getPointSize]("GI.Cogl.Structs.Material#g:method:getPointSize"), [getShininess]("GI.Cogl.Structs.Material#g:method:getShininess"), [getSpecular]("GI.Cogl.Structs.Material#g:method:getSpecular"), [getUserProgram]("GI.Cogl.Structs.Material#g:method:getUserProgram").
-- 
-- ==== Setters
-- [setAlphaTestFunction]("GI.Cogl.Structs.Material#g:method:setAlphaTestFunction"), [setAmbient]("GI.Cogl.Structs.Material#g:method:setAmbient"), [setAmbientAndDiffuse]("GI.Cogl.Structs.Material#g:method:setAmbientAndDiffuse"), [setBlend]("GI.Cogl.Structs.Material#g:method:setBlend"), [setBlendConstant]("GI.Cogl.Structs.Material#g:method:setBlendConstant"), [setColor]("GI.Cogl.Structs.Material#g:method:setColor"), [setColor4f]("GI.Cogl.Structs.Material#g:method:setColor4f"), [setColor4ub]("GI.Cogl.Structs.Material#g:method:setColor4ub"), [setDiffuse]("GI.Cogl.Structs.Material#g:method:setDiffuse"), [setEmission]("GI.Cogl.Structs.Material#g:method:setEmission"), [setLayer]("GI.Cogl.Structs.Material#g:method:setLayer"), [setLayerCombine]("GI.Cogl.Structs.Material#g:method:setLayerCombine"), [setLayerCombineConstant]("GI.Cogl.Structs.Material#g:method:setLayerCombineConstant"), [setLayerFilters]("GI.Cogl.Structs.Material#g:method:setLayerFilters"), [setLayerMatrix]("GI.Cogl.Structs.Material#g:method:setLayerMatrix"), [setLayerPointSpriteCoordsEnabled]("GI.Cogl.Structs.Material#g:method:setLayerPointSpriteCoordsEnabled"), [setLayerWrapMode]("GI.Cogl.Structs.Material#g:method:setLayerWrapMode"), [setLayerWrapModeP]("GI.Cogl.Structs.Material#g:method:setLayerWrapModeP"), [setLayerWrapModeS]("GI.Cogl.Structs.Material#g:method:setLayerWrapModeS"), [setLayerWrapModeT]("GI.Cogl.Structs.Material#g:method:setLayerWrapModeT"), [setPointSize]("GI.Cogl.Structs.Material#g:method:setPointSize"), [setShininess]("GI.Cogl.Structs.Material#g:method:setShininess"), [setSpecular]("GI.Cogl.Structs.Material#g:method:setSpecular"), [setUserProgram]("GI.Cogl.Structs.Material#g:method:setUserProgram").

#if defined(ENABLE_OVERLOADING)
    ResolveMaterialMethod                   ,
#endif

-- ** getAmbient #method:getAmbient#

#if defined(ENABLE_OVERLOADING)
    MaterialGetAmbientMethodInfo            ,
#endif
    materialGetAmbient                      ,


-- ** getColor #method:getColor#

#if defined(ENABLE_OVERLOADING)
    MaterialGetColorMethodInfo              ,
#endif
    materialGetColor                        ,


-- ** getDiffuse #method:getDiffuse#

#if defined(ENABLE_OVERLOADING)
    MaterialGetDiffuseMethodInfo            ,
#endif
    materialGetDiffuse                      ,


-- ** getEmission #method:getEmission#

#if defined(ENABLE_OVERLOADING)
    MaterialGetEmissionMethodInfo           ,
#endif
    materialGetEmission                     ,


-- ** getLayerPointSpriteCoordsEnabled #method:getLayerPointSpriteCoordsEnabled#

#if defined(ENABLE_OVERLOADING)
    MaterialGetLayerPointSpriteCoordsEnabledMethodInfo,
#endif
    materialGetLayerPointSpriteCoordsEnabled,


-- ** getLayerWrapModeP #method:getLayerWrapModeP#

#if defined(ENABLE_OVERLOADING)
    MaterialGetLayerWrapModePMethodInfo     ,
#endif
    materialGetLayerWrapModeP               ,


-- ** getLayerWrapModeS #method:getLayerWrapModeS#

#if defined(ENABLE_OVERLOADING)
    MaterialGetLayerWrapModeSMethodInfo     ,
#endif
    materialGetLayerWrapModeS               ,


-- ** getLayerWrapModeT #method:getLayerWrapModeT#

#if defined(ENABLE_OVERLOADING)
    MaterialGetLayerWrapModeTMethodInfo     ,
#endif
    materialGetLayerWrapModeT               ,


-- ** getLayers #method:getLayers#

#if defined(ENABLE_OVERLOADING)
    MaterialGetLayersMethodInfo             ,
#endif
    materialGetLayers                       ,


-- ** getNLayers #method:getNLayers#

#if defined(ENABLE_OVERLOADING)
    MaterialGetNLayersMethodInfo            ,
#endif
    materialGetNLayers                      ,


-- ** getPointSize #method:getPointSize#

#if defined(ENABLE_OVERLOADING)
    MaterialGetPointSizeMethodInfo          ,
#endif
    materialGetPointSize                    ,


-- ** getShininess #method:getShininess#

#if defined(ENABLE_OVERLOADING)
    MaterialGetShininessMethodInfo          ,
#endif
    materialGetShininess                    ,


-- ** getSpecular #method:getSpecular#

#if defined(ENABLE_OVERLOADING)
    MaterialGetSpecularMethodInfo           ,
#endif
    materialGetSpecular                     ,


-- ** getUserProgram #method:getUserProgram#

#if defined(ENABLE_OVERLOADING)
    MaterialGetUserProgramMethodInfo        ,
#endif
    materialGetUserProgram                  ,


-- ** ref #method:ref#

    materialRef                             ,


-- ** removeLayer #method:removeLayer#

#if defined(ENABLE_OVERLOADING)
    MaterialRemoveLayerMethodInfo           ,
#endif
    materialRemoveLayer                     ,


-- ** setAlphaTestFunction #method:setAlphaTestFunction#

#if defined(ENABLE_OVERLOADING)
    MaterialSetAlphaTestFunctionMethodInfo  ,
#endif
    materialSetAlphaTestFunction            ,


-- ** setAmbient #method:setAmbient#

#if defined(ENABLE_OVERLOADING)
    MaterialSetAmbientMethodInfo            ,
#endif
    materialSetAmbient                      ,


-- ** setAmbientAndDiffuse #method:setAmbientAndDiffuse#

#if defined(ENABLE_OVERLOADING)
    MaterialSetAmbientAndDiffuseMethodInfo  ,
#endif
    materialSetAmbientAndDiffuse            ,


-- ** setBlend #method:setBlend#

#if defined(ENABLE_OVERLOADING)
    MaterialSetBlendMethodInfo              ,
#endif
    materialSetBlend                        ,


-- ** setBlendConstant #method:setBlendConstant#

#if defined(ENABLE_OVERLOADING)
    MaterialSetBlendConstantMethodInfo      ,
#endif
    materialSetBlendConstant                ,


-- ** setColor #method:setColor#

#if defined(ENABLE_OVERLOADING)
    MaterialSetColorMethodInfo              ,
#endif
    materialSetColor                        ,


-- ** setColor4f #method:setColor4f#

#if defined(ENABLE_OVERLOADING)
    MaterialSetColor4fMethodInfo            ,
#endif
    materialSetColor4f                      ,


-- ** setColor4ub #method:setColor4ub#

#if defined(ENABLE_OVERLOADING)
    MaterialSetColor4ubMethodInfo           ,
#endif
    materialSetColor4ub                     ,


-- ** setDiffuse #method:setDiffuse#

#if defined(ENABLE_OVERLOADING)
    MaterialSetDiffuseMethodInfo            ,
#endif
    materialSetDiffuse                      ,


-- ** setEmission #method:setEmission#

#if defined(ENABLE_OVERLOADING)
    MaterialSetEmissionMethodInfo           ,
#endif
    materialSetEmission                     ,


-- ** setLayer #method:setLayer#

#if defined(ENABLE_OVERLOADING)
    MaterialSetLayerMethodInfo              ,
#endif
    materialSetLayer                        ,


-- ** setLayerCombine #method:setLayerCombine#

#if defined(ENABLE_OVERLOADING)
    MaterialSetLayerCombineMethodInfo       ,
#endif
    materialSetLayerCombine                 ,


-- ** setLayerCombineConstant #method:setLayerCombineConstant#

#if defined(ENABLE_OVERLOADING)
    MaterialSetLayerCombineConstantMethodInfo,
#endif
    materialSetLayerCombineConstant         ,


-- ** setLayerFilters #method:setLayerFilters#

#if defined(ENABLE_OVERLOADING)
    MaterialSetLayerFiltersMethodInfo       ,
#endif
    materialSetLayerFilters                 ,


-- ** setLayerMatrix #method:setLayerMatrix#

#if defined(ENABLE_OVERLOADING)
    MaterialSetLayerMatrixMethodInfo        ,
#endif
    materialSetLayerMatrix                  ,


-- ** setLayerPointSpriteCoordsEnabled #method:setLayerPointSpriteCoordsEnabled#

#if defined(ENABLE_OVERLOADING)
    MaterialSetLayerPointSpriteCoordsEnabledMethodInfo,
#endif
    materialSetLayerPointSpriteCoordsEnabled,


-- ** setLayerWrapMode #method:setLayerWrapMode#

#if defined(ENABLE_OVERLOADING)
    MaterialSetLayerWrapModeMethodInfo      ,
#endif
    materialSetLayerWrapMode                ,


-- ** setLayerWrapModeP #method:setLayerWrapModeP#

#if defined(ENABLE_OVERLOADING)
    MaterialSetLayerWrapModePMethodInfo     ,
#endif
    materialSetLayerWrapModeP               ,


-- ** setLayerWrapModeS #method:setLayerWrapModeS#

#if defined(ENABLE_OVERLOADING)
    MaterialSetLayerWrapModeSMethodInfo     ,
#endif
    materialSetLayerWrapModeS               ,


-- ** setLayerWrapModeT #method:setLayerWrapModeT#

#if defined(ENABLE_OVERLOADING)
    MaterialSetLayerWrapModeTMethodInfo     ,
#endif
    materialSetLayerWrapModeT               ,


-- ** setPointSize #method:setPointSize#

#if defined(ENABLE_OVERLOADING)
    MaterialSetPointSizeMethodInfo          ,
#endif
    materialSetPointSize                    ,


-- ** setShininess #method:setShininess#

#if defined(ENABLE_OVERLOADING)
    MaterialSetShininessMethodInfo          ,
#endif
    materialSetShininess                    ,


-- ** setSpecular #method:setSpecular#

#if defined(ENABLE_OVERLOADING)
    MaterialSetSpecularMethodInfo           ,
#endif
    materialSetSpecular                     ,


-- ** setUserProgram #method:setUserProgram#

#if defined(ENABLE_OVERLOADING)
    MaterialSetUserProgramMethodInfo        ,
#endif
    materialSetUserProgram                  ,


-- ** unref #method:unref#

    materialUnref                           ,




    ) where

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

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

import {-# SOURCE #-} qualified GI.Cogl.Enums as Cogl.Enums
import {-# SOURCE #-} qualified GI.Cogl.Structs.Color as Cogl.Color
import {-# SOURCE #-} qualified GI.Cogl.Structs.MaterialLayer as Cogl.MaterialLayer
import {-# SOURCE #-} qualified GI.Cogl.Structs.Matrix as Cogl.Matrix

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

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

-- XXX Wrapping a foreign struct/union with no known destructor or size, leak?
instance BoxedPtr Material where
    boxedPtrCopy :: Material -> IO Material
boxedPtrCopy = Material -> IO Material
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    boxedPtrFree :: Material -> IO ()
boxedPtrFree = \Material
_x -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


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

-- method Material::get_ambient
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ambient"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The location to store the ambient color"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_get_ambient" cogl_material_get_ambient :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Ptr Cogl.Color.Color ->                 -- ambient : TInterface (Name {namespace = "Cogl", name = "Color"})
    IO ()

{-# DEPRECATED materialGetAmbient ["(Since version 1.16)","Use the @/CoglSnippet/@ shader api for lighting"] #-}
-- | Retrieves the current ambient color for /@material@/
-- 
-- /Since: 1.0/
materialGetAmbient ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Cogl.Color.Color
    -- ^ /@ambient@/: The location to store the ambient color
    -> m ()
materialGetAmbient :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Color -> m ()
materialGetAmbient Material
material Color
ambient = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    Ptr Color
ambient' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
ambient
    Ptr Material -> Ptr Color -> IO ()
cogl_material_get_ambient Ptr Material
material' Ptr Color
ambient'
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
ambient
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MaterialGetAmbientMethodInfo
instance (signature ~ (Cogl.Color.Color -> m ()), MonadIO m) => O.OverloadedMethod MaterialGetAmbientMethodInfo Material signature where
    overloadedMethod = materialGetAmbient

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


#endif

-- method Material::get_color
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "color"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The location to store the color"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_get_color" cogl_material_get_color :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Ptr Cogl.Color.Color ->                 -- color : TInterface (Name {namespace = "Cogl", name = "Color"})
    IO ()

{-# DEPRECATED materialGetColor ["(Since version 1.16)","Use @/cogl_pipeline_get_color()/@ instead"] #-}
-- | Retrieves the current material color.
-- 
-- /Since: 1.0/
materialGetColor ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> m (Cogl.Color.Color)
materialGetColor :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> m Color
materialGetColor Material
material = IO Color -> m Color
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Color -> m Color) -> IO Color -> m Color
forall a b. (a -> b) -> a -> b
$ do
    Ptr Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    Ptr Color
color <- Int -> IO (Ptr Color)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Cogl.Color.Color)
    Ptr Material -> Ptr Color -> IO ()
cogl_material_get_color Ptr Material
material' Ptr Color
color
    Color
color' <- ((ManagedPtr Color -> Color) -> Ptr Color -> IO Color
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Color -> Color
Cogl.Color.Color) Ptr Color
color
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    Color -> IO Color
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Color
color'

#if defined(ENABLE_OVERLOADING)
data MaterialGetColorMethodInfo
instance (signature ~ (m (Cogl.Color.Color)), MonadIO m) => O.OverloadedMethod MaterialGetColorMethodInfo Material signature where
    overloadedMethod = materialGetColor

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


#endif

-- method Material::get_diffuse
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "diffuse"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The location to store the diffuse color"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_get_diffuse" cogl_material_get_diffuse :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Ptr Cogl.Color.Color ->                 -- diffuse : TInterface (Name {namespace = "Cogl", name = "Color"})
    IO ()

{-# DEPRECATED materialGetDiffuse ["(Since version 1.16)","Use the @/CoglSnippet/@ shader api for lighting"] #-}
-- | Retrieves the current diffuse color for /@material@/
-- 
-- /Since: 1.0/
materialGetDiffuse ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Cogl.Color.Color
    -- ^ /@diffuse@/: The location to store the diffuse color
    -> m ()
materialGetDiffuse :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Color -> m ()
materialGetDiffuse Material
material Color
diffuse = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    Ptr Color
diffuse' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
diffuse
    Ptr Material -> Ptr Color -> IO ()
cogl_material_get_diffuse Ptr Material
material' Ptr Color
diffuse'
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
diffuse
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MaterialGetDiffuseMethodInfo
instance (signature ~ (Cogl.Color.Color -> m ()), MonadIO m) => O.OverloadedMethod MaterialGetDiffuseMethodInfo Material signature where
    overloadedMethod = materialGetDiffuse

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


#endif

-- method Material::get_emission
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "emission"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The location to store the emission color"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_get_emission" cogl_material_get_emission :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Ptr Cogl.Color.Color ->                 -- emission : TInterface (Name {namespace = "Cogl", name = "Color"})
    IO ()

{-# DEPRECATED materialGetEmission ["(Since version 1.16)","Use the @/CoglSnippet/@ shader api for lighting"] #-}
-- | Retrieves the materials current emission color.
-- 
-- /Since: 1.0/
materialGetEmission ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Cogl.Color.Color
    -- ^ /@emission@/: The location to store the emission color
    -> m ()
materialGetEmission :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Color -> m ()
materialGetEmission Material
material Color
emission = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    Ptr Color
emission' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
emission
    Ptr Material -> Ptr Color -> IO ()
cogl_material_get_emission Ptr Material
material' Ptr Color
emission'
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
emission
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MaterialGetEmissionMethodInfo
instance (signature ~ (Cogl.Color.Color -> m ()), MonadIO m) => O.OverloadedMethod MaterialGetEmissionMethodInfo Material signature where
    overloadedMethod = materialGetEmission

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


#endif

-- method Material::get_layer_point_sprite_coords_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglHandle to a material."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "layer_index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the layer number to check."
--                 , 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_material_get_layer_point_sprite_coords_enabled" cogl_material_get_layer_point_sprite_coords_enabled :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Int32 ->                                -- layer_index : TBasicType TInt
    IO Int32

{-# DEPRECATED materialGetLayerPointSpriteCoordsEnabled ["(Since version 1.16)","Use @/cogl_pipeline_get_layer_point_sprite_coords_enabled()/@","                 instead"] #-}
-- | Gets whether point sprite coordinate generation is enabled for this
-- texture layer.
-- 
-- /Since: 1.4/
materialGetLayerPointSpriteCoordsEnabled ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: a @/CoglHandle/@ to a material.
    -> Int32
    -- ^ /@layerIndex@/: the layer number to check.
    -> m Int32
    -- ^ __Returns:__ whether the texture coordinates will be replaced with
    -- point sprite coordinates.
materialGetLayerPointSpriteCoordsEnabled :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Int32 -> m Int32
materialGetLayerPointSpriteCoordsEnabled Material
material Int32
layerIndex = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    Int32
result <- Ptr Material -> Int32 -> IO Int32
cogl_material_get_layer_point_sprite_coords_enabled Ptr Material
material' Int32
layerIndex
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data MaterialGetLayerPointSpriteCoordsEnabledMethodInfo
instance (signature ~ (Int32 -> m Int32), MonadIO m) => O.OverloadedMethod MaterialGetLayerPointSpriteCoordsEnabledMethodInfo Material signature where
    overloadedMethod = materialGetLayerPointSpriteCoordsEnabled

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


#endif

-- method Material::get_layer_wrap_mode_p
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "layer_index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the layer number to change."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Cogl" , name = "MaterialWrapMode" })
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_get_layer_wrap_mode_p" cogl_material_get_layer_wrap_mode_p :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Int32 ->                                -- layer_index : TBasicType TInt
    IO CUInt

{-# DEPRECATED materialGetLayerWrapModeP ["(Since version 1.16)","Use @/cogl_pipeline_get_layer_wrap_mode_p()/@ instead"] #-}
-- | Returns the wrap mode for the \'p\' coordinate of texture lookups on this
-- layer.
-- 
-- /Since: 1.6/
materialGetLayerWrapModeP ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Int32
    -- ^ /@layerIndex@/: the layer number to change.
    -> m Cogl.Enums.MaterialWrapMode
    -- ^ __Returns:__ the wrap mode for the \'p\' coordinate of texture lookups on
    -- this layer.
materialGetLayerWrapModeP :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Int32 -> m MaterialWrapMode
materialGetLayerWrapModeP Material
material Int32
layerIndex = IO MaterialWrapMode -> m MaterialWrapMode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MaterialWrapMode -> m MaterialWrapMode)
-> IO MaterialWrapMode -> m MaterialWrapMode
forall a b. (a -> b) -> a -> b
$ do
    Ptr Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    CUInt
result <- Ptr Material -> Int32 -> IO CUInt
cogl_material_get_layer_wrap_mode_p Ptr Material
material' Int32
layerIndex
    let result' :: MaterialWrapMode
result' = (Int -> MaterialWrapMode
forall a. Enum a => Int -> a
toEnum (Int -> MaterialWrapMode)
-> (CUInt -> Int) -> CUInt -> MaterialWrapMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    MaterialWrapMode -> IO MaterialWrapMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MaterialWrapMode
result'

#if defined(ENABLE_OVERLOADING)
data MaterialGetLayerWrapModePMethodInfo
instance (signature ~ (Int32 -> m Cogl.Enums.MaterialWrapMode), MonadIO m) => O.OverloadedMethod MaterialGetLayerWrapModePMethodInfo Material signature where
    overloadedMethod = materialGetLayerWrapModeP

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


#endif

-- method Material::get_layer_wrap_mode_s
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "layer_index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the layer number to change."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Cogl" , name = "MaterialWrapMode" })
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_get_layer_wrap_mode_s" cogl_material_get_layer_wrap_mode_s :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Int32 ->                                -- layer_index : TBasicType TInt
    IO CUInt

{-# DEPRECATED materialGetLayerWrapModeS ["(Since version 1.16)","Use @/cogl_pipeline_get_layer_wrap_mode_s()/@ instead"] #-}
-- | Returns the wrap mode for the \'s\' coordinate of texture lookups on this
-- layer.
-- 
-- /Since: 1.6/
materialGetLayerWrapModeS ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Int32
    -- ^ /@layerIndex@/: the layer number to change.
    -> m Cogl.Enums.MaterialWrapMode
    -- ^ __Returns:__ the wrap mode for the \'s\' coordinate of texture lookups on
    -- this layer.
materialGetLayerWrapModeS :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Int32 -> m MaterialWrapMode
materialGetLayerWrapModeS Material
material Int32
layerIndex = IO MaterialWrapMode -> m MaterialWrapMode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MaterialWrapMode -> m MaterialWrapMode)
-> IO MaterialWrapMode -> m MaterialWrapMode
forall a b. (a -> b) -> a -> b
$ do
    Ptr Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    CUInt
result <- Ptr Material -> Int32 -> IO CUInt
cogl_material_get_layer_wrap_mode_s Ptr Material
material' Int32
layerIndex
    let result' :: MaterialWrapMode
result' = (Int -> MaterialWrapMode
forall a. Enum a => Int -> a
toEnum (Int -> MaterialWrapMode)
-> (CUInt -> Int) -> CUInt -> MaterialWrapMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    MaterialWrapMode -> IO MaterialWrapMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MaterialWrapMode
result'

#if defined(ENABLE_OVERLOADING)
data MaterialGetLayerWrapModeSMethodInfo
instance (signature ~ (Int32 -> m Cogl.Enums.MaterialWrapMode), MonadIO m) => O.OverloadedMethod MaterialGetLayerWrapModeSMethodInfo Material signature where
    overloadedMethod = materialGetLayerWrapModeS

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


#endif

-- method Material::get_layer_wrap_mode_t
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "layer_index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the layer number to change."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Cogl" , name = "MaterialWrapMode" })
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_get_layer_wrap_mode_t" cogl_material_get_layer_wrap_mode_t :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Int32 ->                                -- layer_index : TBasicType TInt
    IO CUInt

{-# DEPRECATED materialGetLayerWrapModeT ["(Since version 1.16)","Use @/cogl_pipeline_get_layer_wrap_mode_t()/@ instead"] #-}
-- | Returns the wrap mode for the \'t\' coordinate of texture lookups on this
-- layer.
-- 
-- /Since: 1.6/
materialGetLayerWrapModeT ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Int32
    -- ^ /@layerIndex@/: the layer number to change.
    -> m Cogl.Enums.MaterialWrapMode
    -- ^ __Returns:__ the wrap mode for the \'t\' coordinate of texture lookups on
    -- this layer.
materialGetLayerWrapModeT :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Int32 -> m MaterialWrapMode
materialGetLayerWrapModeT Material
material Int32
layerIndex = IO MaterialWrapMode -> m MaterialWrapMode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MaterialWrapMode -> m MaterialWrapMode)
-> IO MaterialWrapMode -> m MaterialWrapMode
forall a b. (a -> b) -> a -> b
$ do
    Ptr Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    CUInt
result <- Ptr Material -> Int32 -> IO CUInt
cogl_material_get_layer_wrap_mode_t Ptr Material
material' Int32
layerIndex
    let result' :: MaterialWrapMode
result' = (Int -> MaterialWrapMode
forall a. Enum a => Int -> a
toEnum (Int -> MaterialWrapMode)
-> (CUInt -> Int) -> CUInt -> MaterialWrapMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    MaterialWrapMode -> IO MaterialWrapMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MaterialWrapMode
result'

#if defined(ENABLE_OVERLOADING)
data MaterialGetLayerWrapModeTMethodInfo
instance (signature ~ (Int32 -> m Cogl.Enums.MaterialWrapMode), MonadIO m) => O.OverloadedMethod MaterialGetLayerWrapModeTMethodInfo Material signature where
    overloadedMethod = materialGetLayerWrapModeT

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


#endif

-- method Material::get_layers
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "Cogl" , name = "MaterialLayer" }))
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_get_layers" cogl_material_get_layers :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    IO (Ptr (GList (Ptr Cogl.MaterialLayer.MaterialLayer)))

-- | This function lets you access a material\'s internal list of layers
-- for iteration.
-- 
-- \<note>You should avoid using this API if possible since it was only
-- made public by mistake and will be deprecated when we have
-- suitable alternative.\<\/note>
-- 
-- \<note>It\'s important to understand that the list returned may not
-- remain valid if you modify the material or any of the layers in any
-- way and so you would have to re-get the list in that
-- situation.\<\/note>
materialGetLayers ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> m [Cogl.MaterialLayer.MaterialLayer]
    -- ^ __Returns:__ A
    --    list of t'GI.Cogl.Structs.MaterialLayer.MaterialLayer'\'s that can be passed to the
    --    cogl_material_layer_* functions. The list is owned by Cogl and it
    --    should not be modified or freed
    --    Deprecated: 1.16: Use @/cogl_pipeline_get_layers()/@ instead
materialGetLayers :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> m [MaterialLayer]
materialGetLayers Material
material = IO [MaterialLayer] -> m [MaterialLayer]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [MaterialLayer] -> m [MaterialLayer])
-> IO [MaterialLayer] -> m [MaterialLayer]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    Ptr (GList (Ptr MaterialLayer))
result <- Ptr Material -> IO (Ptr (GList (Ptr MaterialLayer)))
cogl_material_get_layers Ptr Material
material'
    [Ptr MaterialLayer]
result' <- Ptr (GList (Ptr MaterialLayer)) -> IO [Ptr MaterialLayer]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr MaterialLayer))
result
    [MaterialLayer]
result'' <- (Ptr MaterialLayer -> IO MaterialLayer)
-> [Ptr MaterialLayer] -> IO [MaterialLayer]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr MaterialLayer -> MaterialLayer)
-> Ptr MaterialLayer -> IO MaterialLayer
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr MaterialLayer -> MaterialLayer
Cogl.MaterialLayer.MaterialLayer) [Ptr MaterialLayer]
result'
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    [MaterialLayer] -> IO [MaterialLayer]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [MaterialLayer]
result''

#if defined(ENABLE_OVERLOADING)
data MaterialGetLayersMethodInfo
instance (signature ~ (m [Cogl.MaterialLayer.MaterialLayer]), MonadIO m) => O.OverloadedMethod MaterialGetLayersMethodInfo Material signature where
    overloadedMethod = materialGetLayers

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


#endif

-- method Material::get_n_layers
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , 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_material_get_n_layers" cogl_material_get_n_layers :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    IO Int32

{-# DEPRECATED materialGetNLayers ["(Since version 1.16)","Use @/cogl_pipeline_get_n_layers()/@ instead"] #-}
-- | Retrieves the number of layers defined for the given /@material@/
-- 
-- /Since: 1.0/
materialGetNLayers ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> m Int32
    -- ^ __Returns:__ the number of layers
materialGetNLayers :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> m Int32
materialGetNLayers Material
material = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    Int32
result <- Ptr Material -> IO Int32
cogl_material_get_n_layers Ptr Material
material'
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data MaterialGetNLayersMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod MaterialGetNLayersMethodInfo Material signature where
    overloadedMethod = materialGetNLayers

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


#endif

-- method Material::get_point_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglHandle to a material."
--                 , 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_material_get_point_size" cogl_material_get_point_size :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    IO CFloat

{-# DEPRECATED materialGetPointSize ["(Since version 1.16)","Use @/cogl_pipeline_get_point_size()/@ instead"] #-}
-- | Get the size of points drawn when 'GI.Cogl.Enums.VerticesModePoints' is
-- used with the vertex buffer API.
-- 
-- /Since: 1.4/
materialGetPointSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: a @/CoglHandle/@ to a material.
    -> m Float
    -- ^ __Returns:__ the point size of the material.
materialGetPointSize :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> m Float
materialGetPointSize Material
material = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    CFloat
result <- Ptr Material -> IO CFloat
cogl_material_get_point_size Ptr Material
material'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data MaterialGetPointSizeMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.OverloadedMethod MaterialGetPointSizeMethodInfo Material signature where
    overloadedMethod = materialGetPointSize

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


#endif

-- method Material::get_shininess
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , 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_material_get_shininess" cogl_material_get_shininess :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    IO CFloat

{-# DEPRECATED materialGetShininess ["(Since version 1.16)","Use the @/CoglSnippet/@ shader api for lighting"] #-}
-- | Retrieves the materials current emission color.
-- 
-- /Since: 1.0/
materialGetShininess ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> m Float
    -- ^ __Returns:__ The materials current shininess value
materialGetShininess :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> m Float
materialGetShininess Material
material = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    CFloat
result <- Ptr Material -> IO CFloat
cogl_material_get_shininess Ptr Material
material'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data MaterialGetShininessMethodInfo
instance (signature ~ (m Float), MonadIO m) => O.OverloadedMethod MaterialGetShininessMethodInfo Material signature where
    overloadedMethod = materialGetShininess

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


#endif

-- method Material::get_specular
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "specular"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The location to store the specular color"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_get_specular" cogl_material_get_specular :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Ptr Cogl.Color.Color ->                 -- specular : TInterface (Name {namespace = "Cogl", name = "Color"})
    IO ()

{-# DEPRECATED materialGetSpecular ["(Since version 1.16)","Use the @/CoglSnippet/@ shader api for lighting"] #-}
-- | Retrieves the materials current specular color.
-- 
-- /Since: 1.0/
materialGetSpecular ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Cogl.Color.Color
    -- ^ /@specular@/: The location to store the specular color
    -> m ()
materialGetSpecular :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Color -> m ()
materialGetSpecular Material
material Color
specular = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    Ptr Color
specular' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
specular
    Ptr Material -> Ptr Color -> IO ()
cogl_material_get_specular Ptr Material
material' Ptr Color
specular'
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
specular
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MaterialGetSpecularMethodInfo
instance (signature ~ (Cogl.Color.Color -> m ()), MonadIO m) => O.OverloadedMethod MaterialGetSpecularMethodInfo Material signature where
    overloadedMethod = materialGetSpecular

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


#endif

-- method Material::get_user_program
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglMaterial object."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TPtr)
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_get_user_program" cogl_material_get_user_program :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    IO (Ptr ())

{-# DEPRECATED materialGetUserProgram ["(Since version 1.16)","Use @/CoglSnippet/@ api instead instead"] #-}
-- | Queries what user program has been associated with the given
-- /@material@/ using 'GI.Cogl.Structs.Material.materialSetUserProgram'.
-- 
-- /Since: 1.4/
materialGetUserProgram ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: a t'GI.Cogl.Structs.Material.Material' object.
    -> m (Ptr ())
    -- ^ __Returns:__ The current user program
    --   or @/COGL_INVALID_HANDLE/@.
materialGetUserProgram :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> m (Ptr ())
materialGetUserProgram Material
material = IO (Ptr ()) -> m (Ptr ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
    Ptr Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    Ptr ()
result <- Ptr Material -> IO (Ptr ())
cogl_material_get_user_program Ptr Material
material'
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result

#if defined(ENABLE_OVERLOADING)
data MaterialGetUserProgramMethodInfo
instance (signature ~ (m (Ptr ())), MonadIO m) => O.OverloadedMethod MaterialGetUserProgramMethodInfo Material signature where
    overloadedMethod = materialGetUserProgram

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


#endif

-- method Material::remove_layer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "layer_index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Specifies the layer you want to remove"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_remove_layer" cogl_material_remove_layer :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Int32 ->                                -- layer_index : TBasicType TInt
    IO ()

{-# DEPRECATED materialRemoveLayer ["(Since version 1.16)","Use @/cogl_pipeline_remove_layer()/@ instead"] #-}
-- | This function removes a layer from your material
materialRemoveLayer ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Int32
    -- ^ /@layerIndex@/: Specifies the layer you want to remove
    -> m ()
materialRemoveLayer :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Int32 -> m ()
materialRemoveLayer Material
material Int32
layerIndex = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    Ptr Material -> Int32 -> IO ()
cogl_material_remove_layer Ptr Material
material' Int32
layerIndex
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MaterialRemoveLayerMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m) => O.OverloadedMethod MaterialRemoveLayerMethodInfo Material signature where
    overloadedMethod = materialRemoveLayer

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


#endif

-- method Material::set_alpha_test_function
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "alpha_func"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "MaterialAlphaFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A @CoglMaterialAlphaFunc constant"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "alpha_reference"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A reference point that the chosen alpha function uses\n  to compare incoming fragments to."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_set_alpha_test_function" cogl_material_set_alpha_test_function :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    CUInt ->                                -- alpha_func : TInterface (Name {namespace = "Cogl", name = "MaterialAlphaFunc"})
    CFloat ->                               -- alpha_reference : TBasicType TFloat
    IO ()

{-# DEPRECATED materialSetAlphaTestFunction ["(Since version 1.16)","Use @/cogl_pipeline_set_alpha_test_function()/@ instead"] #-}
-- | Before a primitive is blended with the framebuffer, it goes through an
-- alpha test stage which lets you discard fragments based on the current
-- alpha value. This function lets you change the function used to evaluate
-- the alpha channel, and thus determine which fragments are discarded
-- and which continue on to the blending stage.
-- 
-- The default is 'GI.Cogl.Enums.MaterialAlphaFuncAlways'
-- 
-- /Since: 1.0/
materialSetAlphaTestFunction ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Cogl.Enums.MaterialAlphaFunc
    -- ^ /@alphaFunc@/: A /@coglMaterialAlphaFunc@/ constant
    -> Float
    -- ^ /@alphaReference@/: A reference point that the chosen alpha function uses
    --   to compare incoming fragments to.
    -> m ()
materialSetAlphaTestFunction :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> MaterialAlphaFunc -> Float -> m ()
materialSetAlphaTestFunction Material
material MaterialAlphaFunc
alphaFunc Float
alphaReference = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    let alphaFunc' :: CUInt
alphaFunc' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (MaterialAlphaFunc -> Int) -> MaterialAlphaFunc -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaterialAlphaFunc -> Int
forall a. Enum a => a -> Int
fromEnum) MaterialAlphaFunc
alphaFunc
    let alphaReference' :: CFloat
alphaReference' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
alphaReference
    Ptr Material -> CUInt -> CFloat -> IO ()
cogl_material_set_alpha_test_function Ptr Material
material' CUInt
alphaFunc' CFloat
alphaReference'
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MaterialSetAlphaTestFunctionMethodInfo
instance (signature ~ (Cogl.Enums.MaterialAlphaFunc -> Float -> m ()), MonadIO m) => O.OverloadedMethod MaterialSetAlphaTestFunctionMethodInfo Material signature where
    overloadedMethod = materialSetAlphaTestFunction

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


#endif

-- method Material::set_ambient
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ambient"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The components of the desired ambient color"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_set_ambient" cogl_material_set_ambient :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Ptr Cogl.Color.Color ->                 -- ambient : TInterface (Name {namespace = "Cogl", name = "Color"})
    IO ()

{-# DEPRECATED materialSetAmbient ["(Since version 1.16)","Use the @/CoglSnippet/@ shader api for lighting"] #-}
-- | Sets the material\'s ambient color, in the standard OpenGL lighting
-- model. The ambient color affects the overall color of the object.
-- 
-- Since the diffuse color will be intense when the light hits the surface
-- directly, the ambient will be most apparent where the light hits at a
-- slant.
-- 
-- The default value is (0.2, 0.2, 0.2, 1.0)
-- 
-- /Since: 1.0/
materialSetAmbient ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Cogl.Color.Color
    -- ^ /@ambient@/: The components of the desired ambient color
    -> m ()
materialSetAmbient :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Color -> m ()
materialSetAmbient Material
material Color
ambient = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    Ptr Color
ambient' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
ambient
    Ptr Material -> Ptr Color -> IO ()
cogl_material_set_ambient Ptr Material
material' Ptr Color
ambient'
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
ambient
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MaterialSetAmbientMethodInfo
instance (signature ~ (Cogl.Color.Color -> m ()), MonadIO m) => O.OverloadedMethod MaterialSetAmbientMethodInfo Material signature where
    overloadedMethod = materialSetAmbient

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


#endif

-- method Material::set_ambient_and_diffuse
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "color"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The components of the desired ambient and diffuse colors"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_set_ambient_and_diffuse" cogl_material_set_ambient_and_diffuse :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Ptr Cogl.Color.Color ->                 -- color : TInterface (Name {namespace = "Cogl", name = "Color"})
    IO ()

{-# DEPRECATED materialSetAmbientAndDiffuse ["(Since version 1.16)","Use the @/CoglSnippet/@ shader api for lighting"] #-}
-- | Conveniently sets the diffuse and ambient color of /@material@/ at the same
-- time. See 'GI.Cogl.Structs.Material.materialSetAmbient' and 'GI.Cogl.Structs.Material.materialSetDiffuse'.
-- 
-- The default ambient color is (0.2, 0.2, 0.2, 1.0)
-- 
-- The default diffuse color is (0.8, 0.8, 0.8, 1.0)
-- 
-- /Since: 1.0/
materialSetAmbientAndDiffuse ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Cogl.Color.Color
    -- ^ /@color@/: The components of the desired ambient and diffuse colors
    -> m ()
materialSetAmbientAndDiffuse :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Color -> m ()
materialSetAmbientAndDiffuse Material
material Color
color = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    Ptr Material -> Ptr Color -> IO ()
cogl_material_set_ambient_and_diffuse Ptr Material
material' Ptr Color
color'
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MaterialSetAmbientAndDiffuseMethodInfo
instance (signature ~ (Cogl.Color.Color -> m ()), MonadIO m) => O.OverloadedMethod MaterialSetAmbientAndDiffuseMethodInfo Material signature where
    overloadedMethod = materialSetAmbientAndDiffuse

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


#endif

-- method Material::set_blend
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "blend_string"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A <link linkend=\"cogl-Blend-Strings\">Cogl blend string</link>\n  describing the desired blend function."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : True
-- Skip return : False

foreign import ccall "cogl_material_set_blend" cogl_material_set_blend :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    CString ->                              -- blend_string : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO Int32

{-# DEPRECATED materialSetBlend ["(Since version 1.16)","Use @/cogl_pipeline_set_blend()/@ instead"] #-}
-- | If not already familiar; please refer \<link linkend=\"cogl-Blend-Strings\">here\<\/link>
-- for an overview of what blend strings are, and their syntax.
-- 
-- Blending occurs after the alpha test function, and combines fragments with
-- the framebuffer.
-- 
-- Currently the only blend function Cogl exposes is @/ADD()/@. So any valid
-- blend statements will be of the form:
-- 
-- >
-- >  &lt;channel-mask&gt;=ADD(SRC_COLOR*(&lt;factor&gt;), DST_COLOR*(&lt;factor&gt;))
-- 
-- 
-- \<warning>The brackets around blend factors are currently not
-- optional!\<\/warning>
-- 
-- This is the list of source-names usable as blend factors:
-- \<itemizedlist>
--   \<listitem>\<para>SRC_COLOR: The color of the in comming fragment\<\/para>\<\/listitem>
--   \<listitem>\<para>DST_COLOR: The color of the framebuffer\<\/para>\<\/listitem>
--   \<listitem>\<para>CONSTANT: The constant set via 'GI.Cogl.Structs.Material.materialSetBlendConstant'\<\/para>\<\/listitem>
-- \<\/itemizedlist>
-- 
-- The source names can be used according to the
-- \<link linkend=\"cogl-Blend-String-syntax\">color-source and factor syntax\<\/link>,
-- so for example \"(1-SRC_COLOR[A])\" would be a valid factor, as would
-- \"(CONSTANT[RGB])\"
-- 
-- These can also be used as factors:
-- \<itemizedlist>
--   \<listitem>0: (0, 0, 0, 0)\<\/listitem>
--   \<listitem>1: (1, 1, 1, 1)\<\/listitem>
--   \<listitem>SRC_ALPHA_SATURATE_FACTOR: (f,f,f,1) where f = MIN(SRC_COLOR[A],1-DST_COLOR[A])\<\/listitem>
-- \<\/itemizedlist>
-- 
-- \<note>Remember; all color components are normalized to the range [0, 1]
-- before computing the result of blending.\<\/note>
-- 
-- \<example id=\"cogl-Blend-Strings-blend-unpremul\">
--   \<title>Blend Strings\/1\<\/title>
--   \<para>Blend a non-premultiplied source over a destination with
--   premultiplied alpha:\<\/para>
--   \<programlisting>
-- \"RGB = ADD(SRC_COLOR*(SRC_COLOR[A]), DST_COLOR*(1-SRC_COLOR[A]))\"
-- \"A   = ADD(SRC_COLOR, DST_COLOR*(1-SRC_COLOR[A]))\"
--   \<\/programlisting>
-- \<\/example>
-- 
-- \<example id=\"cogl-Blend-Strings-blend-premul\">
--   \<title>Blend Strings\/2\<\/title>
--   \<para>Blend a premultiplied source over a destination with
--   premultiplied alpha\<\/para>
--   \<programlisting>
-- \"RGBA = ADD(SRC_COLOR, DST_COLOR*(1-SRC_COLOR[A]))\"
--   \<\/programlisting>
-- \<\/example>
-- 
-- The default blend string is:
-- >
-- >   RGBA = ADD (SRC_COLOR, DST_COLOR*(1-SRC_COLOR[A]))
-- 
-- 
-- That gives normal alpha-blending when the calculated color for the material
-- is in premultiplied form.
-- 
-- /Since: 1.0/
materialSetBlend ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> T.Text
    -- ^ /@blendString@/: A \<link linkend=\"cogl-Blend-Strings\">Cogl blend string\<\/link>
    --   describing the desired blend function.
    -> m Int32
    -- ^ __Returns:__ 'P.True' if the blend string was successfully parsed, and the
    --   described blending is supported by the underlying driver\/hardware. If
    --   there was an error, 'P.False' is returned and /@error@/ is set accordingly (if
    --   present). /(Can throw 'Data.GI.Base.GError.GError')/
materialSetBlend :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Text -> m Int32
materialSetBlend Material
material Text
blendString = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    CString
blendString' <- Text -> IO CString
textToCString Text
blendString
    IO Int32 -> IO () -> IO Int32
forall a b. IO a -> IO b -> IO a
onException (do
        Int32
result <- (Ptr (Ptr GError) -> IO Int32) -> IO Int32
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Int32) -> IO Int32)
-> (Ptr (Ptr GError) -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ Ptr Material -> CString -> Ptr (Ptr GError) -> IO Int32
cogl_material_set_blend Ptr Material
material' CString
blendString'
        Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
blendString'
        Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
blendString'
     )

#if defined(ENABLE_OVERLOADING)
data MaterialSetBlendMethodInfo
instance (signature ~ (T.Text -> m Int32), MonadIO m) => O.OverloadedMethod MaterialSetBlendMethodInfo Material signature where
    overloadedMethod = materialSetBlend

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


#endif

-- method Material::set_blend_constant
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "constant_color"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The constant color you want"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_set_blend_constant" cogl_material_set_blend_constant :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Ptr Cogl.Color.Color ->                 -- constant_color : TInterface (Name {namespace = "Cogl", name = "Color"})
    IO ()

{-# DEPRECATED materialSetBlendConstant ["(Since version 1.16)","Use @/cogl_pipeline_set_blend_constant()/@ instead"] #-}
-- | When blending is setup to reference a CONSTANT blend factor then
-- blending will depend on the constant set with this function.
-- 
-- /Since: 1.0/
materialSetBlendConstant ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Cogl.Color.Color
    -- ^ /@constantColor@/: The constant color you want
    -> m ()
materialSetBlendConstant :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Color -> m ()
materialSetBlendConstant Material
material Color
constantColor = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    Ptr Color
constantColor' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
constantColor
    Ptr Material -> Ptr Color -> IO ()
cogl_material_set_blend_constant Ptr Material
material' Ptr Color
constantColor'
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
constantColor
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MaterialSetBlendConstantMethodInfo
instance (signature ~ (Cogl.Color.Color -> m ()), MonadIO m) => O.OverloadedMethod MaterialSetBlendConstantMethodInfo Material signature where
    overloadedMethod = materialSetBlendConstant

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


#endif

-- method Material::set_color
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "color"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The components of the color"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_set_color" cogl_material_set_color :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Ptr Cogl.Color.Color ->                 -- color : TInterface (Name {namespace = "Cogl", name = "Color"})
    IO ()

{-# DEPRECATED materialSetColor ["(Since version 1.16)","Use @/cogl_pipeline_set_color()/@ instead"] #-}
-- | Sets the basic color of the material, used when no lighting is enabled.
-- 
-- Note that if you don\'t add any layers to the material then the color
-- will be blended unmodified with the destination; the default blend
-- expects premultiplied colors: for example, use (0.5, 0.0, 0.0, 0.5) for
-- semi-transparent red. See 'GI.Cogl.Structs.Color.colorPremultiply'.
-- 
-- The default value is (1.0, 1.0, 1.0, 1.0)
-- 
-- /Since: 1.0/
materialSetColor ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Cogl.Color.Color
    -- ^ /@color@/: The components of the color
    -> m ()
materialSetColor :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Color -> m ()
materialSetColor Material
material Color
color = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    Ptr Color
color' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
color
    Ptr Material -> Ptr Color -> IO ()
cogl_material_set_color Ptr Material
material' Ptr Color
color'
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
color
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MaterialSetColorMethodInfo
instance (signature ~ (Cogl.Color.Color -> m ()), MonadIO m) => O.OverloadedMethod MaterialSetColorMethodInfo Material signature where
    overloadedMethod = materialSetColor

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


#endif

-- method Material::set_color4f
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "red"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The red component" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "green"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The green component"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "blue"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The blue component" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "alpha"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The alpha component"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_set_color4f" cogl_material_set_color4f :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    CFloat ->                               -- red : TBasicType TFloat
    CFloat ->                               -- green : TBasicType TFloat
    CFloat ->                               -- blue : TBasicType TFloat
    CFloat ->                               -- alpha : TBasicType TFloat
    IO ()

{-# DEPRECATED materialSetColor4f ["(Since version 1.16)","Use @/cogl_pipeline_set_color4f()/@ instead"] #-}
-- | Sets the basic color of the material, used when no lighting is enabled.
-- 
-- The default value is (1.0, 1.0, 1.0, 1.0)
-- 
-- /Since: 1.0/
materialSetColor4f ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Float
    -- ^ /@red@/: The red component
    -> Float
    -- ^ /@green@/: The green component
    -> Float
    -- ^ /@blue@/: The blue component
    -> Float
    -- ^ /@alpha@/: The alpha component
    -> m ()
materialSetColor4f :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Float -> Float -> Float -> Float -> m ()
materialSetColor4f Material
material Float
red Float
green Float
blue Float
alpha = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    let red' :: CFloat
red' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
red
    let green' :: CFloat
green' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
green
    let blue' :: CFloat
blue' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
blue
    let alpha' :: CFloat
alpha' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
alpha
    Ptr Material -> CFloat -> CFloat -> CFloat -> CFloat -> IO ()
cogl_material_set_color4f Ptr Material
material' CFloat
red' CFloat
green' CFloat
blue' CFloat
alpha'
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MaterialSetColor4fMethodInfo
instance (signature ~ (Float -> Float -> Float -> Float -> m ()), MonadIO m) => O.OverloadedMethod MaterialSetColor4fMethodInfo Material signature where
    overloadedMethod = materialSetColor4f

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


#endif

-- method Material::set_color4ub
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "red"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The red component" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "green"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The green component"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "blue"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The blue component" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "alpha"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The alpha component"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_set_color4ub" cogl_material_set_color4ub :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Word8 ->                                -- red : TBasicType TUInt8
    Word8 ->                                -- green : TBasicType TUInt8
    Word8 ->                                -- blue : TBasicType TUInt8
    Word8 ->                                -- alpha : TBasicType TUInt8
    IO ()

{-# DEPRECATED materialSetColor4ub ["(Since version 1.16)","Use @/cogl_pipeline_set_color4ub()/@ instead"] #-}
-- | Sets the basic color of the material, used when no lighting is enabled.
-- 
-- The default value is (0xff, 0xff, 0xff, 0xff)
-- 
-- /Since: 1.0/
materialSetColor4ub ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Word8
    -- ^ /@red@/: The red component
    -> Word8
    -- ^ /@green@/: The green component
    -> Word8
    -- ^ /@blue@/: The blue component
    -> Word8
    -- ^ /@alpha@/: The alpha component
    -> m ()
materialSetColor4ub :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Word8 -> Word8 -> Word8 -> Word8 -> m ()
materialSetColor4ub Material
material Word8
red Word8
green Word8
blue Word8
alpha = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    Ptr Material -> Word8 -> Word8 -> Word8 -> Word8 -> IO ()
cogl_material_set_color4ub Ptr Material
material' Word8
red Word8
green Word8
blue Word8
alpha
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MaterialSetColor4ubMethodInfo
instance (signature ~ (Word8 -> Word8 -> Word8 -> Word8 -> m ()), MonadIO m) => O.OverloadedMethod MaterialSetColor4ubMethodInfo Material signature where
    overloadedMethod = materialSetColor4ub

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


#endif

-- method Material::set_diffuse
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "diffuse"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The components of the desired diffuse color"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_set_diffuse" cogl_material_set_diffuse :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Ptr Cogl.Color.Color ->                 -- diffuse : TInterface (Name {namespace = "Cogl", name = "Color"})
    IO ()

{-# DEPRECATED materialSetDiffuse ["(Since version 1.16)","Use the @/CoglSnippet/@ shader api for lighting"] #-}
-- | Sets the material\'s diffuse color, in the standard OpenGL lighting
-- model. The diffuse color is most intense where the light hits the
-- surface directly - perpendicular to the surface.
-- 
-- The default value is (0.8, 0.8, 0.8, 1.0)
-- 
-- /Since: 1.0/
materialSetDiffuse ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Cogl.Color.Color
    -- ^ /@diffuse@/: The components of the desired diffuse color
    -> m ()
materialSetDiffuse :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Color -> m ()
materialSetDiffuse Material
material Color
diffuse = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    Ptr Color
diffuse' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
diffuse
    Ptr Material -> Ptr Color -> IO ()
cogl_material_set_diffuse Ptr Material
material' Ptr Color
diffuse'
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
diffuse
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MaterialSetDiffuseMethodInfo
instance (signature ~ (Cogl.Color.Color -> m ()), MonadIO m) => O.OverloadedMethod MaterialSetDiffuseMethodInfo Material signature where
    overloadedMethod = materialSetDiffuse

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


#endif

-- method Material::set_emission
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "emission"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The components of the desired emissive color"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_set_emission" cogl_material_set_emission :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Ptr Cogl.Color.Color ->                 -- emission : TInterface (Name {namespace = "Cogl", name = "Color"})
    IO ()

{-# DEPRECATED materialSetEmission ["(Since version 1.16)","Use the @/CoglSnippet/@ shader api for lighting"] #-}
-- | Sets the material\'s emissive color, in the standard OpenGL lighting
-- model. It will look like the surface is a light source emitting this
-- color.
-- 
-- The default value is (0.0, 0.0, 0.0, 1.0)
-- 
-- /Since: 1.0/
materialSetEmission ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Cogl.Color.Color
    -- ^ /@emission@/: The components of the desired emissive color
    -> m ()
materialSetEmission :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Color -> m ()
materialSetEmission Material
material Color
emission = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    Ptr Color
emission' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
emission
    Ptr Material -> Ptr Color -> IO ()
cogl_material_set_emission Ptr Material
material' Ptr Color
emission'
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
emission
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MaterialSetEmissionMethodInfo
instance (signature ~ (Cogl.Color.Color -> m ()), MonadIO m) => O.OverloadedMethod MaterialSetEmissionMethodInfo Material signature where
    overloadedMethod = materialSetEmission

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


#endif

-- method Material::set_layer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "layer_index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the layer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "texture"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglHandle for the layer object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_set_layer" cogl_material_set_layer :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Int32 ->                                -- layer_index : TBasicType TInt
    Ptr () ->                               -- texture : TBasicType TPtr
    IO ()

{-# DEPRECATED materialSetLayer ["(Since version 1.16)","Use @/cogl_pipeline_set_layer()/@ instead"] #-}
-- | In addition to the standard OpenGL lighting model a Cogl material may have
-- one or more layers comprised of textures that can be blended together in
-- order, with a number of different texture combine modes. This function
-- defines a new texture layer.
-- 
-- The index values of multiple layers do not have to be consecutive; it is
-- only their relative order that is important.
-- 
-- \<note>In the future, we may define other types of material layers, such
-- as purely GLSL based layers.\<\/note>
-- 
-- /Since: 1.0/
materialSetLayer ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Int32
    -- ^ /@layerIndex@/: the index of the layer
    -> Ptr ()
    -- ^ /@texture@/: a @/CoglHandle/@ for the layer object
    -> m ()
materialSetLayer :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Int32 -> Ptr () -> m ()
materialSetLayer Material
material Int32
layerIndex Ptr ()
texture = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    Ptr Material -> Int32 -> Ptr () -> IO ()
cogl_material_set_layer Ptr Material
material' Int32
layerIndex Ptr ()
texture
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MaterialSetLayerMethodInfo
instance (signature ~ (Int32 -> Ptr () -> m ()), MonadIO m) => O.OverloadedMethod MaterialSetLayerMethodInfo Material signature where
    overloadedMethod = materialSetLayer

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


#endif

-- method Material::set_layer_combine
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "layer_index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Specifies the layer you want define a combine function for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "blend_string"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A <link linkend=\"cogl-Blend-Strings\">Cogl blend string</link>\n   describing the desired texture combine function."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : True
-- Skip return : False

foreign import ccall "cogl_material_set_layer_combine" cogl_material_set_layer_combine :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Int32 ->                                -- layer_index : TBasicType TInt
    CString ->                              -- blend_string : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO Int32

{-# DEPRECATED materialSetLayerCombine ["(Since version 1.16)","Use @/cogl_pipeline_set_layer_combine()/@ instead"] #-}
-- | If not already familiar; you can refer
-- \<link linkend=\"cogl-Blend-Strings\">here\<\/link> for an overview of what blend
-- strings are and there syntax.
-- 
-- These are all the functions available for texture combining:
-- \<itemizedlist>
--   \<listitem>REPLACE(arg0) = arg0\<\/listitem>
--   \<listitem>MODULATE(arg0, arg1) = arg0 x arg1\<\/listitem>
--   \<listitem>ADD(arg0, arg1) = arg0 + arg1\<\/listitem>
--   \<listitem>ADD_SIGNED(arg0, arg1) = arg0 + arg1 - 0.5\<\/listitem>
--   \<listitem>INTERPOLATE(arg0, arg1, arg2) = arg0 x arg2 + arg1 x (1 - arg2)\<\/listitem>
--   \<listitem>SUBTRACT(arg0, arg1) = arg0 - arg1\<\/listitem>
--   \<listitem>
--     \<programlisting>
--  DOT3_RGB(arg0, arg1) = 4 x ((arg0[R] - 0.5)) * (arg1[R] - 0.5) +
--                              (arg0[G] - 0.5)) * (arg1[G] - 0.5) +
--                              (arg0[B] - 0.5)) * (arg1[B] - 0.5))
--     \<\/programlisting>
--   \<\/listitem>
--   \<listitem>
--     \<programlisting>
--  DOT3_RGBA(arg0, arg1) = 4 x ((arg0[R] - 0.5)) * (arg1[R] - 0.5) +
--                               (arg0[G] - 0.5)) * (arg1[G] - 0.5) +
--                               (arg0[B] - 0.5)) * (arg1[B] - 0.5))
--     \<\/programlisting>
--   \<\/listitem>
-- \<\/itemizedlist>
-- 
-- Refer to the
-- \<link linkend=\"cogl-Blend-String-syntax\">color-source syntax\<\/link> for
-- describing the arguments. The valid source names for texture combining
-- are:
-- \<variablelist>
--   \<varlistentry>
--     \<term>TEXTURE\<\/term>
--     \<listitem>Use the color from the current texture layer\<\/listitem>
--   \<\/varlistentry>
--   \<varlistentry>
--     \<term>TEXTURE_0, TEXTURE_1, etc\<\/term>
--     \<listitem>Use the color from the specified texture layer\<\/listitem>
--   \<\/varlistentry>
--   \<varlistentry>
--     \<term>CONSTANT\<\/term>
--     \<listitem>Use the color from the constant given with
--     @/cogl_material_set_layer_constant()/@\<\/listitem>
--   \<\/varlistentry>
--   \<varlistentry>
--     \<term>PRIMARY\<\/term>
--     \<listitem>Use the color of the material as set with
--     'GI.Cogl.Structs.Material.materialSetColor'\<\/listitem>
--   \<\/varlistentry>
--   \<varlistentry>
--     \<term>PREVIOUS\<\/term>
--     \<listitem>Either use the texture color from the previous layer, or
--     if this is layer 0, use the color of the material as set with
--     'GI.Cogl.Structs.Material.materialSetColor'\<\/listitem>
--   \<\/varlistentry>
-- \<\/variablelist>
-- 
-- \<refsect2 id=\"cogl-Layer-Combine-Examples\">
--   \<title>Layer Combine Examples\<\/title>
--   \<para>This is effectively what the default blending is:\<\/para>
--   \<informalexample>\<programlisting>
--   RGBA = MODULATE (PREVIOUS, TEXTURE)
--   \<\/programlisting>\<\/informalexample>
--   \<para>This could be used to cross-fade between two images, using
--   the alpha component of a constant as the interpolator. The constant
--   color is given by calling cogl_material_set_layer_constant.\<\/para>
--   \<informalexample>\<programlisting>
--   RGBA = INTERPOLATE (PREVIOUS, TEXTURE, CONSTANT[A])
--   \<\/programlisting>\<\/informalexample>
-- \<\/refsect2>
-- 
-- \<note>You can\'t give a multiplication factor for arguments as you can
-- with blending.\<\/note>
-- 
-- /Since: 1.0/
materialSetLayerCombine ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Int32
    -- ^ /@layerIndex@/: Specifies the layer you want define a combine function for
    -> T.Text
    -- ^ /@blendString@/: A \<link linkend=\"cogl-Blend-Strings\">Cogl blend string\<\/link>
    --    describing the desired texture combine function.
    -> m Int32
    -- ^ __Returns:__ 'P.True' if the blend string was successfully parsed, and the
    --   described texture combining is supported by the underlying driver and
    --   or hardware. On failure, 'P.False' is returned and /@error@/ is set /(Can throw 'Data.GI.Base.GError.GError')/
materialSetLayerCombine :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Int32 -> Text -> m Int32
materialSetLayerCombine Material
material Int32
layerIndex Text
blendString = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    CString
blendString' <- Text -> IO CString
textToCString Text
blendString
    IO Int32 -> IO () -> IO Int32
forall a b. IO a -> IO b -> IO a
onException (do
        Int32
result <- (Ptr (Ptr GError) -> IO Int32) -> IO Int32
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Int32) -> IO Int32)
-> (Ptr (Ptr GError) -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ Ptr Material -> Int32 -> CString -> Ptr (Ptr GError) -> IO Int32
cogl_material_set_layer_combine Ptr Material
material' Int32
layerIndex CString
blendString'
        Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
blendString'
        Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
blendString'
     )

#if defined(ENABLE_OVERLOADING)
data MaterialSetLayerCombineMethodInfo
instance (signature ~ (Int32 -> T.Text -> m Int32), MonadIO m) => O.OverloadedMethod MaterialSetLayerCombineMethodInfo Material signature where
    overloadedMethod = materialSetLayerCombine

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


#endif

-- method Material::set_layer_combine_constant
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "layer_index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Specifies the layer you want to specify a constant used\n              for texture combining"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "constant"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The constant color you want"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_set_layer_combine_constant" cogl_material_set_layer_combine_constant :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Int32 ->                                -- layer_index : TBasicType TInt
    Ptr Cogl.Color.Color ->                 -- constant : TInterface (Name {namespace = "Cogl", name = "Color"})
    IO ()

{-# DEPRECATED materialSetLayerCombineConstant ["(Since version 1.16)","Use @/cogl_pipeline_set_layer_combine_constant()/@","instead"] #-}
-- | When you are using the \'CONSTANT\' color source in a layer combine
-- description then you can use this function to define its value.
-- 
-- /Since: 1.0/
materialSetLayerCombineConstant ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Int32
    -- ^ /@layerIndex@/: Specifies the layer you want to specify a constant used
    --               for texture combining
    -> Cogl.Color.Color
    -- ^ /@constant@/: The constant color you want
    -> m ()
materialSetLayerCombineConstant :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Int32 -> Color -> m ()
materialSetLayerCombineConstant Material
material Int32
layerIndex Color
constant = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    Ptr Color
constant' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
constant
    Ptr Material -> Int32 -> Ptr Color -> IO ()
cogl_material_set_layer_combine_constant Ptr Material
material' Int32
layerIndex Ptr Color
constant'
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
constant
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MaterialSetLayerCombineConstantMethodInfo
instance (signature ~ (Int32 -> Cogl.Color.Color -> m ()), MonadIO m) => O.OverloadedMethod MaterialSetLayerCombineConstantMethodInfo Material signature where
    overloadedMethod = materialSetLayerCombineConstant

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


#endif

-- method Material::set_layer_filters
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "layer_index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the layer number to change."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "min_filter"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "MaterialFilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the filter used when scaling a texture down."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mag_filter"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "MaterialFilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the filter used when magnifying a texture."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_set_layer_filters" cogl_material_set_layer_filters :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Int32 ->                                -- layer_index : TBasicType TInt
    CUInt ->                                -- min_filter : TInterface (Name {namespace = "Cogl", name = "MaterialFilter"})
    CUInt ->                                -- mag_filter : TInterface (Name {namespace = "Cogl", name = "MaterialFilter"})
    IO ()

{-# DEPRECATED materialSetLayerFilters ["(Since version 1.16)","Use @/cogl_pipeline_set_layer_filters()/@ instead"] #-}
-- | Changes the decimation and interpolation filters used when a texture is
-- drawn at other scales than 100%.
materialSetLayerFilters ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Int32
    -- ^ /@layerIndex@/: the layer number to change.
    -> Cogl.Enums.MaterialFilter
    -- ^ /@minFilter@/: the filter used when scaling a texture down.
    -> Cogl.Enums.MaterialFilter
    -- ^ /@magFilter@/: the filter used when magnifying a texture.
    -> m ()
materialSetLayerFilters :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Int32 -> MaterialFilter -> MaterialFilter -> m ()
materialSetLayerFilters Material
material Int32
layerIndex MaterialFilter
minFilter MaterialFilter
magFilter = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    let minFilter' :: CUInt
minFilter' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (MaterialFilter -> Int) -> MaterialFilter -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaterialFilter -> Int
forall a. Enum a => a -> Int
fromEnum) MaterialFilter
minFilter
    let magFilter' :: CUInt
magFilter' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (MaterialFilter -> Int) -> MaterialFilter -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaterialFilter -> Int
forall a. Enum a => a -> Int
fromEnum) MaterialFilter
magFilter
    Ptr Material -> Int32 -> CUInt -> CUInt -> IO ()
cogl_material_set_layer_filters Ptr Material
material' Int32
layerIndex CUInt
minFilter' CUInt
magFilter'
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MaterialSetLayerFiltersMethodInfo
instance (signature ~ (Int32 -> Cogl.Enums.MaterialFilter -> Cogl.Enums.MaterialFilter -> m ()), MonadIO m) => O.OverloadedMethod MaterialSetLayerFiltersMethodInfo Material signature where
    overloadedMethod = materialSetLayerFilters

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


#endif

-- method Material::set_layer_matrix
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "layer_index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index for the layer inside @material"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "matrix"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Matrix" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the transformation matrix for the layer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_set_layer_matrix" cogl_material_set_layer_matrix :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Int32 ->                                -- layer_index : TBasicType TInt
    Ptr Cogl.Matrix.Matrix ->               -- matrix : TInterface (Name {namespace = "Cogl", name = "Matrix"})
    IO ()

{-# DEPRECATED materialSetLayerMatrix ["(Since version 1.16)","Use @/cogl_pipeline_set_layer_matrix()/@ instead"] #-}
-- | This function lets you set a matrix that can be used to e.g. translate
-- and rotate a single layer of a material used to fill your geometry.
materialSetLayerMatrix ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Int32
    -- ^ /@layerIndex@/: the index for the layer inside /@material@/
    -> Cogl.Matrix.Matrix
    -- ^ /@matrix@/: the transformation matrix for the layer
    -> m ()
materialSetLayerMatrix :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Int32 -> Matrix -> m ()
materialSetLayerMatrix Material
material Int32
layerIndex 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    Ptr Matrix
matrix' <- Matrix -> IO (Ptr Matrix)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Matrix
matrix
    Ptr Material -> Int32 -> Ptr Matrix -> IO ()
cogl_material_set_layer_matrix Ptr Material
material' Int32
layerIndex Ptr Matrix
matrix'
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    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 MaterialSetLayerMatrixMethodInfo
instance (signature ~ (Int32 -> Cogl.Matrix.Matrix -> m ()), MonadIO m) => O.OverloadedMethod MaterialSetLayerMatrixMethodInfo Material signature where
    overloadedMethod = materialSetLayerMatrix

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


#endif

-- method Material::set_layer_point_sprite_coords_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglHandle to a material."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "layer_index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the layer number to change."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "enable"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "whether to enable point sprite coord generation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : True
-- Skip return : False

foreign import ccall "cogl_material_set_layer_point_sprite_coords_enabled" cogl_material_set_layer_point_sprite_coords_enabled :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Int32 ->                                -- layer_index : TBasicType TInt
    Int32 ->                                -- enable : TBasicType TInt
    Ptr (Ptr GError) ->                     -- error
    IO Int32

{-# DEPRECATED materialSetLayerPointSpriteCoordsEnabled ["(Since version 1.16)","Use @/cogl_pipeline_set_layer_point_sprite_coords_enabled()/@","                 instead"] #-}
-- | When rendering points, if /@enable@/ is 'P.True' then the texture
-- coordinates for this layer will be replaced with coordinates that
-- vary from 0.0 to 1.0 across the primitive. The top left of the
-- point will have the coordinates 0.0,0.0 and the bottom right will
-- have 1.0,1.0. If /@enable@/ is 'P.False' then the coordinates will be
-- fixed for the entire point.
-- 
-- This function will only work if 'GI.Cogl.Flags.FeatureFlagsPointSprite' is
-- available. If the feature is not available then the function will
-- return 'P.False' and set /@error@/.
-- 
-- /Since: 1.4/
materialSetLayerPointSpriteCoordsEnabled ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: a @/CoglHandle/@ to a material.
    -> Int32
    -- ^ /@layerIndex@/: the layer number to change.
    -> Int32
    -- ^ /@enable@/: whether to enable point sprite coord generation.
    -> m Int32
    -- ^ __Returns:__ 'P.True' if the function succeeds, 'P.False' otherwise. /(Can throw 'Data.GI.Base.GError.GError')/
materialSetLayerPointSpriteCoordsEnabled :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Int32 -> Int32 -> m Int32
materialSetLayerPointSpriteCoordsEnabled Material
material Int32
layerIndex Int32
enable = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    IO Int32 -> IO () -> IO Int32
forall a b. IO a -> IO b -> IO a
onException (do
        Int32
result <- (Ptr (Ptr GError) -> IO Int32) -> IO Int32
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Int32) -> IO Int32)
-> (Ptr (Ptr GError) -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ Ptr Material -> Int32 -> Int32 -> Ptr (Ptr GError) -> IO Int32
cogl_material_set_layer_point_sprite_coords_enabled Ptr Material
material' Int32
layerIndex Int32
enable
        Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
        Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data MaterialSetLayerPointSpriteCoordsEnabledMethodInfo
instance (signature ~ (Int32 -> Int32 -> m Int32), MonadIO m) => O.OverloadedMethod MaterialSetLayerPointSpriteCoordsEnabledMethodInfo Material signature where
    overloadedMethod = materialSetLayerPointSpriteCoordsEnabled

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


#endif

-- method Material::set_layer_wrap_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "layer_index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the layer number to change."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "MaterialWrapMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new wrap mode" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_set_layer_wrap_mode" cogl_material_set_layer_wrap_mode :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Int32 ->                                -- layer_index : TBasicType TInt
    CUInt ->                                -- mode : TInterface (Name {namespace = "Cogl", name = "MaterialWrapMode"})
    IO ()

{-# DEPRECATED materialSetLayerWrapMode ["(Since version 1.16)","Use @/cogl_pipeline_set_layer_wrap_mode()/@ instead"] #-}
-- | Sets the wrap mode for all three coordinates of texture lookups on
-- this layer. This is equivalent to calling
-- 'GI.Cogl.Structs.Material.materialSetLayerWrapModeS',
-- 'GI.Cogl.Structs.Material.materialSetLayerWrapModeT' and
-- 'GI.Cogl.Structs.Material.materialSetLayerWrapModeP' separately.
-- 
-- /Since: 1.4/
materialSetLayerWrapMode ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Int32
    -- ^ /@layerIndex@/: the layer number to change.
    -> Cogl.Enums.MaterialWrapMode
    -- ^ /@mode@/: the new wrap mode
    -> m ()
materialSetLayerWrapMode :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Int32 -> MaterialWrapMode -> m ()
materialSetLayerWrapMode Material
material Int32
layerIndex MaterialWrapMode
mode = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (MaterialWrapMode -> Int) -> MaterialWrapMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaterialWrapMode -> Int
forall a. Enum a => a -> Int
fromEnum) MaterialWrapMode
mode
    Ptr Material -> Int32 -> CUInt -> IO ()
cogl_material_set_layer_wrap_mode Ptr Material
material' Int32
layerIndex CUInt
mode'
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MaterialSetLayerWrapModeMethodInfo
instance (signature ~ (Int32 -> Cogl.Enums.MaterialWrapMode -> m ()), MonadIO m) => O.OverloadedMethod MaterialSetLayerWrapModeMethodInfo Material signature where
    overloadedMethod = materialSetLayerWrapMode

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


#endif

-- method Material::set_layer_wrap_mode_p
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "layer_index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the layer number to change."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "MaterialWrapMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new wrap mode" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_set_layer_wrap_mode_p" cogl_material_set_layer_wrap_mode_p :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Int32 ->                                -- layer_index : TBasicType TInt
    CUInt ->                                -- mode : TInterface (Name {namespace = "Cogl", name = "MaterialWrapMode"})
    IO ()

{-# DEPRECATED materialSetLayerWrapModeP ["(Since version 1.16)","Use @/cogl_pipeline_set_layer_wrap_mode_p()/@ instead"] #-}
-- | Sets the wrap mode for the \'p\' coordinate of texture lookups on
-- this layer. \'p\' is the third coordinate.
-- 
-- /Since: 1.4/
materialSetLayerWrapModeP ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Int32
    -- ^ /@layerIndex@/: the layer number to change.
    -> Cogl.Enums.MaterialWrapMode
    -- ^ /@mode@/: the new wrap mode
    -> m ()
materialSetLayerWrapModeP :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Int32 -> MaterialWrapMode -> m ()
materialSetLayerWrapModeP Material
material Int32
layerIndex MaterialWrapMode
mode = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (MaterialWrapMode -> Int) -> MaterialWrapMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaterialWrapMode -> Int
forall a. Enum a => a -> Int
fromEnum) MaterialWrapMode
mode
    Ptr Material -> Int32 -> CUInt -> IO ()
cogl_material_set_layer_wrap_mode_p Ptr Material
material' Int32
layerIndex CUInt
mode'
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MaterialSetLayerWrapModePMethodInfo
instance (signature ~ (Int32 -> Cogl.Enums.MaterialWrapMode -> m ()), MonadIO m) => O.OverloadedMethod MaterialSetLayerWrapModePMethodInfo Material signature where
    overloadedMethod = materialSetLayerWrapModeP

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


#endif

-- method Material::set_layer_wrap_mode_s
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "layer_index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the layer number to change."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "MaterialWrapMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new wrap mode" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_set_layer_wrap_mode_s" cogl_material_set_layer_wrap_mode_s :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Int32 ->                                -- layer_index : TBasicType TInt
    CUInt ->                                -- mode : TInterface (Name {namespace = "Cogl", name = "MaterialWrapMode"})
    IO ()

{-# DEPRECATED materialSetLayerWrapModeS ["(Since version 1.16)","Use @/cogl_pipeline_set_layer_wrap_mode_s()/@ instead"] #-}
-- | Sets the wrap mode for the \'s\' coordinate of texture lookups on this layer.
-- 
-- /Since: 1.4/
materialSetLayerWrapModeS ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Int32
    -- ^ /@layerIndex@/: the layer number to change.
    -> Cogl.Enums.MaterialWrapMode
    -- ^ /@mode@/: the new wrap mode
    -> m ()
materialSetLayerWrapModeS :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Int32 -> MaterialWrapMode -> m ()
materialSetLayerWrapModeS Material
material Int32
layerIndex MaterialWrapMode
mode = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (MaterialWrapMode -> Int) -> MaterialWrapMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaterialWrapMode -> Int
forall a. Enum a => a -> Int
fromEnum) MaterialWrapMode
mode
    Ptr Material -> Int32 -> CUInt -> IO ()
cogl_material_set_layer_wrap_mode_s Ptr Material
material' Int32
layerIndex CUInt
mode'
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MaterialSetLayerWrapModeSMethodInfo
instance (signature ~ (Int32 -> Cogl.Enums.MaterialWrapMode -> m ()), MonadIO m) => O.OverloadedMethod MaterialSetLayerWrapModeSMethodInfo Material signature where
    overloadedMethod = materialSetLayerWrapModeS

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


#endif

-- method Material::set_layer_wrap_mode_t
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "layer_index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the layer number to change."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "MaterialWrapMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new wrap mode" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_set_layer_wrap_mode_t" cogl_material_set_layer_wrap_mode_t :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Int32 ->                                -- layer_index : TBasicType TInt
    CUInt ->                                -- mode : TInterface (Name {namespace = "Cogl", name = "MaterialWrapMode"})
    IO ()

{-# DEPRECATED materialSetLayerWrapModeT ["(Since version 1.16)","Use @/cogl_pipeline_set_layer_wrap_mode_t()/@ instead"] #-}
-- | Sets the wrap mode for the \'t\' coordinate of texture lookups on this layer.
-- 
-- /Since: 1.4/
materialSetLayerWrapModeT ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Int32
    -- ^ /@layerIndex@/: the layer number to change.
    -> Cogl.Enums.MaterialWrapMode
    -- ^ /@mode@/: the new wrap mode
    -> m ()
materialSetLayerWrapModeT :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Int32 -> MaterialWrapMode -> m ()
materialSetLayerWrapModeT Material
material Int32
layerIndex MaterialWrapMode
mode = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (MaterialWrapMode -> Int) -> MaterialWrapMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaterialWrapMode -> Int
forall a. Enum a => a -> Int
fromEnum) MaterialWrapMode
mode
    Ptr Material -> Int32 -> CUInt -> IO ()
cogl_material_set_layer_wrap_mode_t Ptr Material
material' Int32
layerIndex CUInt
mode'
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MaterialSetLayerWrapModeTMethodInfo
instance (signature ~ (Int32 -> Cogl.Enums.MaterialWrapMode -> m ()), MonadIO m) => O.OverloadedMethod MaterialSetLayerWrapModeTMethodInfo Material signature where
    overloadedMethod = materialSetLayerWrapModeT

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


#endif

-- method Material::set_point_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a material." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "point_size"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new point size."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_set_point_size" cogl_material_set_point_size :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    CFloat ->                               -- point_size : TBasicType TFloat
    IO ()

{-# DEPRECATED materialSetPointSize ["(Since version 1.16)","Use @/cogl_pipeline_set_point_size()/@ instead"] #-}
-- | Changes the size of points drawn when 'GI.Cogl.Enums.VerticesModePoints' is
-- used with the vertex buffer API. Note that typically the GPU will
-- only support a limited minimum and maximum range of point sizes. If
-- the chosen point size is outside that range then the nearest value
-- within that range will be used instead. The size of a point is in
-- screen space so it will be the same regardless of any
-- transformations. The default point size is 1.0.
-- 
-- /Since: 1.4/
materialSetPointSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: a material.
    -> Float
    -- ^ /@pointSize@/: the new point size.
    -> m ()
materialSetPointSize :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Float -> m ()
materialSetPointSize Material
material Float
pointSize = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    let pointSize' :: CFloat
pointSize' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
pointSize
    Ptr Material -> CFloat -> IO ()
cogl_material_set_point_size Ptr Material
material' CFloat
pointSize'
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MaterialSetPointSizeMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m) => O.OverloadedMethod MaterialSetPointSizeMethodInfo Material signature where
    overloadedMethod = materialSetPointSize

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


#endif

-- method Material::set_shininess
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "shininess"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The desired shininess; must be >= 0.0"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_set_shininess" cogl_material_set_shininess :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    CFloat ->                               -- shininess : TBasicType TFloat
    IO ()

{-# DEPRECATED materialSetShininess ["(Since version 1.16)","Use the @/CoglSnippet/@ shader api for lighting"] #-}
-- | Sets the shininess of the material, in the standard OpenGL lighting
-- model, which determines the size of the specular highlights. A
-- higher /@shininess@/ will produce smaller highlights which makes the
-- object appear more shiny.
-- 
-- The default value is 0.0
-- 
-- /Since: 1.0/
materialSetShininess ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Float
    -- ^ /@shininess@/: The desired shininess; must be >= 0.0
    -> m ()
materialSetShininess :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Float -> m ()
materialSetShininess Material
material Float
shininess = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    let shininess' :: CFloat
shininess' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
shininess
    Ptr Material -> CFloat -> IO ()
cogl_material_set_shininess Ptr Material
material' CFloat
shininess'
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MaterialSetShininessMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m) => O.OverloadedMethod MaterialSetShininessMethodInfo Material signature where
    overloadedMethod = materialSetShininess

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


#endif

-- method Material::set_specular
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterial object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "specular"
--           , argType = TInterface Name { namespace = "Cogl" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The components of the desired specular color"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_set_specular" cogl_material_set_specular :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Ptr Cogl.Color.Color ->                 -- specular : TInterface (Name {namespace = "Cogl", name = "Color"})
    IO ()

{-# DEPRECATED materialSetSpecular ["(Since version 1.16)","Use the @/CoglSnippet/@ shader api for lighting"] #-}
-- | Sets the material\'s specular color, in the standard OpenGL lighting
-- model. The intensity of the specular color depends on the viewport
-- position, and is brightest along the lines of reflection.
-- 
-- The default value is (0.0, 0.0, 0.0, 1.0)
-- 
-- /Since: 1.0/
materialSetSpecular ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: A t'GI.Cogl.Structs.Material.Material' object
    -> Cogl.Color.Color
    -- ^ /@specular@/: The components of the desired specular color
    -> m ()
materialSetSpecular :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Color -> m ()
materialSetSpecular Material
material Color
specular = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    Ptr Color
specular' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
specular
    Ptr Material -> Ptr Color -> IO ()
cogl_material_set_specular Ptr Material
material' Ptr Color
specular'
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
specular
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MaterialSetSpecularMethodInfo
instance (signature ~ (Cogl.Color.Color -> m ()), MonadIO m) => O.OverloadedMethod MaterialSetSpecularMethodInfo Material signature where
    overloadedMethod = materialSetSpecular

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


#endif

-- method Material::set_user_program
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "material"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Material" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglMaterial object."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "program"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglHandle to a linked CoglProgram"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_set_user_program" cogl_material_set_user_program :: 
    Ptr Material ->                         -- material : TInterface (Name {namespace = "Cogl", name = "Material"})
    Ptr () ->                               -- program : TBasicType TPtr
    IO ()

{-# DEPRECATED materialSetUserProgram ["(Since version 1.16)","Use @/CoglSnippet/@ api instead instead"] #-}
-- | Associates a linked CoglProgram with the given material so that the
-- program can take full control of vertex and\/or fragment processing.
-- 
-- This is an example of how it can be used to associate an ARBfp
-- program with a t'GI.Cogl.Structs.Material.Material':
-- >
-- >CoglHandle shader;
-- >CoglHandle program;
-- >CoglMaterial *material;
-- >
-- >shader = cogl_create_shader (COGL_SHADER_TYPE_FRAGMENT);
-- >cogl_shader_source (shader,
-- >                    "!!ARBfp1.0\n"
-- >                    "MOV result.color,fragment.color;\n"
-- >                    "END\n");
-- >cogl_shader_compile (shader);
-- >
-- >program = cogl_create_program ();
-- >cogl_program_attach_shader (program, shader);
-- >cogl_program_link (program);
-- >
-- >material = cogl_material_new ();
-- >cogl_material_set_user_program (material, program);
-- >
-- >cogl_set_source_color4ub (0xff, 0x00, 0x00, 0xff);
-- >cogl_rectangle (0, 0, 100, 100);
-- 
-- 
-- It is possibly worth keeping in mind that this API is not part of
-- the long term design for how we want to expose shaders to Cogl
-- developers (We are planning on deprecating the cogl_program and
-- cogl_shader APIs in favour of a \"snippet\" framework) but in the
-- meantime we hope this will handle most practical GLSL and ARBfp
-- requirements.
-- 
-- Also remember you need to check for either the
-- 'GI.Cogl.Flags.FeatureFlagsShadersGlsl' or 'GI.Cogl.Flags.FeatureFlagsShadersArbfp' before
-- using the cogl_program or cogl_shader API.
-- 
-- /Since: 1.4/
materialSetUserProgram ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Material
    -- ^ /@material@/: a t'GI.Cogl.Structs.Material.Material' object.
    -> Ptr ()
    -- ^ /@program@/: A @/CoglHandle/@ to a linked CoglProgram
    -> m ()
materialSetUserProgram :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Material -> Ptr () -> m ()
materialSetUserProgram Material
material Ptr ()
program = 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 Material
material' <- Material -> IO (Ptr Material)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Material
material
    Ptr Material -> Ptr () -> IO ()
cogl_material_set_user_program Ptr Material
material' Ptr ()
program
    Material -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Material
material
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MaterialSetUserProgramMethodInfo
instance (signature ~ (Ptr () -> m ()), MonadIO m) => O.OverloadedMethod MaterialSetUserProgramMethodInfo Material signature where
    overloadedMethod = materialSetUserProgram

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


#endif

-- method Material::ref
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "material"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglMaterial object."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TPtr)
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_ref" cogl_material_ref :: 
    Ptr () ->                               -- material : TBasicType TPtr
    IO (Ptr ())

{-# DEPRECATED materialRef ["(Since version 1.2)","Use @/cogl_object_ref()/@ instead"] #-}
-- | Increment the reference count for a t'GI.Cogl.Structs.Material.Material'.
-- 
-- /Since: 1.0/
materialRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ptr ()
    -- ^ /@material@/: a t'GI.Cogl.Structs.Material.Material' object.
    -> m (Ptr ())
    -- ^ __Returns:__ the /@material@/.
materialRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Ptr () -> m (Ptr ())
materialRef Ptr ()
material = IO (Ptr ()) -> m (Ptr ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
    Ptr ()
result <- Ptr () -> IO (Ptr ())
cogl_material_ref Ptr ()
material
    Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result

#if defined(ENABLE_OVERLOADING)
#endif

-- method Material::unref
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "material"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglMaterial object."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_material_unref" cogl_material_unref :: 
    Ptr () ->                               -- material : TBasicType TPtr
    IO ()

{-# DEPRECATED materialUnref ["(Since version 1.2)","Use @/cogl_object_unref()/@ instead"] #-}
-- | Decrement the reference count for a t'GI.Cogl.Structs.Material.Material'.
-- 
-- /Since: 1.0/
materialUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ptr ()
    -- ^ /@material@/: a t'GI.Cogl.Structs.Material.Material' object.
    -> m ()
materialUnref :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Ptr () -> m ()
materialUnref Ptr ()
material = 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 () -> IO ()
cogl_material_unref Ptr ()
material
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveMaterialMethod (t :: Symbol) (o :: *) :: * where
    ResolveMaterialMethod "removeLayer" o = MaterialRemoveLayerMethodInfo
    ResolveMaterialMethod "getAmbient" o = MaterialGetAmbientMethodInfo
    ResolveMaterialMethod "getColor" o = MaterialGetColorMethodInfo
    ResolveMaterialMethod "getDiffuse" o = MaterialGetDiffuseMethodInfo
    ResolveMaterialMethod "getEmission" o = MaterialGetEmissionMethodInfo
    ResolveMaterialMethod "getLayerPointSpriteCoordsEnabled" o = MaterialGetLayerPointSpriteCoordsEnabledMethodInfo
    ResolveMaterialMethod "getLayerWrapModeP" o = MaterialGetLayerWrapModePMethodInfo
    ResolveMaterialMethod "getLayerWrapModeS" o = MaterialGetLayerWrapModeSMethodInfo
    ResolveMaterialMethod "getLayerWrapModeT" o = MaterialGetLayerWrapModeTMethodInfo
    ResolveMaterialMethod "getLayers" o = MaterialGetLayersMethodInfo
    ResolveMaterialMethod "getNLayers" o = MaterialGetNLayersMethodInfo
    ResolveMaterialMethod "getPointSize" o = MaterialGetPointSizeMethodInfo
    ResolveMaterialMethod "getShininess" o = MaterialGetShininessMethodInfo
    ResolveMaterialMethod "getSpecular" o = MaterialGetSpecularMethodInfo
    ResolveMaterialMethod "getUserProgram" o = MaterialGetUserProgramMethodInfo
    ResolveMaterialMethod "setAlphaTestFunction" o = MaterialSetAlphaTestFunctionMethodInfo
    ResolveMaterialMethod "setAmbient" o = MaterialSetAmbientMethodInfo
    ResolveMaterialMethod "setAmbientAndDiffuse" o = MaterialSetAmbientAndDiffuseMethodInfo
    ResolveMaterialMethod "setBlend" o = MaterialSetBlendMethodInfo
    ResolveMaterialMethod "setBlendConstant" o = MaterialSetBlendConstantMethodInfo
    ResolveMaterialMethod "setColor" o = MaterialSetColorMethodInfo
    ResolveMaterialMethod "setColor4f" o = MaterialSetColor4fMethodInfo
    ResolveMaterialMethod "setColor4ub" o = MaterialSetColor4ubMethodInfo
    ResolveMaterialMethod "setDiffuse" o = MaterialSetDiffuseMethodInfo
    ResolveMaterialMethod "setEmission" o = MaterialSetEmissionMethodInfo
    ResolveMaterialMethod "setLayer" o = MaterialSetLayerMethodInfo
    ResolveMaterialMethod "setLayerCombine" o = MaterialSetLayerCombineMethodInfo
    ResolveMaterialMethod "setLayerCombineConstant" o = MaterialSetLayerCombineConstantMethodInfo
    ResolveMaterialMethod "setLayerFilters" o = MaterialSetLayerFiltersMethodInfo
    ResolveMaterialMethod "setLayerMatrix" o = MaterialSetLayerMatrixMethodInfo
    ResolveMaterialMethod "setLayerPointSpriteCoordsEnabled" o = MaterialSetLayerPointSpriteCoordsEnabledMethodInfo
    ResolveMaterialMethod "setLayerWrapMode" o = MaterialSetLayerWrapModeMethodInfo
    ResolveMaterialMethod "setLayerWrapModeP" o = MaterialSetLayerWrapModePMethodInfo
    ResolveMaterialMethod "setLayerWrapModeS" o = MaterialSetLayerWrapModeSMethodInfo
    ResolveMaterialMethod "setLayerWrapModeT" o = MaterialSetLayerWrapModeTMethodInfo
    ResolveMaterialMethod "setPointSize" o = MaterialSetPointSizeMethodInfo
    ResolveMaterialMethod "setShininess" o = MaterialSetShininessMethodInfo
    ResolveMaterialMethod "setSpecular" o = MaterialSetSpecularMethodInfo
    ResolveMaterialMethod "setUserProgram" o = MaterialSetUserProgramMethodInfo
    ResolveMaterialMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif