{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GdkTexture@ is the basic element used to refer to pixel data.
-- 
-- It is primarily meant for pixel data that will not change over
-- multiple frames, and will be used for a long time.
-- 
-- There are various ways to create @GdkTexture@ objects from a
-- t'GI.GdkPixbuf.Objects.Pixbuf.Pixbuf', or from bytes stored in memory, a file, or a
-- [struct/@gio@/.Resource].
-- 
-- The ownership of the pixel data is transferred to the @GdkTexture@
-- instance; you can only make a copy of it, via 'GI.Gdk.Objects.Texture.textureDownload'.
-- 
-- @GdkTexture@ is an immutable object: That means you cannot change
-- anything about it other than increasing the reference count via
-- 'GI.GObject.Objects.Object.objectRef', and consequently, it is a thread-safe object.

#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"), [equal]("GI.Gio.Interfaces.Icon#g:method:equal"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hash]("GI.Gio.Interfaces.Icon#g:method:hash"), [invalidateContents]("GI.Gdk.Interfaces.Paintable#g:method:invalidateContents"), [invalidateSize]("GI.Gdk.Interfaces.Paintable#g:method:invalidateSize"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [load]("GI.Gio.Interfaces.LoadableIcon#g:method:load"), [loadAsync]("GI.Gio.Interfaces.LoadableIcon#g:method:loadAsync"), [loadFinish]("GI.Gio.Interfaces.LoadableIcon#g:method:loadFinish"), [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"), [saveToPngBytes]("GI.Gdk.Objects.Texture#g:method:saveToPngBytes"), [saveToTiff]("GI.Gdk.Objects.Texture#g:method:saveToTiff"), [saveToTiffBytes]("GI.Gdk.Objects.Texture#g:method:saveToTiffBytes"), [serialize]("GI.Gio.Interfaces.Icon#g:method:serialize"), [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"), [toString]("GI.Gio.Interfaces.Icon#g:method:toString"), [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"), [getFormat]("GI.Gdk.Objects.Texture#g:method:getFormat"), [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                         ,


-- ** getFormat #method:getFormat#

#if defined(ENABLE_OVERLOADING)
    TextureGetFormatMethodInfo              ,
#endif
    textureGetFormat                        ,


-- ** getHeight #method:getHeight#

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


-- ** getWidth #method:getWidth#

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


-- ** newForPixbuf #method:newForPixbuf#

    textureNewForPixbuf                     ,


-- ** newFromBytes #method:newFromBytes#

    textureNewFromBytes                     ,


-- ** newFromFile #method:newFromFile#

    textureNewFromFile                      ,


-- ** newFromFilename #method:newFromFilename#

    textureNewFromFilename                  ,


-- ** newFromResource #method:newFromResource#

    textureNewFromResource                  ,


-- ** saveToPng #method:saveToPng#

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


-- ** saveToPngBytes #method:saveToPngBytes#

#if defined(ENABLE_OVERLOADING)
    TextureSaveToPngBytesMethodInfo         ,
#endif
    textureSaveToPngBytes                   ,


-- ** saveToTiff #method:saveToTiff#

#if defined(ENABLE_OVERLOADING)
    TextureSaveToTiffMethodInfo             ,
#endif
    textureSaveToTiff                       ,


-- ** saveToTiffBytes #method:saveToTiffBytes#

#if defined(ENABLE_OVERLOADING)
    TextureSaveToTiffBytesMethodInfo        ,
#endif
    textureSaveToTiffBytes                  ,




 -- * 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.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 qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gdk.Enums as Gdk.Enums
import {-# SOURCE #-} qualified GI.Gdk.Flags as Gdk.Flags
import {-# SOURCE #-} qualified GI.Gdk.Interfaces.Paintable as Gdk.Paintable
import {-# SOURCE #-} qualified GI.Gdk.Objects.Snapshot as Gdk.Snapshot
import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gio.Interfaces.LoadableIcon as Gio.LoadableIcon

#else
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gdk.Enums as Gdk.Enums
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
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gio.Interfaces.LoadableIcon as Gio.LoadableIcon

#endif

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

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, Gio.Icon.Icon, Gio.LoadableIcon.LoadableIcon]

-- | 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 a. IO a -> m a
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 <- 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 /= FP.nullPtr
        then P.Just <$> B.ManagedPtr.newObject Texture ptr
        else return P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveTextureMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveTextureMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveTextureMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveTextureMethod "computeConcreteSize" o = Gdk.Paintable.PaintableComputeConcreteSizeMethodInfo
    ResolveTextureMethod "download" o = TextureDownloadMethodInfo
    ResolveTextureMethod "equal" o = Gio.Icon.IconEqualMethodInfo
    ResolveTextureMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveTextureMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveTextureMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveTextureMethod "hash" o = Gio.Icon.IconHashMethodInfo
    ResolveTextureMethod "invalidateContents" o = Gdk.Paintable.PaintableInvalidateContentsMethodInfo
    ResolveTextureMethod "invalidateSize" o = Gdk.Paintable.PaintableInvalidateSizeMethodInfo
    ResolveTextureMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveTextureMethod "load" o = Gio.LoadableIcon.LoadableIconLoadMethodInfo
    ResolveTextureMethod "loadAsync" o = Gio.LoadableIcon.LoadableIconLoadAsyncMethodInfo
    ResolveTextureMethod "loadFinish" o = Gio.LoadableIcon.LoadableIconLoadFinishMethodInfo
    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 "saveToPngBytes" o = TextureSaveToPngBytesMethodInfo
    ResolveTextureMethod "saveToTiff" o = TextureSaveToTiffMethodInfo
    ResolveTextureMethod "saveToTiffBytes" o = TextureSaveToTiffBytesMethodInfo
    ResolveTextureMethod "serialize" o = Gio.Icon.IconSerializeMethodInfo
    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 "toString" o = Gio.Icon.IconToStringMethodInfo
    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 "getFormat" o = TextureGetFormatMethodInfo
    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 a. IO a -> m a
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 a. IO a -> m a
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 a. IO a -> IO a
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
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Texture.height"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Texture.html#g:attr:height"
        })
#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 a. IO a -> m a
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 a. IO a -> m a
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 a. IO a -> IO a
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
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Texture.width"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Texture.html#g:attr:width"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Texture
type instance O.AttributeList Texture = TextureAttributeList
type TextureAttributeList = ('[ '("height", TextureHeightPropertyInfo), '("width", TextureWidthPropertyInfo)] :: [(Symbol, DK.Type)])
#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, DK.Type)])

#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
--           , argCallbackUserData = 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 @GdkPixbuf@.
-- 
-- This function is threadsafe, so that you can e.g. use GTask
-- and 'GI.Gio.Objects.Task.taskRunInThread' to avoid blocking the main thread
-- while loading a big image.
textureNewForPixbuf ::
    (B.CallStack.HasCallStack, MonadIO m, GdkPixbuf.Pixbuf.IsPixbuf a) =>
    a
    -- ^ /@pixbuf@/: a @GdkPixbuf@
    -> m Texture
    -- ^ __Returns:__ a new @GdkTexture@
textureNewForPixbuf :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPixbuf a) =>
a -> m Texture
textureNewForPixbuf a
pixbuf = IO Texture -> m Texture
forall a. IO a -> m a
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
    pixbuf' <- a -> IO (Ptr Pixbuf)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pixbuf
    result <- gdk_texture_new_for_pixbuf pixbuf'
    checkUnexpectedReturnNULL "textureNewForPixbuf" result
    result' <- (wrapObject Texture) result
    touchManagedPtr pixbuf
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Texture::new_from_bytes
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "bytes"
--           , argType = TInterface Name { namespace = "GLib" , name = "Bytes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GBytes` containing the data to load"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Texture" })
-- throws : True
-- Skip return : False

foreign import ccall "gdk_texture_new_from_bytes" gdk_texture_new_from_bytes :: 
    Ptr GLib.Bytes.Bytes ->                 -- bytes : TInterface (Name {namespace = "GLib", name = "Bytes"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Texture)

-- | Creates a new texture by loading an image from memory,
-- 
-- The file format is detected automatically. The supported formats
-- are PNG, JPEG and TIFF, though more formats might be available.
-- 
-- If 'P.Nothing' is returned, then /@error@/ will be set.
-- 
-- This function is threadsafe, so that you can e.g. use GTask
-- and 'GI.Gio.Objects.Task.taskRunInThread' to avoid blocking the main thread
-- while loading a big image.
-- 
-- /Since: 4.6/
textureNewFromBytes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GLib.Bytes.Bytes
    -- ^ /@bytes@/: a @GBytes@ containing the data to load
    -> m Texture
    -- ^ __Returns:__ A newly-created @GdkTexture@ /(Can throw 'Data.GI.Base.GError.GError')/
textureNewFromBytes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Bytes -> m Texture
textureNewFromBytes Bytes
bytes = IO Texture -> m Texture
forall a. IO a -> m a
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
    bytes' <- Bytes -> IO (Ptr Bytes)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Bytes
bytes
    onException (do
        result <- propagateGError $ gdk_texture_new_from_bytes bytes'
        checkUnexpectedReturnNULL "textureNewFromBytes" result
        result' <- (wrapObject Texture) result
        touchManagedPtr bytes
        return result'
     ) (do
        return ()
     )

#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
--           , argCallbackUserData = 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, JPEG and TIFF, though more formats might be available.
-- 
-- If 'P.Nothing' is returned, then /@error@/ will be set.
-- 
-- This function is threadsafe, so that you can e.g. use GTask
-- and 'GI.Gio.Objects.Task.taskRunInThread' to avoid blocking the main thread
-- while loading a big image.
textureNewFromFile ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.File.IsFile a) =>
    a
    -- ^ /@file@/: @GFile@ to load
    -> m Texture
    -- ^ __Returns:__ A newly-created @GdkTexture@ /(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 a. IO a -> m a
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
    file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    onException (do
        result <- propagateGError $ gdk_texture_new_from_file file'
        checkUnexpectedReturnNULL "textureNewFromFile" result
        result' <- (wrapObject Texture) result
        touchManagedPtr file
        return result'
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Texture::new_from_filename
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "path"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the filename to load"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Texture" })
-- throws : True
-- Skip return : False

foreign import ccall "gdk_texture_new_from_filename" gdk_texture_new_from_filename :: 
    CString ->                              -- path : TBasicType TFileName
    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, JPEG and TIFF, though more formats might be available.
-- 
-- If 'P.Nothing' is returned, then /@error@/ will be set.
-- 
-- This function is threadsafe, so that you can e.g. use GTask
-- and 'GI.Gio.Objects.Task.taskRunInThread' to avoid blocking the main thread
-- while loading a big image.
-- 
-- /Since: 4.6/
textureNewFromFilename ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Char]
    -- ^ /@path@/: the filename to load
    -> m Texture
    -- ^ __Returns:__ A newly-created @GdkTexture@ /(Can throw 'Data.GI.Base.GError.GError')/
textureNewFromFilename :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> m Texture
textureNewFromFilename String
path = IO Texture -> m Texture
forall a. IO a -> m a
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
    path' <- String -> IO CString
stringToCString String
path
    onException (do
        result <- propagateGError $ gdk_texture_new_from_filename path'
        checkUnexpectedReturnNULL "textureNewFromFilename" result
        result' <- (wrapObject Texture) result
        freeMem path'
        return result'
     ) (do
        freeMem path'
     )

#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
--           , argCallbackUserData = 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.
-- 
-- This function is threadsafe, so that you can e.g. use GTask
-- and 'GI.Gio.Objects.Task.taskRunInThread' to avoid blocking the main thread
-- while loading a big image.
textureNewFromResource ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@resourcePath@/: the path of the resource file
    -> m Texture
    -- ^ __Returns:__ A newly-created @GdkTexture@
textureNewFromResource :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m Texture
textureNewFromResource Text
resourcePath = IO Texture -> m Texture
forall a. IO a -> m a
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
    resourcePath' <- Text -> IO CString
textToCString Text
resourcePath
    result <- gdk_texture_new_from_resource resourcePath'
    checkUnexpectedReturnNULL "textureNewFromResource" result
    result' <- (wrapObject Texture) result
    freeMem resourcePath'
    return 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stride"
--           , argType = TBasicType TSize
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "rowstride in bytes" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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)
    FCT.CSize ->                            -- stride : TBasicType TSize
    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);
