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

-- * Exported types
    Texture(..)                             ,
    IsTexture                               ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [allocate]("GI.Cogl.Interfaces.Texture#g:method:allocate"), [copySubImage]("GI.Cogl.Interfaces.Texture#g:method:copySubImage"), [isSliced]("GI.Cogl.Interfaces.Texture#g:method:isSliced").
-- 
-- ==== Getters
-- [getComponents]("GI.Cogl.Interfaces.Texture#g:method:getComponents"), [getData]("GI.Cogl.Interfaces.Texture#g:method:getData"), [getGlTexture]("GI.Cogl.Interfaces.Texture#g:method:getGlTexture"), [getHeight]("GI.Cogl.Interfaces.Texture#g:method:getHeight"), [getMaxWaste]("GI.Cogl.Interfaces.Texture#g:method:getMaxWaste"), [getPremultiplied]("GI.Cogl.Interfaces.Texture#g:method:getPremultiplied"), [getWidth]("GI.Cogl.Interfaces.Texture#g:method:getWidth").
-- 
-- ==== Setters
-- [setComponents]("GI.Cogl.Interfaces.Texture#g:method:setComponents"), [setPremultiplied]("GI.Cogl.Interfaces.Texture#g:method:setPremultiplied"), [setRegion]("GI.Cogl.Interfaces.Texture#g:method:setRegion").

#if defined(ENABLE_OVERLOADING)
    ResolveTextureMethod                    ,
#endif

-- ** allocate #method:allocate#

#if defined(ENABLE_OVERLOADING)
    TextureAllocateMethodInfo               ,
#endif
    textureAllocate                         ,


-- ** copySubImage #method:copySubImage#

#if defined(ENABLE_OVERLOADING)
    TextureCopySubImageMethodInfo           ,
#endif
    textureCopySubImage                     ,


-- ** getComponents #method:getComponents#

#if defined(ENABLE_OVERLOADING)
    TextureGetComponentsMethodInfo          ,
#endif
    textureGetComponents                    ,


-- ** getData #method:getData#

#if defined(ENABLE_OVERLOADING)
    TextureGetDataMethodInfo                ,
#endif
    textureGetData                          ,


-- ** getGlTexture #method:getGlTexture#

#if defined(ENABLE_OVERLOADING)
    TextureGetGlTextureMethodInfo           ,
#endif
    textureGetGlTexture                     ,


-- ** getHeight #method:getHeight#

#if defined(ENABLE_OVERLOADING)
    TextureGetHeightMethodInfo              ,
#endif
    textureGetHeight                        ,


-- ** getMaxWaste #method:getMaxWaste#

#if defined(ENABLE_OVERLOADING)
    TextureGetMaxWasteMethodInfo            ,
#endif
    textureGetMaxWaste                      ,


-- ** getPremultiplied #method:getPremultiplied#

#if defined(ENABLE_OVERLOADING)
    TextureGetPremultipliedMethodInfo       ,
#endif
    textureGetPremultiplied                 ,


-- ** getWidth #method:getWidth#

#if defined(ENABLE_OVERLOADING)
    TextureGetWidthMethodInfo               ,
#endif
    textureGetWidth                         ,


-- ** isSliced #method:isSliced#

#if defined(ENABLE_OVERLOADING)
    TextureIsSlicedMethodInfo               ,
#endif
    textureIsSliced                         ,


-- ** setComponents #method:setComponents#

#if defined(ENABLE_OVERLOADING)
    TextureSetComponentsMethodInfo          ,
#endif
    textureSetComponents                    ,


-- ** setPremultiplied #method:setPremultiplied#

#if defined(ENABLE_OVERLOADING)
    TextureSetPremultipliedMethodInfo       ,
#endif
    textureSetPremultiplied                 ,


-- ** setRegion #method:setRegion#

#if defined(ENABLE_OVERLOADING)
    TextureSetRegionMethodInfo              ,
#endif
    textureSetRegion                        ,




    ) 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

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

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

-- | Type class for types which implement `Texture`.
class (ManagedPtrNewtype o, O.IsDescendantOf Texture o) => IsTexture o
instance (ManagedPtrNewtype o, O.IsDescendantOf Texture o) => IsTexture o
-- XXX Wrapping a foreign struct/union with no known destructor or size, leak?
instance BoxedPtr Texture where
    boxedPtrCopy :: Texture -> IO Texture
boxedPtrCopy = Texture -> IO Texture
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    boxedPtrFree :: Texture -> IO ()
boxedPtrFree = \Texture
_x -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


#if defined(ENABLE_OVERLOADING)
type family ResolveTextureMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveTextureMethod "allocate" o = TextureAllocateMethodInfo
    ResolveTextureMethod "copySubImage" o = TextureCopySubImageMethodInfo
    ResolveTextureMethod "isSliced" o = TextureIsSlicedMethodInfo
    ResolveTextureMethod "getComponents" o = TextureGetComponentsMethodInfo
    ResolveTextureMethod "getData" o = TextureGetDataMethodInfo
    ResolveTextureMethod "getGlTexture" o = TextureGetGlTextureMethodInfo
    ResolveTextureMethod "getHeight" o = TextureGetHeightMethodInfo
    ResolveTextureMethod "getMaxWaste" o = TextureGetMaxWasteMethodInfo
    ResolveTextureMethod "getPremultiplied" o = TextureGetPremultipliedMethodInfo
    ResolveTextureMethod "getWidth" o = TextureGetWidthMethodInfo
    ResolveTextureMethod "setComponents" o = TextureSetComponentsMethodInfo
    ResolveTextureMethod "setPremultiplied" o = TextureSetPremultipliedMethodInfo
    ResolveTextureMethod "setRegion" o = TextureSetRegionMethodInfo
    ResolveTextureMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- method Texture::allocate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "texture"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Texture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #CoglTexture" , 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_texture_allocate" cogl_texture_allocate :: 
    Ptr Texture ->                          -- texture : TInterface (Name {namespace = "Cogl", name = "Texture"})
    Ptr (Ptr GError) ->                     -- error
    IO Int32

-- | Explicitly allocates the storage for the given /@texture@/ which
-- allows you to be sure that there is enough memory for the
-- texture and if not then the error can be handled gracefully.
-- 
-- \<note>Normally applications don\'t need to use this api directly
-- since the texture will be implicitly allocated when data is set on
-- the texture, or if the texture is attached to a t'GI.Cogl.Objects.Offscreen.Offscreen'
-- framebuffer and rendered too.\<\/note>
textureAllocate ::
    (B.CallStack.HasCallStack, MonadIO m, IsTexture a) =>
    a
    -- ^ /@texture@/: A @/CoglTexture/@
    -> m Int32
    -- ^ __Returns:__ 'P.True' if the texture was successfully allocated,
    --               otherwise 'P.False' and /@error@/ will be updated if it
    --               wasn\'t 'P.Nothing'. /(Can throw 'Data.GI.Base.GError.GError')/
textureAllocate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a -> m Int32
textureAllocate a
texture = 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 Texture
texture' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
texture
    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 Texture -> Ptr (Ptr GError) -> IO Int32
cogl_texture_allocate Ptr Texture
texture'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
texture
        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 TextureAllocateMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsTexture a) => O.OverloadedMethod TextureAllocateMethodInfo a signature where
    overloadedMethod = textureAllocate

instance O.OverloadedMethodInfo TextureAllocateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Interfaces.Texture.textureAllocate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Interfaces-Texture.html#v:textureAllocate"
        })


#endif

-- method Texture::copy_sub_image
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "texture"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Texture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "xoffset"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "yoffset"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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_texture_copy_sub_image" cogl_texture_copy_sub_image :: 
    Ptr Texture ->                          -- texture : TInterface (Name {namespace = "Cogl", name = "Texture"})
    Int32 ->                                -- xoffset : TBasicType TInt
    Int32 ->                                -- yoffset : TBasicType TInt
    Int32 ->                                -- x : TBasicType TInt
    Int32 ->                                -- y : TBasicType TInt
    Word64 ->                               -- width : TBasicType TUInt64
    Word64 ->                               -- height : TBasicType TUInt64
    IO Int32

-- | /No description available in the introspection data./
textureCopySubImage ::
    (B.CallStack.HasCallStack, MonadIO m, IsTexture a) =>
    a
    -> Int32
    -> Int32
    -> Int32
    -> Int32
    -> Word64
    -> Word64
    -> m Int32
textureCopySubImage :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a
-> Int32 -> Int32 -> Int32 -> Int32 -> Word64 -> Word64 -> m Int32
textureCopySubImage a
texture Int32
xoffset Int32
yoffset Int32
x Int32
y Word64
width Word64
height = 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 Texture
texture' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
texture
    Int32
result <- Ptr Texture
-> Int32 -> Int32 -> Int32 -> Int32 -> Word64 -> Word64 -> IO Int32
cogl_texture_copy_sub_image Ptr Texture
texture' Int32
xoffset Int32
yoffset Int32
x Int32
y Word64
width Word64
height
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
texture
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TextureCopySubImageMethodInfo
instance (signature ~ (Int32 -> Int32 -> Int32 -> Int32 -> Word64 -> Word64 -> m Int32), MonadIO m, IsTexture a) => O.OverloadedMethod TextureCopySubImageMethodInfo a signature where
    overloadedMethod = textureCopySubImage

instance O.OverloadedMethodInfo TextureCopySubImageMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Interfaces.Texture.textureCopySubImage",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Interfaces-Texture.html#v:textureCopySubImage"
        })


#endif

-- method Texture::get_components
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "texture"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Texture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglTexture pointer."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Cogl" , name = "TextureComponents" })
-- throws : False
-- Skip return : False

foreign import ccall "cogl_texture_get_components" cogl_texture_get_components :: 
    Ptr Texture ->                          -- texture : TInterface (Name {namespace = "Cogl", name = "Texture"})
    IO CUInt

-- | Queries what components the given /@texture@/ stores internally as set
-- via 'GI.Cogl.Interfaces.Texture.textureSetComponents'.
-- 
-- For textures created by the ‘_with_size’ constructors the default
-- is 'GI.Cogl.Enums.TextureComponentsRgba'. The other constructors which take
-- a @/CoglBitmap/@ or a data pointer default to the same components as
-- the pixel format of the data.
-- 
-- /Since: 1.18/
textureGetComponents ::
    (B.CallStack.HasCallStack, MonadIO m, IsTexture a) =>
    a
    -- ^ /@texture@/: a @/CoglTexture/@ pointer.
    -> m Cogl.Enums.TextureComponents
textureGetComponents :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a -> m TextureComponents
textureGetComponents a
texture = IO TextureComponents -> m TextureComponents
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TextureComponents -> m TextureComponents)
-> IO TextureComponents -> m TextureComponents
forall a b. (a -> b) -> a -> b
$ do
    Ptr Texture
texture' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
texture
    CUInt
result <- Ptr Texture -> IO CUInt
cogl_texture_get_components Ptr Texture
texture'
    let result' :: TextureComponents
result' = (Int -> TextureComponents
forall a. Enum a => Int -> a
toEnum (Int -> TextureComponents)
-> (CUInt -> Int) -> CUInt -> TextureComponents
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
texture
    TextureComponents -> IO TextureComponents
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TextureComponents
result'

#if defined(ENABLE_OVERLOADING)
data TextureGetComponentsMethodInfo
instance (signature ~ (m Cogl.Enums.TextureComponents), MonadIO m, IsTexture a) => O.OverloadedMethod TextureGetComponentsMethodInfo a signature where
    overloadedMethod = textureGetComponents

instance O.OverloadedMethodInfo TextureGetComponentsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Interfaces.Texture.textureGetComponents",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Interfaces-Texture.html#v:textureGetComponents"
        })


#endif

