{-# 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.MaterialLayer
    ( 

-- * Exported types
    MaterialLayer(..)                       ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- /None/.
-- 
-- ==== Getters
-- [getMagFilter]("GI.Cogl.Structs.MaterialLayer#g:method:getMagFilter"), [getMinFilter]("GI.Cogl.Structs.MaterialLayer#g:method:getMinFilter"), [getTexture]("GI.Cogl.Structs.MaterialLayer#g:method:getTexture"), [getType]("GI.Cogl.Structs.MaterialLayer#g:method:getType"), [getWrapModeP]("GI.Cogl.Structs.MaterialLayer#g:method:getWrapModeP"), [getWrapModeS]("GI.Cogl.Structs.MaterialLayer#g:method:getWrapModeS"), [getWrapModeT]("GI.Cogl.Structs.MaterialLayer#g:method:getWrapModeT").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveMaterialLayerMethod              ,
#endif

-- ** getMagFilter #method:getMagFilter#

#if defined(ENABLE_OVERLOADING)
    MaterialLayerGetMagFilterMethodInfo     ,
#endif
    materialLayerGetMagFilter               ,


-- ** getMinFilter #method:getMinFilter#

#if defined(ENABLE_OVERLOADING)
    MaterialLayerGetMinFilterMethodInfo     ,
#endif
    materialLayerGetMinFilter               ,


-- ** getTexture #method:getTexture#

#if defined(ENABLE_OVERLOADING)
    MaterialLayerGetTextureMethodInfo       ,
#endif
    materialLayerGetTexture                 ,


-- ** getType #method:getType#

#if defined(ENABLE_OVERLOADING)
    MaterialLayerGetTypeMethodInfo          ,
#endif
    materialLayerGetType                    ,


-- ** getWrapModeP #method:getWrapModeP#

#if defined(ENABLE_OVERLOADING)
    MaterialLayerGetWrapModePMethodInfo     ,
#endif
    materialLayerGetWrapModeP               ,


-- ** getWrapModeS #method:getWrapModeS#

#if defined(ENABLE_OVERLOADING)
    MaterialLayerGetWrapModeSMethodInfo     ,
#endif
    materialLayerGetWrapModeS               ,


-- ** getWrapModeT #method:getWrapModeT#

#if defined(ENABLE_OVERLOADING)
    MaterialLayerGetWrapModeTMethodInfo     ,
#endif
    materialLayerGetWrapModeT               ,




    ) where

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

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

import {-# SOURCE #-} qualified GI.Cogl.Enums as Cogl.Enums

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

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

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


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList MaterialLayer
type instance O.AttributeList MaterialLayer = MaterialLayerAttributeList
type MaterialLayerAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

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

foreign import ccall "cogl_material_layer_get_mag_filter" cogl_material_layer_get_mag_filter :: 
    Ptr MaterialLayer ->                    -- layer : TInterface (Name {namespace = "Cogl", name = "MaterialLayer"})
    IO CUInt

{-# DEPRECATED materialLayerGetMagFilter ["(Since version 1.16)","No replacement"] #-}
-- | Queries the currently set downscaling filter for a material later
materialLayerGetMagFilter ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MaterialLayer
    -- ^ /@layer@/: A t'GI.Cogl.Structs.MaterialLayer.MaterialLayer' object
    -> m Cogl.Enums.MaterialFilter
    -- ^ __Returns:__ the current downscaling filter
materialLayerGetMagFilter :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MaterialLayer -> m MaterialFilter
materialLayerGetMagFilter MaterialLayer
layer = IO MaterialFilter -> m MaterialFilter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MaterialFilter -> m MaterialFilter)
-> IO MaterialFilter -> m MaterialFilter
forall a b. (a -> b) -> a -> b
$ do
    Ptr MaterialLayer
layer' <- MaterialLayer -> IO (Ptr MaterialLayer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MaterialLayer
layer
    CUInt
result <- Ptr MaterialLayer -> IO CUInt
cogl_material_layer_get_mag_filter Ptr MaterialLayer
layer'
    let result' :: MaterialFilter
result' = (Int -> MaterialFilter
forall a. Enum a => Int -> a
toEnum (Int -> MaterialFilter)
-> (CUInt -> Int) -> CUInt -> MaterialFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    MaterialLayer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MaterialLayer
layer
    MaterialFilter -> IO MaterialFilter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MaterialFilter
result'

#if defined(ENABLE_OVERLOADING)
data MaterialLayerGetMagFilterMethodInfo
instance (signature ~ (m Cogl.Enums.MaterialFilter), MonadIO m) => O.OverloadedMethod MaterialLayerGetMagFilterMethodInfo MaterialLayer signature where
    overloadedMethod = materialLayerGetMagFilter

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


#endif

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

foreign import ccall "cogl_material_layer_get_min_filter" cogl_material_layer_get_min_filter :: 
    Ptr MaterialLayer ->                    -- layer : TInterface (Name {namespace = "Cogl", name = "MaterialLayer"})
    IO CUInt

{-# DEPRECATED materialLayerGetMinFilter ["(Since version 1.16)","No replacement"] #-}
-- | Queries the currently set downscaling filter for a material layer
materialLayerGetMinFilter ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MaterialLayer
    -- ^ /@layer@/: a @/CoglHandle/@ for a material layer
    -> m Cogl.Enums.MaterialFilter
    -- ^ __Returns:__ the current downscaling filter
materialLayerGetMinFilter :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MaterialLayer -> m MaterialFilter
materialLayerGetMinFilter MaterialLayer
layer = IO MaterialFilter -> m MaterialFilter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MaterialFilter -> m MaterialFilter)
-> IO MaterialFilter -> m MaterialFilter
forall a b. (a -> b) -> a -> b
$ do
    Ptr MaterialLayer
layer' <- MaterialLayer -> IO (Ptr MaterialLayer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MaterialLayer
layer
    CUInt
result <- Ptr MaterialLayer -> IO CUInt
cogl_material_layer_get_min_filter Ptr MaterialLayer
layer'
    let result' :: MaterialFilter
result' = (Int -> MaterialFilter
forall a. Enum a => Int -> a
toEnum (Int -> MaterialFilter)
-> (CUInt -> Int) -> CUInt -> MaterialFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    MaterialLayer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MaterialLayer
layer
    MaterialFilter -> IO MaterialFilter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MaterialFilter
result'

#if defined(ENABLE_OVERLOADING)
data MaterialLayerGetMinFilterMethodInfo
instance (signature ~ (m Cogl.Enums.MaterialFilter), MonadIO m) => O.OverloadedMethod MaterialLayerGetMinFilterMethodInfo MaterialLayer signature where
    overloadedMethod = materialLayerGetMinFilter

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


#endif

-- method MaterialLayer::get_texture
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layer"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "MaterialLayer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterialLayer 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_layer_get_texture" cogl_material_layer_get_texture :: 
    Ptr MaterialLayer ->                    -- layer : TInterface (Name {namespace = "Cogl", name = "MaterialLayer"})
    IO (Ptr ())

{-# DEPRECATED materialLayerGetTexture ["(Since version 1.16)","No replacement"] #-}
-- | Extracts a texture handle for a specific layer.
-- 
-- \<note>In the future Cogl may support purely GLSL based layers; for those
-- layers this function which will likely return @/COGL_INVALID_HANDLE/@ if you
-- try to get the texture handle from them. Considering this scenario, you
-- should call 'GI.Cogl.Structs.MaterialLayer.materialLayerGetType' first in order check it is of
-- type 'GI.Cogl.Enums.MaterialLayerTypeTexture' before calling this function.\<\/note>
materialLayerGetTexture ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MaterialLayer
    -- ^ /@layer@/: A t'GI.Cogl.Structs.MaterialLayer.MaterialLayer' object
    -> m (Ptr ())
    -- ^ __Returns:__ a @/CoglHandle/@ for the texture inside the layer
materialLayerGetTexture :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MaterialLayer -> m (Ptr ())
materialLayerGetTexture MaterialLayer
layer = 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 MaterialLayer
layer' <- MaterialLayer -> IO (Ptr MaterialLayer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MaterialLayer
layer
    Ptr ()
result <- Ptr MaterialLayer -> IO (Ptr ())
cogl_material_layer_get_texture Ptr MaterialLayer
layer'
    MaterialLayer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MaterialLayer
layer
    Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result

#if defined(ENABLE_OVERLOADING)
data MaterialLayerGetTextureMethodInfo
instance (signature ~ (m (Ptr ())), MonadIO m) => O.OverloadedMethod MaterialLayerGetTextureMethodInfo MaterialLayer signature where
    overloadedMethod = materialLayerGetTexture

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


#endif

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

foreign import ccall "cogl_material_layer_get_type" cogl_material_layer_get_type :: 
    Ptr MaterialLayer ->                    -- layer : TInterface (Name {namespace = "Cogl", name = "MaterialLayer"})
    IO CUInt

{-# DEPRECATED materialLayerGetType ["(Since version 1.16)","No replacement"] #-}
-- | Retrieves the type of the layer
-- 
-- Currently there is only one type of layer defined:
-- 'GI.Cogl.Enums.MaterialLayerTypeTexture', but considering we may add purely GLSL
-- based layers in the future, you should write code that checks the type
-- first.
materialLayerGetType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MaterialLayer
    -- ^ /@layer@/: A t'GI.Cogl.Structs.MaterialLayer.MaterialLayer' object
    -> m Cogl.Enums.MaterialLayerType
    -- ^ __Returns:__ the type of the layer
materialLayerGetType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MaterialLayer -> m MaterialLayerType
materialLayerGetType MaterialLayer
layer = IO MaterialLayerType -> m MaterialLayerType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MaterialLayerType -> m MaterialLayerType)
-> IO MaterialLayerType -> m MaterialLayerType
forall a b. (a -> b) -> a -> b
$ do
    Ptr MaterialLayer
layer' <- MaterialLayer -> IO (Ptr MaterialLayer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MaterialLayer
layer
    CUInt
result <- Ptr MaterialLayer -> IO CUInt
cogl_material_layer_get_type Ptr MaterialLayer
layer'
    let result' :: MaterialLayerType
result' = (Int -> MaterialLayerType
forall a. Enum a => Int -> a
toEnum (Int -> MaterialLayerType)
-> (CUInt -> Int) -> CUInt -> MaterialLayerType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    MaterialLayer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MaterialLayer
layer
    MaterialLayerType -> IO MaterialLayerType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MaterialLayerType
result'

#if defined(ENABLE_OVERLOADING)
data MaterialLayerGetTypeMethodInfo
instance (signature ~ (m Cogl.Enums.MaterialLayerType), MonadIO m) => O.OverloadedMethod MaterialLayerGetTypeMethodInfo MaterialLayer signature where
    overloadedMethod = materialLayerGetType

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


#endif

-- method MaterialLayer::get_wrap_mode_p
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layer"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "MaterialLayer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterialLayer object"
--                 , 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_layer_get_wrap_mode_p" cogl_material_layer_get_wrap_mode_p :: 
    Ptr MaterialLayer ->                    -- layer : TInterface (Name {namespace = "Cogl", name = "MaterialLayer"})
    IO CUInt

{-# DEPRECATED materialLayerGetWrapModeP ["(Since version 1.16)","Use @/cogl_pipeline_layer_get_wrap_mode_p()/@ instead"] #-}
-- | Gets the wrap mode for the \'p\' coordinate of texture lookups on
-- this layer. \'p\' is the third coordinate.
-- 
-- /Since: 1.4/
materialLayerGetWrapModeP ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MaterialLayer
    -- ^ /@layer@/: A t'GI.Cogl.Structs.MaterialLayer.MaterialLayer' object
    -> m Cogl.Enums.MaterialWrapMode
    -- ^ __Returns:__ the wrap mode value for the p coordinate.
materialLayerGetWrapModeP :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MaterialLayer -> m MaterialWrapMode
materialLayerGetWrapModeP MaterialLayer
layer = 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 MaterialLayer
layer' <- MaterialLayer -> IO (Ptr MaterialLayer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MaterialLayer
layer
    CUInt
result <- Ptr MaterialLayer -> IO CUInt
cogl_material_layer_get_wrap_mode_p Ptr MaterialLayer
layer'
    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
    MaterialLayer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MaterialLayer
layer
    MaterialWrapMode -> IO MaterialWrapMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MaterialWrapMode
result'

#if defined(ENABLE_OVERLOADING)
data MaterialLayerGetWrapModePMethodInfo
instance (signature ~ (m Cogl.Enums.MaterialWrapMode), MonadIO m) => O.OverloadedMethod MaterialLayerGetWrapModePMethodInfo MaterialLayer signature where
    overloadedMethod = materialLayerGetWrapModeP

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


#endif

-- method MaterialLayer::get_wrap_mode_s
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layer"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "MaterialLayer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterialLayer object"
--                 , 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_layer_get_wrap_mode_s" cogl_material_layer_get_wrap_mode_s :: 
    Ptr MaterialLayer ->                    -- layer : TInterface (Name {namespace = "Cogl", name = "MaterialLayer"})
    IO CUInt

{-# DEPRECATED materialLayerGetWrapModeS ["(Since version 1.16)","Use @/cogl_pipeline_layer_get_wrap_mode_s()/@ instead"] #-}
-- | Gets the wrap mode for the \'s\' coordinate of texture lookups on this layer.
-- 
-- /Since: 1.4/
materialLayerGetWrapModeS ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MaterialLayer
    -- ^ /@layer@/: A t'GI.Cogl.Structs.MaterialLayer.MaterialLayer' object
    -> m Cogl.Enums.MaterialWrapMode
    -- ^ __Returns:__ the wrap mode value for the s coordinate.
materialLayerGetWrapModeS :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MaterialLayer -> m MaterialWrapMode
materialLayerGetWrapModeS MaterialLayer
layer = 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 MaterialLayer
layer' <- MaterialLayer -> IO (Ptr MaterialLayer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MaterialLayer
layer
    CUInt
result <- Ptr MaterialLayer -> IO CUInt
cogl_material_layer_get_wrap_mode_s Ptr MaterialLayer
layer'
    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
    MaterialLayer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MaterialLayer
layer
    MaterialWrapMode -> IO MaterialWrapMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MaterialWrapMode
result'

#if defined(ENABLE_OVERLOADING)
data MaterialLayerGetWrapModeSMethodInfo
instance (signature ~ (m Cogl.Enums.MaterialWrapMode), MonadIO m) => O.OverloadedMethod MaterialLayerGetWrapModeSMethodInfo MaterialLayer signature where
    overloadedMethod = materialLayerGetWrapModeS

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


#endif

-- method MaterialLayer::get_wrap_mode_t
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layer"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "MaterialLayer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglMaterialLayer object"
--                 , 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_layer_get_wrap_mode_t" cogl_material_layer_get_wrap_mode_t :: 
    Ptr MaterialLayer ->                    -- layer : TInterface (Name {namespace = "Cogl", name = "MaterialLayer"})
    IO CUInt

{-# DEPRECATED materialLayerGetWrapModeT ["(Since version 1.16)","Use @/cogl_pipeline_layer_get_wrap_mode_t()/@ instead"] #-}
-- | Gets the wrap mode for the \'t\' coordinate of texture lookups on this layer.
-- 
-- /Since: 1.4/
materialLayerGetWrapModeT ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MaterialLayer
    -- ^ /@layer@/: A t'GI.Cogl.Structs.MaterialLayer.MaterialLayer' object
    -> m Cogl.Enums.MaterialWrapMode
    -- ^ __Returns:__ the wrap mode value for the t coordinate.
materialLayerGetWrapModeT :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MaterialLayer -> m MaterialWrapMode
materialLayerGetWrapModeT MaterialLayer
layer = 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 MaterialLayer
layer' <- MaterialLayer -> IO (Ptr MaterialLayer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MaterialLayer
layer
    CUInt
result <- Ptr MaterialLayer -> IO CUInt
cogl_material_layer_get_wrap_mode_t Ptr MaterialLayer
layer'
    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
    MaterialLayer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MaterialLayer
layer
    MaterialWrapMode -> IO MaterialWrapMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MaterialWrapMode
result'

#if defined(ENABLE_OVERLOADING)
data MaterialLayerGetWrapModeTMethodInfo
instance (signature ~ (m Cogl.Enums.MaterialWrapMode), MonadIO m) => O.OverloadedMethod MaterialLayerGetWrapModeTMethodInfo MaterialLayer signature where
    overloadedMethod = materialLayerGetWrapModeT

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


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveMaterialLayerMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveMaterialLayerMethod "getMagFilter" o = MaterialLayerGetMagFilterMethodInfo
    ResolveMaterialLayerMethod "getMinFilter" o = MaterialLayerGetMinFilterMethodInfo
    ResolveMaterialLayerMethod "getTexture" o = MaterialLayerGetTextureMethodInfo
    ResolveMaterialLayerMethod "getType" o = MaterialLayerGetTypeMethodInfo
    ResolveMaterialLayerMethod "getWrapModeP" o = MaterialLayerGetWrapModePMethodInfo
    ResolveMaterialLayerMethod "getWrapModeS" o = MaterialLayerGetWrapModeSMethodInfo
    ResolveMaterialLayerMethod "getWrapModeT" o = MaterialLayerGetWrapModeTMethodInfo
    ResolveMaterialLayerMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif