{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The @GdkTexture@ structure contains only private data.

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

module GI.Gdk.Objects.Texture
    ( 

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


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [computeConcreteSize]("GI.Gdk.Interfaces.Paintable#g:method:computeConcreteSize"), [download]("GI.Gdk.Objects.Texture#g:method:download"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [invalidateContents]("GI.Gdk.Interfaces.Paintable#g:method:invalidateContents"), [invalidateSize]("GI.Gdk.Interfaces.Paintable#g:method:invalidateSize"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [saveToPng]("GI.Gdk.Objects.Texture#g:method:saveToPng"), [snapshot]("GI.Gdk.Interfaces.Paintable#g:method:snapshot"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getCurrentImage]("GI.Gdk.Interfaces.Paintable#g:method:getCurrentImage"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFlags]("GI.Gdk.Interfaces.Paintable#g:method:getFlags"), [getHeight]("GI.Gdk.Objects.Texture#g:method:getHeight"), [getIntrinsicAspectRatio]("GI.Gdk.Interfaces.Paintable#g:method:getIntrinsicAspectRatio"), [getIntrinsicHeight]("GI.Gdk.Interfaces.Paintable#g:method:getIntrinsicHeight"), [getIntrinsicWidth]("GI.Gdk.Interfaces.Paintable#g:method:getIntrinsicWidth"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getWidth]("GI.Gdk.Objects.Texture#g:method:getWidth").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveTextureMethod                    ,
#endif

-- ** download #method:download#

#if defined(ENABLE_OVERLOADING)
    TextureDownloadMethodInfo               ,
#endif
    textureDownload                         ,


-- ** getHeight #method:getHeight#

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


-- ** getWidth #method:getWidth#

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


-- ** newForPixbuf #method:newForPixbuf#

    textureNewForPixbuf                     ,


-- ** newFromFile #method:newFromFile#

    textureNewFromFile                      ,


-- ** newFromResource #method:newFromResource#

    textureNewFromResource                  ,


-- ** saveToPng #method:saveToPng#

#if defined(ENABLE_OVERLOADING)
    TextureSaveToPngMethodInfo              ,
#endif
    textureSaveToPng                        ,




 -- * Properties


-- ** height #attr:height#
-- | The height of the texture, in pixels.

#if defined(ENABLE_OVERLOADING)
    TextureHeightPropertyInfo               ,
#endif
    constructTextureHeight                  ,
    getTextureHeight                        ,
#if defined(ENABLE_OVERLOADING)
    textureHeight                           ,
#endif


-- ** width #attr:width#
-- | The width of the texture, in pixels.

#if defined(ENABLE_OVERLOADING)
    TextureWidthPropertyInfo                ,
#endif
    constructTextureWidth                   ,
    getTextureWidth                         ,
#if defined(ENABLE_OVERLOADING)
    textureWidth                            ,
#endif




    ) 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.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.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gdk.Interfaces.Paintable as Gdk.Paintable
import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import qualified GI.Gio.Interfaces.File as Gio.File

-- | 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
/= :: Texture -> Texture -> Bool
$c/= :: Texture -> Texture -> Bool
== :: Texture -> Texture -> Bool
$c== :: Texture -> Texture -> Bool
Eq)

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

foreign import ccall "gdk_texture_get_type"
    c_gdk_texture_get_type :: IO B.Types.GType

instance B.Types.TypedObject Texture where
    glibType :: IO GType
glibType = IO GType
c_gdk_texture_get_type

instance B.Types.GObject Texture

-- | Type class for types which can be safely cast to `Texture`, for instance with `toTexture`.
class (SP.GObject o, O.IsDescendantOf Texture o) => IsTexture o
instance (SP.GObject o, O.IsDescendantOf Texture o) => IsTexture o

instance O.HasParentTypes Texture
type instance O.ParentTypes Texture = '[GObject.Object.Object, Gdk.Paintable.Paintable]

-- | Cast to `Texture`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toTexture :: (MIO.MonadIO m, IsTexture o) => o -> m Texture
toTexture :: forall (m :: * -> *) o. (MonadIO m, IsTexture o) => o -> m Texture
toTexture = IO Texture -> m Texture
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Texture -> m Texture) -> (o -> IO Texture) -> o -> m Texture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Texture -> Texture) -> o -> IO Texture
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Texture -> Texture
Texture

-- | Convert 'Texture' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Texture) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gdk_texture_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Texture -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Texture
P.Nothing = Ptr GValue -> Ptr Texture -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Texture
forall a. Ptr a
FP.nullPtr :: FP.Ptr Texture)
    gvalueSet_ Ptr GValue
gv (P.Just Texture
obj) = Texture -> (Ptr Texture -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Texture
obj (Ptr GValue -> Ptr Texture -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Texture)
gvalueGet_ Ptr GValue
gv = do
        Ptr Texture
ptr <- Ptr GValue -> IO (Ptr Texture)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Texture)
        if Ptr Texture
ptr Ptr Texture -> Ptr Texture -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Texture
forall a. Ptr a
FP.nullPtr
        then Texture -> Maybe Texture
forall a. a -> Maybe a
P.Just (Texture -> Maybe Texture) -> IO Texture -> IO (Maybe Texture)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Texture -> Texture) -> Ptr Texture -> IO Texture
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Texture -> Texture
Texture Ptr Texture
ptr
        else Maybe Texture -> IO (Maybe Texture)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Texture
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveTextureMethod (t :: Symbol) (o :: *) :: * where
    ResolveTextureMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveTextureMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveTextureMethod "computeConcreteSize" o = Gdk.Paintable.PaintableComputeConcreteSizeMethodInfo
    ResolveTextureMethod "download" o = TextureDownloadMethodInfo
    ResolveTextureMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveTextureMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveTextureMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveTextureMethod "invalidateContents" o = Gdk.Paintable.PaintableInvalidateContentsMethodInfo
    ResolveTextureMethod "invalidateSize" o = Gdk.Paintable.PaintableInvalidateSizeMethodInfo
    ResolveTextureMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveTextureMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveTextureMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveTextureMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveTextureMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveTextureMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveTextureMethod "saveToPng" o = TextureSaveToPngMethodInfo
    ResolveTextureMethod "snapshot" o = Gdk.Paintable.PaintableSnapshotMethodInfo
    ResolveTextureMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveTextureMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveTextureMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveTextureMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveTextureMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveTextureMethod "getCurrentImage" o = Gdk.Paintable.PaintableGetCurrentImageMethodInfo
    ResolveTextureMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveTextureMethod "getFlags" o = Gdk.Paintable.PaintableGetFlagsMethodInfo
    ResolveTextureMethod "getHeight" o = TextureGetHeightMethodInfo
    ResolveTextureMethod "getIntrinsicAspectRatio" o = Gdk.Paintable.PaintableGetIntrinsicAspectRatioMethodInfo
    ResolveTextureMethod "getIntrinsicHeight" o = Gdk.Paintable.PaintableGetIntrinsicHeightMethodInfo
    ResolveTextureMethod "getIntrinsicWidth" o = Gdk.Paintable.PaintableGetIntrinsicWidthMethodInfo
    ResolveTextureMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveTextureMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveTextureMethod "getWidth" o = TextureGetWidthMethodInfo
    ResolveTextureMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveTextureMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveTextureMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    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

-- VVV Prop "height"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@height@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' texture #height
-- @
getTextureHeight :: (MonadIO m, IsTexture o) => o -> m Int32
getTextureHeight :: forall (m :: * -> *) o. (MonadIO m, IsTexture o) => o -> m Int32
getTextureHeight o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"height"

-- | Construct a `GValueConstruct` with valid value for the “@height@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTextureHeight :: (IsTexture o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructTextureHeight :: forall o (m :: * -> *).
(IsTexture o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructTextureHeight Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"height" Int32
val

#if defined(ENABLE_OVERLOADING)
data TextureHeightPropertyInfo
instance AttrInfo TextureHeightPropertyInfo where
    type AttrAllowedOps TextureHeightPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TextureHeightPropertyInfo = IsTexture
    type AttrSetTypeConstraint TextureHeightPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint TextureHeightPropertyInfo = (~) Int32
    type AttrTransferType TextureHeightPropertyInfo = Int32
    type AttrGetType TextureHeightPropertyInfo = Int32
    type AttrLabel TextureHeightPropertyInfo = "height"
    type AttrOrigin TextureHeightPropertyInfo = Texture
    attrGet = getTextureHeight
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructTextureHeight
    attrClear = undefined
#endif

-- VVV Prop "width"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@width@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' texture #width
-- @
getTextureWidth :: (MonadIO m, IsTexture o) => o -> m Int32
getTextureWidth :: forall (m :: * -> *) o. (MonadIO m, IsTexture o) => o -> m Int32
getTextureWidth o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"width"

-- | Construct a `GValueConstruct` with valid value for the “@width@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTextureWidth :: (IsTexture o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructTextureWidth :: forall o (m :: * -> *).
(IsTexture o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructTextureWidth Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"width" Int32
val

#if defined(ENABLE_OVERLOADING)
data TextureWidthPropertyInfo
instance AttrInfo TextureWidthPropertyInfo where
    type AttrAllowedOps TextureWidthPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TextureWidthPropertyInfo = IsTexture
    type AttrSetTypeConstraint TextureWidthPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint TextureWidthPropertyInfo = (~) Int32
    type AttrTransferType TextureWidthPropertyInfo = Int32
    type AttrGetType TextureWidthPropertyInfo = Int32
    type AttrLabel TextureWidthPropertyInfo = "width"
    type AttrOrigin TextureWidthPropertyInfo = Texture
    attrGet = getTextureWidth
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructTextureWidth
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Texture
type instance O.AttributeList Texture = TextureAttributeList
type TextureAttributeList = ('[ '("height", TextureHeightPropertyInfo), '("width", TextureWidthPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
textureHeight :: AttrLabelProxy "height"
textureHeight = AttrLabelProxy

textureWidth :: AttrLabelProxy "width"
textureWidth = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Texture = TextureSignalList
type TextureSignalList = ('[ '("invalidateContents", Gdk.Paintable.PaintableInvalidateContentsSignalInfo), '("invalidateSize", Gdk.Paintable.PaintableInvalidateSizeSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Texture::new_for_pixbuf
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "pixbuf"
--           , argType =
--               TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkPixbuf" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Texture" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_texture_new_for_pixbuf" gdk_texture_new_for_pixbuf :: 
    Ptr GdkPixbuf.Pixbuf.Pixbuf ->          -- pixbuf : TInterface (Name {namespace = "GdkPixbuf", name = "Pixbuf"})
    IO (Ptr Texture)

-- | Creates a new texture object representing the t'GI.GdkPixbuf.Objects.Pixbuf.Pixbuf'.
textureNewForPixbuf ::
    (B.CallStack.HasCallStack, MonadIO m, GdkPixbuf.Pixbuf.IsPixbuf a) =>
    a
    -- ^ /@pixbuf@/: a t'GI.GdkPixbuf.Objects.Pixbuf.Pixbuf'
    -> m Texture
    -- ^ __Returns:__ a new t'GI.Gdk.Objects.Texture.Texture'
textureNewForPixbuf :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPixbuf a) =>
a -> m Texture
textureNewForPixbuf a
pixbuf = IO Texture -> m Texture
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Texture -> m Texture) -> IO Texture -> m Texture
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pixbuf
pixbuf' <- a -> IO (Ptr Pixbuf)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pixbuf
    Ptr Texture
result <- Ptr Pixbuf -> IO (Ptr Texture)
gdk_texture_new_for_pixbuf Ptr Pixbuf
pixbuf'
    Text -> Ptr Texture -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"textureNewForPixbuf" Ptr Texture
result
    Texture
result' <- ((ManagedPtr Texture -> Texture) -> Ptr Texture -> IO Texture
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Texture -> Texture
Texture) Ptr Texture
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pixbuf
    Texture -> IO Texture
forall (m :: * -> *) a. Monad m => a -> m a
return Texture
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Texture::new_from_file
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GFile to load" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Texture" })
-- throws : True
-- Skip return : False

foreign import ccall "gdk_texture_new_from_file" gdk_texture_new_from_file :: 
    Ptr Gio.File.File ->                    -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Texture)

-- | Creates a new texture by loading an image from a file.
-- The file format is detected automatically.
-- The supported formats are PNG and JPEG, though more formats might be
-- available.
-- 
-- If 'P.Nothing' is returned, then /@error@/ will be set.
textureNewFromFile ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.File.IsFile a) =>
    a
    -- ^ /@file@/: t'GI.Gio.Interfaces.File.File' to load
    -> m Texture
    -- ^ __Returns:__ A newly-created t'GI.Gdk.Objects.Texture.Texture' or 'P.Nothing' if an error occurred. /(Can throw 'Data.GI.Base.GError.GError')/
textureNewFromFile :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFile a) =>
a -> m Texture
textureNewFromFile a
file = IO Texture -> m Texture
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Texture -> m Texture) -> IO Texture -> m Texture
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    IO Texture -> IO () -> IO Texture
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Texture
result <- (Ptr (Ptr GError) -> IO (Ptr Texture)) -> IO (Ptr Texture)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Texture)) -> IO (Ptr Texture))
-> (Ptr (Ptr GError) -> IO (Ptr Texture)) -> IO (Ptr Texture)
forall a b. (a -> b) -> a -> b
$ Ptr File -> Ptr (Ptr GError) -> IO (Ptr Texture)
gdk_texture_new_from_file Ptr File
file'
        Text -> Ptr Texture -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"textureNewFromFile" Ptr Texture
result
        Texture
result' <- ((ManagedPtr Texture -> Texture) -> Ptr Texture -> IO Texture
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Texture -> Texture
Texture) Ptr Texture
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Texture -> IO Texture
forall (m :: * -> *) a. Monad m => a -> m a
return Texture
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Texture::new_from_resource
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "resource_path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the path of the resource file"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Texture" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_texture_new_from_resource" gdk_texture_new_from_resource :: 
    CString ->                              -- resource_path : TBasicType TUTF8
    IO (Ptr Texture)

-- | Creates a new texture by loading an image from a resource.
-- The file format is detected automatically.
-- The supported formats are PNG and JPEG, though more formats might be
-- available.
-- 
-- It is a fatal error if /@resourcePath@/ does not specify a valid
-- image resource and the program will abort if that happens.
-- If you are unsure about the validity of a resource, use
-- 'GI.Gdk.Objects.Texture.textureNewFromFile' to load it.
textureNewFromResource ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@resourcePath@/: the path of the resource file
    -> m Texture
    -- ^ __Returns:__ A newly-created texture
textureNewFromResource :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m Texture
textureNewFromResource Text
resourcePath = IO Texture -> m Texture
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Texture -> m Texture) -> IO Texture -> m Texture
forall a b. (a -> b) -> a -> b
$ do
    CString
resourcePath' <- Text -> IO CString
textToCString Text
resourcePath
    Ptr Texture
result <- CString -> IO (Ptr Texture)
gdk_texture_new_from_resource CString
resourcePath'
    Text -> Ptr Texture -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"textureNewFromResource" Ptr Texture
result
    Texture
result' <- ((ManagedPtr Texture -> Texture) -> Ptr Texture -> IO Texture
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Texture -> Texture
Texture) Ptr Texture
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
resourcePath'
    Texture -> IO Texture
forall (m :: * -> *) a. Monad m => a -> m a
return Texture
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Texture::download
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "texture"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Texture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkTexture" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) (-1) (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "pointer to enough memory to be filled with the\n    downloaded data of @texture"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stride"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "rowstride in bytes" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_texture_download" gdk_texture_download :: 
    Ptr Texture ->                          -- texture : TInterface (Name {namespace = "Gdk", name = "Texture"})
    Ptr Word8 ->                            -- data : TCArray False (-1) (-1) (TBasicType TUInt8)
    Word64 ->                               -- stride : TBasicType TUInt64
    IO ()

-- | Downloads the /@texture@/ into local memory. This may be
-- an expensive operation, as the actual texture data may
-- reside on a GPU or on a remote display server.
-- 
-- The data format of the downloaded data is equivalent to
-- 'GI.Cairo.Enums.FormatArgb32', so every downloaded pixel requires
-- 4 bytes of memory.
-- 
-- Downloading a texture into a Cairo image surface:
-- 
-- === /C code/
-- >
-- >surface = cairo_image_surface_create (CAIRO_FORMAT_ARGB32,
-- >                                      gdk_texture_get_width (texture),
-- >                                      gdk_texture_get_height (texture));
-- >gdk_texture_download (texture,
-- >                      cairo_image_surface_get_data (surface),
-- >                      cairo_image_surface_get_stride (surface));
-- >cairo_surface_mark_dirty (surface);
textureDownload ::
    (B.CallStack.HasCallStack, MonadIO m, IsTexture a) =>
    a
    -- ^ /@texture@/: a t'GI.Gdk.Objects.Texture.Texture'
    -> Ptr Word8
    -- ^ /@data@/: pointer to enough memory to be filled with the
    --     downloaded data of /@texture@/
    -> Word64
    -- ^ /@stride@/: rowstride in bytes
    -> m ()