-- method Texture::get_data
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "texture"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Texture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglTexture pointer."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "PixelFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #CoglPixelFormat to store the texture as."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rowstride"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the rowstride of @data in bytes or pass 0 to calculate\n            from the bytes-per-pixel of @format multiplied by the\n            @texture width."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "memory location to write the @texture's contents, or %NULL\nto only query the data size through the return value."
--                 , 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_texture_get_data" cogl_texture_get_data :: 
    Ptr Texture ->                          -- texture : TInterface (Name {namespace = "Cogl", name = "Texture"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Cogl", name = "PixelFormat"})
    Word32 ->                               -- rowstride : TBasicType TUInt
    Word8 ->                                -- data : TBasicType TUInt8
    IO Int32

-- | Copies the pixel data from a cogl texture to system memory.
-- 
-- \<note>Don\'t pass the value of @/cogl_texture_get_rowstride()/@ as the
-- /@rowstride@/ argument, the rowstride should be the rowstride you
-- want for the destination /@data@/ buffer not the rowstride of the
-- source texture\<\/note>
textureGetData ::
    (B.CallStack.HasCallStack, MonadIO m, IsTexture a) =>
    a
    -- ^ /@texture@/: a @/CoglTexture/@ pointer.
    -> Cogl.Enums.PixelFormat
    -- ^ /@format@/: the t'GI.Cogl.Enums.PixelFormat' to store the texture as.
    -> Word32
    -- ^ /@rowstride@/: the rowstride of /@data@/ in bytes or pass 0 to calculate
    --             from the bytes-per-pixel of /@format@/ multiplied by the
    --             /@texture@/ width.
    -> Word8
    -- ^ /@data@/: memory location to write the /@texture@/\'s contents, or 'P.Nothing'
    -- to only query the data size through the return value.
    -> m Int32
    -- ^ __Returns:__ the size of the texture data in bytes
textureGetData :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a -> PixelFormat -> Word32 -> Word8 -> m Int32
textureGetData a
texture PixelFormat
format Word32
rowstride Word8
data_ = 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 Texture
texture' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
texture
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (PixelFormat -> Int) -> PixelFormat -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixelFormat -> Int
forall a. Enum a => a -> Int
fromEnum) PixelFormat
format
    Int32
result <- Ptr Texture -> CUInt -> Word32 -> Word8 -> IO Int32
cogl_texture_get_data Ptr Texture
texture' CUInt
format' Word32
rowstride Word8
data_
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
texture
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TextureGetDataMethodInfo
instance (signature ~ (Cogl.Enums.PixelFormat -> Word32 -> Word8 -> m Int32), MonadIO m, IsTexture a) => O.OverloadedMethod TextureGetDataMethodInfo a signature where
    overloadedMethod = textureGetData

instance O.OverloadedMethodInfo TextureGetDataMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Interfaces.Texture.textureGetData",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Interfaces-Texture.html#v:textureGetData"
        })


#endif

-- method Texture::get_gl_texture
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "texture"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Texture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglTexture pointer."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_gl_handle"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "pointer to return location for the\n  textures GL handle, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "out_gl_target"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "pointer to return location for the\n  GL target type, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "cogl_texture_get_gl_texture" cogl_texture_get_gl_texture :: 
    Ptr Texture ->                          -- texture : TInterface (Name {namespace = "Cogl", name = "Texture"})
    Ptr Word32 ->                           -- out_gl_handle : TBasicType TUInt
    Ptr Word32 ->                           -- out_gl_target : TBasicType TUInt
    IO Int32

-- | Queries the GL handles for a GPU side texture through its @/CoglTexture/@.
-- 
-- If the texture is spliced the data for the first sub texture will be
-- queried.
textureGetGlTexture ::
    (B.CallStack.HasCallStack, MonadIO m, IsTexture a) =>
    a
    -- ^ /@texture@/: a @/CoglTexture/@ pointer.
    -> m ((Int32, Word32, Word32))
    -- ^ __Returns:__ 'P.True' if the handle was successfully retrieved, 'P.False'
    --   if the handle was invalid
textureGetGlTexture :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a -> m (Int32, Word32, Word32)
textureGetGlTexture a
texture = IO (Int32, Word32, Word32) -> m (Int32, Word32, Word32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Word32, Word32) -> m (Int32, Word32, Word32))
-> IO (Int32, Word32, Word32) -> m (Int32, Word32, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Texture
texture' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
texture
    Ptr Word32
outGlHandle <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr Word32
outGlTarget <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Int32
result <- Ptr Texture -> Ptr Word32 -> Ptr Word32 -> IO Int32
cogl_texture_get_gl_texture Ptr Texture
texture' Ptr Word32
outGlHandle Ptr Word32
outGlTarget
    Word32
outGlHandle' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
outGlHandle
    Word32
outGlTarget' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
outGlTarget
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
texture
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
outGlHandle
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
outGlTarget
    (Int32, Word32, Word32) -> IO (Int32, Word32, Word32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
result, Word32
outGlHandle', Word32
outGlTarget')

#if defined(ENABLE_OVERLOADING)
data TextureGetGlTextureMethodInfo
instance (signature ~ (m ((Int32, Word32, Word32))), MonadIO m, IsTexture a) => O.OverloadedMethod TextureGetGlTextureMethodInfo a signature where
    overloadedMethod = textureGetGlTexture

instance O.OverloadedMethodInfo TextureGetGlTextureMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Interfaces.Texture.textureGetGlTexture",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Interfaces-Texture.html#v:textureGetGlTexture"
        })


#endif

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

foreign import ccall "cogl_texture_get_height" cogl_texture_get_height :: 
    Ptr Texture ->                          -- texture : TInterface (Name {namespace = "Cogl", name = "Texture"})
    IO Word32

-- | Queries the height of a cogl texture.
textureGetHeight ::
    (B.CallStack.HasCallStack, MonadIO m, IsTexture a) =>
    a
    -- ^ /@texture@/: a @/CoglTexture/@ pointer.
    -> m Word32
    -- ^ __Returns:__ the height of the GPU side texture in pixels
textureGetHeight :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a -> m Word32
textureGetHeight a
texture = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Texture
texture' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
texture
    Word32
result <- Ptr Texture -> IO Word32
cogl_texture_get_height Ptr Texture
texture'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
texture
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data TextureGetHeightMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsTexture a) => O.OverloadedMethod TextureGetHeightMethodInfo a signature where
    overloadedMethod = textureGetHeight

instance O.OverloadedMethodInfo TextureGetHeightMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Interfaces.Texture.textureGetHeight",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Interfaces-Texture.html#v:textureGetHeight"
        })


#endif

-- method Texture::get_max_waste
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "texture"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Texture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglTexture pointer."
--                 , 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_texture_get_max_waste" cogl_texture_get_max_waste :: 
    Ptr Texture ->                          -- texture : TInterface (Name {namespace = "Cogl", name = "Texture"})
    IO Int32

-- | Queries the maximum wasted (unused) pixels in one dimension of a GPU side
-- texture.
textureGetMaxWaste ::
    (B.CallStack.HasCallStack, MonadIO m, IsTexture a) =>
    a
    -- ^ /@texture@/: a @/CoglTexture/@ pointer.
    -> m Int32
    -- ^ __Returns:__ the maximum waste
textureGetMaxWaste :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a -> m Int32
textureGetMaxWaste a
texture = 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 Texture
texture' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
texture
    Int32
result <- Ptr Texture -> IO Int32
cogl_texture_get_max_waste Ptr Texture
texture'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
texture
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TextureGetMaxWasteMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsTexture a) => O.OverloadedMethod TextureGetMaxWasteMethodInfo a signature where
    overloadedMethod = textureGetMaxWaste

instance O.OverloadedMethodInfo TextureGetMaxWasteMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Interfaces.Texture.textureGetMaxWaste",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Interfaces-Texture.html#v:textureGetMaxWaste"
        })


#endif

-- method Texture::get_premultiplied
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "texture"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Texture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglTexture pointer."
--                 , 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_texture_get_premultiplied" cogl_texture_get_premultiplied :: 
    Ptr Texture ->                          -- texture : TInterface (Name {namespace = "Cogl", name = "Texture"})
    IO Int32

-- | Queries the pre-multiplied alpha status for internally stored red,
-- green and blue components for the given /@texture@/ as set by
-- 'GI.Cogl.Interfaces.Texture.textureSetPremultiplied'.
-- 
-- By default the pre-multipled state is /@tRUE@/.
-- 
-- /Since: 1.18/
textureGetPremultiplied ::
    (B.CallStack.HasCallStack, MonadIO m, IsTexture a) =>
    a
    -- ^ /@texture@/: a @/CoglTexture/@ pointer.
    -> m Int32
    -- ^ __Returns:__ 'P.True' if red, green and blue components are
    --               internally stored pre-multiplied by the alpha
    --               value or 'P.False' if not.
textureGetPremultiplied :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a -> m Int32
textureGetPremultiplied a
texture = 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 Texture
texture' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
texture
    Int32
result <- Ptr Texture -> IO Int32
cogl_texture_get_premultiplied Ptr Texture
texture'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
texture
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TextureGetPremultipliedMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsTexture a) => O.OverloadedMethod TextureGetPremultipliedMethodInfo a signature where
    overloadedMethod = textureGetPremultiplied

instance O.OverloadedMethodInfo TextureGetPremultipliedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Interfaces.Texture.textureGetPremultiplied",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Interfaces-Texture.html#v:textureGetPremultiplied"
        })