-- 
-- 
-- For more flexible download capabilities, see
-- [struct/@gdk@/.TextureDownloader].
textureDownload ::
    (B.CallStack.HasCallStack, MonadIO m, IsTexture a) =>
    a
    -- ^ /@texture@/: a @GdkTexture@
    -> Ptr Word8
    -- ^ /@data@/: pointer to enough memory to be filled with the
    --   downloaded data of /@texture@/
    -> FCT.CSize
    -- ^ /@stride@/: rowstride in bytes
    -> m ()
textureDownload :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a -> Ptr Word8 -> CSize -> m ()
textureDownload a
texture Ptr Word8
data_ CSize
stride = 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
    texture' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
texture
    gdk_texture_download texture' data_ stride
    touchManagedPtr texture
    return ()

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

instance O.OverloadedMethodInfo TextureDownloadMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Texture.textureDownload",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Texture.html#v:textureDownload"
        })


#endif

-- method Texture::get_format
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gdk" , name = "MemoryFormat" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_texture_get_format" gdk_texture_get_format :: 
    Ptr Texture ->                          -- self : TInterface (Name {namespace = "Gdk", name = "Texture"})
    IO CUInt

-- | Gets the memory format most closely associated with the data of
-- the texture.
-- 
-- Note that it may not be an exact match for texture data
-- stored on the GPU or with compression.
-- 
-- The format can give an indication about the bit depth and opacity
-- of the texture and is useful to determine the best format for
-- downloading the texture.
-- 
-- /Since: 4.10/
textureGetFormat ::
    (B.CallStack.HasCallStack, MonadIO m, IsTexture a) =>
    a
    -- ^ /@self@/: a GdkTexture
    -> m Gdk.Enums.MemoryFormat
    -- ^ __Returns:__ the preferred format for the texture\'s data
textureGetFormat :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a -> m MemoryFormat
textureGetFormat a
self = IO MemoryFormat -> m MemoryFormat
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MemoryFormat -> m MemoryFormat)
-> IO MemoryFormat -> m MemoryFormat
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gdk_texture_get_format self'
    let result' = (Int -> MemoryFormat
forall a. Enum a => Int -> a
toEnum (Int -> MemoryFormat) -> (CUInt -> Int) -> CUInt -> MemoryFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    touchManagedPtr self
    return result'

#if defined(ENABLE_OVERLOADING)
data TextureGetFormatMethodInfo
instance (signature ~ (m Gdk.Enums.MemoryFormat), MonadIO m, IsTexture a) => O.OverloadedMethod TextureGetFormatMethodInfo a signature where
    overloadedMethod = textureGetFormat

instance O.OverloadedMethodInfo TextureGetFormatMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Texture.textureGetFormat",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Texture.html#v:textureGetFormat"
        })


#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
--           , argCallbackUserData = 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 @GdkTexture@
    -> m Int32
    -- ^ __Returns:__ the height of the @GdkTexture@
textureGetHeight :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a -> m Int32
textureGetHeight 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
    texture' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
texture
    result <- gdk_texture_get_height texture'
    touchManagedPtr texture
    return 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 = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Texture.textureGetHeight",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/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
--           , argCallbackUserData = 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 @GdkTexture@
    -> m Int32
    -- ^ __Returns:__ the width of the @GdkTexture@
textureGetWidth :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a -> m Int32
textureGetWidth 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
    texture' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
texture
    result <- gdk_texture_get_width texture'
    touchManagedPtr texture
    return 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 = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Texture.textureGetWidth",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filename"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the filename to store to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 TFileName
    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
-- use 'GI.Gdk.Objects.Texture.textureSaveToPngBytes' or look into the
-- gdk-pixbuf library.
textureSaveToPng ::
    (B.CallStack.HasCallStack, MonadIO m, IsTexture a) =>
    a
    -- ^ /@texture@/: a @GdkTexture@
    -> [Char]
    -- ^ /@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 -> String -> m Bool
textureSaveToPng a
texture String
filename = IO Bool -> m Bool
forall a. IO a -> m a
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
    texture' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
texture
    filename' <- stringToCString filename
    result <- gdk_texture_save_to_png texture' filename'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr texture
    freeMem filename'
    return result'

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

instance O.OverloadedMethodInfo TextureSaveToPngMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Texture.textureSaveToPng",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Texture.html#v:textureSaveToPng"
        })


#endif

-- method Texture::save_to_png_bytes
-- 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "Bytes" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_texture_save_to_png_bytes" gdk_texture_save_to_png_bytes :: 
    Ptr Texture ->                          -- texture : TInterface (Name {namespace = "Gdk", name = "Texture"})
    IO (Ptr GLib.Bytes.Bytes)

-- | Store the given /@texture@/ in memory as a PNG file.
-- 
-- Use 'GI.Gdk.Objects.Texture.textureNewFromBytes' to read it back.
-- 
-- If you want to serialize a texture, this is a convenient and
-- portable way to do that.
-- 
-- If you need more control over the generated image, such as
-- attaching metadata, you should look into an image handling
-- library such as the gdk-pixbuf library.
-- 
-- If you are dealing with high dynamic range float data, you
-- might also want to consider 'GI.Gdk.Objects.Texture.textureSaveToTiffBytes'
-- instead.
-- 
-- /Since: 4.6/
textureSaveToPngBytes ::
    (B.CallStack.HasCallStack, MonadIO m, IsTexture a) =>
    a
    -- ^ /@texture@/: a @GdkTexture@
    -> m GLib.Bytes.Bytes
    -- ^ __Returns:__ a newly allocated @GBytes@ containing PNG data
textureSaveToPngBytes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a -> m Bytes
textureSaveToPngBytes a
texture = IO Bytes -> m Bytes
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bytes -> m Bytes) -> IO Bytes -> m Bytes
forall a b. (a -> b) -> a -> b
$ do
    texture' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