textureDownload :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a -> Ptr Word8 -> Word64 -> m ()
textureDownload a
texture Ptr Word8
data_ Word64
stride = IO () -> m ()
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 -> Ptr Word8 -> Word64 -> IO ()
gdk_texture_download Ptr Texture
texture' Ptr Word8
data_ Word64
stride
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
texture
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextureDownloadMethodInfo
instance (signature ~ (Ptr Word8 -> Word64 -> m ()), MonadIO m, IsTexture a) => O.OverloadedMethod TextureDownloadMethodInfo a signature where
    overloadedMethod = textureDownload

instance O.OverloadedMethodInfo TextureDownloadMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Objects.Texture.textureDownload",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Objects-Texture.html#v:textureDownload"
        }


#endif

-- method Texture::get_height
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "texture"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Texture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkTexture" , 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 "gdk_texture_get_height" gdk_texture_get_height :: 
    Ptr Texture ->                          -- texture : TInterface (Name {namespace = "Gdk", name = "Texture"})
    IO Int32

-- | Returns the height of the /@texture@/, in pixels.
textureGetHeight ::
    (B.CallStack.HasCallStack, MonadIO m, IsTexture a) =>
    a
    -- ^ /@texture@/: a t'GI.Gdk.Objects.Texture.Texture'
    -> m Int32
    -- ^ __Returns:__ the height of the t'GI.Gdk.Objects.Texture.Texture'
textureGetHeight :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a -> m Int32
textureGetHeight a
texture = IO Int32 -> m Int32
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
gdk_texture_get_height Ptr Texture
texture'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
texture
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

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

instance O.OverloadedMethodInfo TextureGetHeightMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Objects.Texture.textureGetHeight",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Objects-Texture.html#v:textureGetHeight"
        }


#endif

-- method Texture::get_width
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "texture"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Texture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkTexture" , 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 "gdk_texture_get_width" gdk_texture_get_width :: 
    Ptr Texture ->                          -- texture : TInterface (Name {namespace = "Gdk", name = "Texture"})
    IO Int32

-- | Returns the width of /@texture@/, in pixels.
textureGetWidth ::
    (B.CallStack.HasCallStack, MonadIO m, IsTexture a) =>
    a
    -- ^ /@texture@/: a t'GI.Gdk.Objects.Texture.Texture'
    -> m Int32
    -- ^ __Returns:__ the width of the t'GI.Gdk.Objects.Texture.Texture'
textureGetWidth :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a -> m Int32
textureGetWidth a
texture = IO Int32 -> m Int32
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
gdk_texture_get_width Ptr Texture
texture'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
texture
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

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

instance O.OverloadedMethodInfo TextureGetWidthMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Objects.Texture.textureGetWidth",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Objects-Texture.html#v:textureGetWidth"
        }


#endif

-- method Texture::save_to_png
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "texture"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Texture" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkTexture" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filename"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the filename to store to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_texture_save_to_png" gdk_texture_save_to_png :: 
    Ptr Texture ->                          -- texture : TInterface (Name {namespace = "Gdk", name = "Texture"})
    CString ->                              -- filename : TBasicType TUTF8
    IO CInt

-- | Store the given /@texture@/ to the /@filename@/ as a PNG file.
-- 
-- This is a utility function intended for debugging and testing.
-- If you want more control over formats, proper error handling or
-- want to store to a t'GI.Gio.Interfaces.File.File' or other location, you might want to
-- look into using the gdk-pixbuf library.
textureSaveToPng ::
    (B.CallStack.HasCallStack, MonadIO m, IsTexture a) =>
    a
    -- ^ /@texture@/: a t'GI.Gdk.Objects.Texture.Texture'
    -> T.Text
    -- ^ /@filename@/: the filename to store to
    -> m Bool
    -- ^ __Returns:__ 'P.True' if saving succeeded, 'P.False' on failure.
textureSaveToPng :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a -> Text -> m Bool
textureSaveToPng a
texture Text
filename = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
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
    CString
filename' <- Text -> IO CString
textToCString Text
filename
    CInt
result <- Ptr Texture -> CString -> IO CInt
gdk_texture_save_to_png Ptr Texture
texture' CString
filename'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
texture
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TextureSaveToPngMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsTexture a) => O.OverloadedMethod TextureSaveToPngMethodInfo a signature where
    overloadedMethod = textureSaveToPng

instance O.OverloadedMethodInfo TextureSaveToPngMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Objects.Texture.textureSaveToPng",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Objects-Texture.html#v:textureSaveToPng"
        }


#endif