#endif

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

foreign import ccall "cogl_texture_get_width" cogl_texture_get_width :: 
    Ptr Texture ->                          -- texture : TInterface (Name {namespace = "Cogl", name = "Texture"})
    IO Word32

-- | Queries the width of a cogl texture.
textureGetWidth ::
    (B.CallStack.HasCallStack, MonadIO m, IsTexture a) =>
    a
    -- ^ /@texture@/: a @/CoglTexture/@ pointer.
    -> m Word32
    -- ^ __Returns:__ the width of the GPU side texture in pixels
textureGetWidth :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a -> m Word32
textureGetWidth a
texture = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Texture
texture' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
texture
    Word32
result <- Ptr Texture -> IO Word32
cogl_texture_get_width Ptr Texture
texture'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
texture
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data TextureGetWidthMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsTexture a) => O.OverloadedMethod TextureGetWidthMethodInfo a signature where
    overloadedMethod = textureGetWidth

instance O.OverloadedMethodInfo TextureGetWidthMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Interfaces.Texture.textureGetWidth",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Interfaces-Texture.html#v:textureGetWidth"
        })


#endif

-- method Texture::is_sliced
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "texture"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Texture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglTexture pointer."
--                 , 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_texture_is_sliced" cogl_texture_is_sliced :: 
    Ptr Texture ->                          -- texture : TInterface (Name {namespace = "Cogl", name = "Texture"})
    IO Int32

-- | Queries if a texture is sliced (stored as multiple GPU side tecture
-- objects).
textureIsSliced ::
    (B.CallStack.HasCallStack, MonadIO m, IsTexture a) =>
    a
    -- ^ /@texture@/: a @/CoglTexture/@ pointer.
    -> m Int32
    -- ^ __Returns:__ 'P.True' if the texture is sliced, 'P.False' if the texture
    --   is stored as a single GPU texture
textureIsSliced :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a -> m Int32
textureIsSliced a
texture = 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 Texture
texture' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
texture
    Int32
result <- Ptr Texture -> IO Int32
cogl_texture_is_sliced Ptr Texture
texture'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
texture
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TextureIsSlicedMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsTexture a) => O.OverloadedMethod TextureIsSlicedMethodInfo a signature where
    overloadedMethod = textureIsSliced

instance O.OverloadedMethodInfo TextureIsSlicedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Interfaces.Texture.textureIsSliced",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Interfaces-Texture.html#v:textureIsSliced"
        })


#endif

-- method Texture::set_components
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "texture"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Texture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglTexture pointer."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "components"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "TextureComponents" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "cogl_texture_set_components" cogl_texture_set_components :: 
    Ptr Texture ->                          -- texture : TInterface (Name {namespace = "Cogl", name = "Texture"})
    CUInt ->                                -- components : TInterface (Name {namespace = "Cogl", name = "TextureComponents"})
    IO ()

-- | Affects the internal storage format for this texture by specifying
-- what components will be required for sampling later.
-- 
-- This api affects how data is uploaded to the GPU since unused
-- components can potentially be discarded from source data.
-- 
-- For textures created by the ‘_with_size’ constructors the default
-- is 'GI.Cogl.Enums.TextureComponentsRgba'. The other constructors which take
-- a @/CoglBitmap/@ or a data pointer default to the same components as
-- the pixel format of the data.
-- 
-- Note that the 'GI.Cogl.Enums.TextureComponentsRg' format is not available
-- on all drivers. The availability can be determined by checking for
-- the @/COGL_FEATURE_ID_TEXTURE_RG/@ feature. If this format is used on
-- a driver where it is not available then 'GI.Cogl.Enums.TextureErrorFormat'
-- will be raised when the texture is allocated. Even if the feature
-- is not available then 'GI.Cogl.Enums.PixelFormatRg88' can still be used as
-- an image format as long as 'GI.Cogl.Enums.TextureComponentsRg' isn\'t used
-- as the texture\'s components.
-- 
-- /Since: 1.18/
textureSetComponents ::
    (B.CallStack.HasCallStack, MonadIO m, IsTexture a) =>
    a
    -- ^ /@texture@/: a @/CoglTexture/@ pointer.
    -> Cogl.Enums.TextureComponents
    -> m ()