texture
    result <- gdk_texture_save_to_png_bytes texture'
    checkUnexpectedReturnNULL "textureSaveToPngBytes" result
    result' <- (wrapBoxed GLib.Bytes.Bytes) result
    touchManagedPtr texture
    return result'

#if defined(ENABLE_OVERLOADING)
data TextureSaveToPngBytesMethodInfo
instance (signature ~ (m GLib.Bytes.Bytes), MonadIO m, IsTexture a) => O.OverloadedMethod TextureSaveToPngBytesMethodInfo a signature where
    overloadedMethod = textureSaveToPngBytes

instance O.OverloadedMethodInfo TextureSaveToPngBytesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Texture.textureSaveToPngBytes",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Texture.html#v:textureSaveToPngBytes"
        })


#endif

-- method Texture::save_to_tiff
-- 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filename"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the filename to store to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

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

-- | Store the given /@texture@/ to the /@filename@/ as a TIFF file.
-- 
-- GTK will attempt to store data without loss.
-- 
-- /Since: 4.6/
textureSaveToTiff ::
    (B.CallStack.HasCallStack, MonadIO m, IsTexture a) =>
    a
    -- ^ /@texture@/: a @GdkTexture@
    -> [Char]
    -- ^ /@filename@/: the filename to store to
    -> m Bool
    -- ^ __Returns:__ 'P.True' if saving succeeded, 'P.False' on failure.
textureSaveToTiff :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a -> String -> m Bool
textureSaveToTiff a
texture String
filename = IO Bool -> m Bool
forall a. IO a -> m a
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
    texture' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
texture
    filename' <- stringToCString filename
    result <- gdk_texture_save_to_tiff texture' filename'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr texture
    freeMem filename'
    return result'

#if defined(ENABLE_OVERLOADING)
data TextureSaveToTiffMethodInfo
instance (signature ~ ([Char] -> m Bool), MonadIO m, IsTexture a) => O.OverloadedMethod TextureSaveToTiffMethodInfo a signature where
    overloadedMethod = textureSaveToTiff

instance O.OverloadedMethodInfo TextureSaveToTiffMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Texture.textureSaveToTiff",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Texture.html#v:textureSaveToTiff"
        })


#endif

-- method Texture::save_to_tiff_bytes
-- 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "Bytes" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_texture_save_to_tiff_bytes" gdk_texture_save_to_tiff_bytes :: 
    Ptr Texture ->                          -- texture : TInterface (Name {namespace = "Gdk", name = "Texture"})
    IO (Ptr GLib.Bytes.Bytes)

-- | Store the given /@texture@/ in memory as a TIFF file.
-- 
-- Use 'GI.Gdk.Objects.Texture.textureNewFromBytes' to read it back.
-- 
-- This function is intended to store a representation of the
-- texture\'s data that is as accurate as possible. This is
-- particularly relevant when working with high dynamic range
-- images and floating-point texture data.
-- 
-- If that is not your concern and you are interested in a
-- smaller size and a more portable format, you might want to
-- use 'GI.Gdk.Objects.Texture.textureSaveToPngBytes'.
-- 
-- /Since: 4.6/
textureSaveToTiffBytes ::
    (B.CallStack.HasCallStack, MonadIO m, IsTexture a) =>
    a
    -- ^ /@texture@/: a @GdkTexture@
    -> m GLib.Bytes.Bytes
    -- ^ __Returns:__ a newly allocated @GBytes@ containing TIFF data
textureSaveToTiffBytes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTexture a) =>
a -> m Bytes
textureSaveToTiffBytes a
texture = IO Bytes -> m Bytes
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bytes -> m Bytes) -> IO Bytes -> m Bytes
forall a b. (a -> b) -> a -> b
$ do
    texture' <- a -> IO (Ptr Texture)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
texture
    result <- gdk_texture_save_to_tiff_bytes texture'
    checkUnexpectedReturnNULL "textureSaveToTiffBytes" result
    result' <- (wrapBoxed GLib.Bytes.Bytes) result
    touchManagedPtr texture
    return result'

#if defined(ENABLE_OVERLOADING)
data TextureSaveToTiffBytesMethodInfo
instance (signature ~ (m GLib.Bytes.Bytes), MonadIO m, IsTexture a) => O.OverloadedMethod TextureSaveToTiffBytesMethodInfo a signature where
    overloadedMethod = textureSaveToTiffBytes

instance O.OverloadedMethodInfo TextureSaveToTiffBytesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Texture.textureSaveToTiffBytes",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Texture.html#v:textureSaveToTiffBytes"
        })


#endif