textureSetComponents :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a -> TextureComponents -> m ()
textureSetComponents a
texture TextureComponents
components = 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 Texture
texture' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
texture
    let components' :: CUInt
components' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (TextureComponents -> Int) -> TextureComponents -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextureComponents -> Int
forall a. Enum a => a -> Int
fromEnum) TextureComponents
components
    Ptr Texture -> CUInt -> IO ()
cogl_texture_set_components Ptr Texture
texture' CUInt
components'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
texture
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextureSetComponentsMethodInfo
instance (signature ~ (Cogl.Enums.TextureComponents -> m ()), MonadIO m, IsTexture a) => O.OverloadedMethod TextureSetComponentsMethodInfo a signature where
    overloadedMethod = textureSetComponents

instance O.OverloadedMethodInfo TextureSetComponentsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Interfaces.Texture.textureSetComponents",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Interfaces-Texture.html#v:textureSetComponents"
        })


#endif

-- method Texture::set_premultiplied
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "texture"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Texture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglTexture pointer."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "premultiplied"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Whether any internally stored red, green or blue\n                components are pre-multiplied by an alpha\n                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_texture_set_premultiplied" cogl_texture_set_premultiplied :: 
    Ptr Texture ->                          -- texture : TInterface (Name {namespace = "Cogl", name = "Texture"})
    Int32 ->                                -- premultiplied : TBasicType TInt
    IO ()

-- | Affects the internal storage format for this texture by specifying
-- whether red, green and blue color components should be stored as
-- pre-multiplied alpha values.
-- 
-- This api affects how data is uploaded to the GPU since Cogl will
-- convert source data to have premultiplied or unpremultiplied
-- components according to this state.
-- 
-- For example if you create a texture via
-- @/cogl_texture_2d_new_with_size()/@ and then upload data via
-- @/cogl_texture_set_data()/@ passing a source format of
-- 'GI.Cogl.Enums.PixelFormatRgba8888' then Cogl will internally multiply the
-- red, green and blue components of the source data by the alpha
-- component, for each pixel so that the internally stored data has
-- pre-multiplied alpha components. If you instead upload data that
-- already has pre-multiplied components by passing
-- 'GI.Cogl.Enums.PixelFormatRgba8888Pre' as the source format to
-- @/cogl_texture_set_data()/@ then the data can be uploaded without being
-- converted.
-- 
-- By default the /@premultipled@/ state is /@tRUE@/.
-- 
-- /Since: 1.18/
textureSetPremultiplied ::
    (B.CallStack.HasCallStack, MonadIO m, IsTexture a) =>
    a
    -- ^ /@texture@/: a @/CoglTexture/@ pointer.
    -> Int32
    -- ^ /@premultiplied@/: Whether any internally stored red, green or blue
    --                 components are pre-multiplied by an alpha
    --                 component.
    -> m ()
textureSetPremultiplied :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a -> Int32 -> m ()
textureSetPremultiplied a
texture Int32
premultiplied = 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 Texture
texture' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
texture
    Ptr Texture -> Int32 -> IO ()
cogl_texture_set_premultiplied Ptr Texture
texture' Int32
premultiplied
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
texture
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextureSetPremultipliedMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsTexture a) => O.OverloadedMethod TextureSetPremultipliedMethodInfo a signature where
    overloadedMethod = textureSetPremultiplied

instance O.OverloadedMethodInfo TextureSetPremultipliedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Interfaces.Texture.textureSetPremultiplied",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Interfaces-Texture.html#v:textureSetPremultiplied"
        })


#endif

-- method Texture::set_region
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "texture"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "Texture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #CoglTexture." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src_x"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "upper left coordinate to use from source data."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src_y"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "upper left coordinate to use from source data."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dst_x"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "upper left destination horizontal coordinate."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dst_y"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "upper left destination vertical coordinate."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dst_width"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "width of destination region to write. (Must be less\n  than or equal to @width)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dst_height"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "height of destination region to write. (Must be less\n  than or equal to @height)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "width of source data buffer."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "height of source data buffer."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType =
--               TInterface Name { namespace = "Cogl" , name = "PixelFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #CoglPixelFormat used in the source buffer."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rowstride"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "rowstride of source buffer (computed from width if none\nspecified)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the actual pixel data."
--                 , 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_texture_set_region" cogl_texture_set_region :: 
    Ptr Texture ->                          -- texture : TInterface (Name {namespace = "Cogl", name = "Texture"})
    Int32 ->                                -- src_x : TBasicType TInt
    Int32 ->                                -- src_y : TBasicType TInt
    Int32 ->                                -- dst_x : TBasicType TInt
    Int32 ->                                -- dst_y : TBasicType TInt
    Word32 ->                               -- dst_width : TBasicType TUInt
    Word32 ->                               -- dst_height : TBasicType TUInt
    Int32 ->                                -- width : TBasicType TInt
    Int32 ->                                -- height : TBasicType TInt
    CUInt ->                                -- format : TInterface (Name {namespace = "Cogl", name = "PixelFormat"})
    Word32 ->                               -- rowstride : TBasicType TUInt
    Word8 ->                                -- data : TBasicType TUInt8
    IO Int32

-- | Sets the pixels in a rectangular subregion of /@texture@/ from an in-memory
-- buffer containing pixel data.
-- 
-- \<note>The region set can\'t be larger than the source /@data@/\<\/note>
textureSetRegion ::
    (B.CallStack.HasCallStack, MonadIO m, IsTexture a) =>
    a
    -- ^ /@texture@/: a @/CoglTexture/@.
    -> Int32
    -- ^ /@srcX@/: upper left coordinate to use from source data.
    -> Int32
    -- ^ /@srcY@/: upper left coordinate to use from source data.
    -> Int32
    -- ^ /@dstX@/: upper left destination horizontal coordinate.
    -> Int32
    -- ^ /@dstY@/: upper left destination vertical coordinate.
    -> Word32
    -- ^ /@dstWidth@/: width of destination region to write. (Must be less
    --   than or equal to /@width@/)
    -> Word32
    -- ^ /@dstHeight@/: height of destination region to write. (Must be less
    --   than or equal to /@height@/)
    -> Int32
    -- ^ /@width@/: width of source data buffer.
    -> Int32
    -- ^ /@height@/: height of source data buffer.
    -> Cogl.Enums.PixelFormat
    -- ^ /@format@/: the t'GI.Cogl.Enums.PixelFormat' used in the source buffer.
    -> Word32
    -- ^ /@rowstride@/: rowstride of source buffer (computed from width if none
    -- specified)
    -> Word8
    -- ^ /@data@/: the actual pixel data.
    -> m Int32
    -- ^ __Returns:__ 'P.True' if the subregion upload was successful, and
    --   'P.False' otherwise
textureSetRegion :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a
-> Int32
-> Int32
-> Int32
-> Int32
-> Word32
-> Word32
-> Int32
-> Int32
-> PixelFormat
-> Word32
-> Word8
-> m Int32
textureSetRegion a
texture Int32
srcX Int32
srcY Int32
dstX Int32
dstY Word32
dstWidth Word32
dstHeight Int32
width Int32
height PixelFormat
format Word32
rowstride Word8
data_ = 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 Texture
texture' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
texture
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (PixelFormat -> Int) -> PixelFormat -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixelFormat -> Int
forall a. Enum a => a -> Int
fromEnum) PixelFormat
format
    Int32
result <- Ptr Texture
-> Int32
-> Int32
-> Int32
-> Int32
-> Word32
-> Word32
-> Int32
-> Int32
-> CUInt
-> Word32
-> Word8
-> IO Int32
cogl_texture_set_region Ptr Texture
texture' Int32
srcX Int32
srcY Int32
dstX Int32
dstY Word32
dstWidth Word32
dstHeight Int32
width Int32
height CUInt
format' Word32
rowstride Word8
data_
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
texture
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TextureSetRegionMethodInfo
instance (signature ~ (Int32 -> Int32 -> Int32 -> Int32 -> Word32 -> Word32 -> Int32 -> Int32 -> Cogl.Enums.PixelFormat -> Word32 -> Word8 -> m Int32), MonadIO m, IsTexture a) => O.OverloadedMethod TextureSetRegionMethodInfo a signature where
    overloadedMethod = textureSetRegion

instance O.OverloadedMethodInfo TextureSetRegionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Cogl.Interfaces.Texture.textureSetRegion",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-cogl-1.0.5/docs/GI-Cogl-Interfaces-Texture.html#v:textureSetRegion"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Texture = TextureSignalList
type TextureSignalList = ('[ ] :: [(Symbol, DK.Type)])

#endif