{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An opaque struct representing an animation.

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

module GI.GdkPixbuf.Objects.PixbufAnimation
    ( 

-- * Exported types
    PixbufAnimation(..)                     ,
    IsPixbufAnimation                       ,
    toPixbufAnimation                       ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolvePixbufAnimationMethod            ,
#endif


-- ** getHeight #method:getHeight#

#if defined(ENABLE_OVERLOADING)
    PixbufAnimationGetHeightMethodInfo      ,
#endif
    pixbufAnimationGetHeight                ,


-- ** getIter #method:getIter#

#if defined(ENABLE_OVERLOADING)
    PixbufAnimationGetIterMethodInfo        ,
#endif
    pixbufAnimationGetIter                  ,


-- ** getStaticImage #method:getStaticImage#

#if defined(ENABLE_OVERLOADING)
    PixbufAnimationGetStaticImageMethodInfo ,
#endif
    pixbufAnimationGetStaticImage           ,


-- ** getWidth #method:getWidth#

#if defined(ENABLE_OVERLOADING)
    PixbufAnimationGetWidthMethodInfo       ,
#endif
    pixbufAnimationGetWidth                 ,


-- ** isStaticImage #method:isStaticImage#

#if defined(ENABLE_OVERLOADING)
    PixbufAnimationIsStaticImageMethodInfo  ,
#endif
    pixbufAnimationIsStaticImage            ,


-- ** newFromFile #method:newFromFile#

    pixbufAnimationNewFromFile              ,


-- ** newFromResource #method:newFromResource#

    pixbufAnimationNewFromResource          ,


-- ** newFromStream #method:newFromStream#

    pixbufAnimationNewFromStream            ,


-- ** newFromStreamAsync #method:newFromStreamAsync#

    pixbufAnimationNewFromStreamAsync       ,


-- ** newFromStreamFinish #method:newFromStreamFinish#

    pixbufAnimationNewFromStreamFinish      ,




    ) 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.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 GI.GLib.Structs.TimeVal as GLib.TimeVal
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import {-# SOURCE #-} qualified GI.GdkPixbuf.Objects.PixbufAnimationIter as GdkPixbuf.PixbufAnimationIter
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.InputStream as Gio.InputStream

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

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

foreign import ccall "gdk_pixbuf_animation_get_type"
    c_gdk_pixbuf_animation_get_type :: IO B.Types.GType

instance B.Types.TypedObject PixbufAnimation where
    glibType :: IO GType
glibType = IO GType
c_gdk_pixbuf_animation_get_type

instance B.Types.GObject PixbufAnimation

-- | Convert 'PixbufAnimation' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue PixbufAnimation where
    toGValue :: PixbufAnimation -> IO GValue
toGValue PixbufAnimation
o = do
        GType
gtype <- IO GType
c_gdk_pixbuf_animation_get_type
        PixbufAnimation -> (Ptr PixbufAnimation -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr PixbufAnimation
o (GType
-> (GValue -> Ptr PixbufAnimation -> IO ())
-> Ptr PixbufAnimation
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr PixbufAnimation -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO PixbufAnimation
fromGValue GValue
gv = do
        Ptr PixbufAnimation
ptr <- GValue -> IO (Ptr PixbufAnimation)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr PixbufAnimation)
        (ManagedPtr PixbufAnimation -> PixbufAnimation)
-> Ptr PixbufAnimation -> IO PixbufAnimation
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr PixbufAnimation -> PixbufAnimation
PixbufAnimation Ptr PixbufAnimation
ptr
        
    

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

instance O.HasParentTypes PixbufAnimation
type instance O.ParentTypes PixbufAnimation = '[GObject.Object.Object]

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

#if defined(ENABLE_OVERLOADING)
type family ResolvePixbufAnimationMethod (t :: Symbol) (o :: *) :: * where
    ResolvePixbufAnimationMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePixbufAnimationMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePixbufAnimationMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePixbufAnimationMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePixbufAnimationMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePixbufAnimationMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePixbufAnimationMethod "isStaticImage" o = PixbufAnimationIsStaticImageMethodInfo
    ResolvePixbufAnimationMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePixbufAnimationMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePixbufAnimationMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolvePixbufAnimationMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePixbufAnimationMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePixbufAnimationMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePixbufAnimationMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePixbufAnimationMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePixbufAnimationMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolvePixbufAnimationMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePixbufAnimationMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePixbufAnimationMethod "getHeight" o = PixbufAnimationGetHeightMethodInfo
    ResolvePixbufAnimationMethod "getIter" o = PixbufAnimationGetIterMethodInfo
    ResolvePixbufAnimationMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePixbufAnimationMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePixbufAnimationMethod "getStaticImage" o = PixbufAnimationGetStaticImageMethodInfo
    ResolvePixbufAnimationMethod "getWidth" o = PixbufAnimationGetWidthMethodInfo
    ResolvePixbufAnimationMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePixbufAnimationMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePixbufAnimationMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePixbufAnimationMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolvePixbufAnimationMethod t PixbufAnimation, O.MethodInfo info PixbufAnimation p) => OL.IsLabel t (PixbufAnimation -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList PixbufAnimation = PixbufAnimationSignalList
type PixbufAnimationSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method PixbufAnimation::new_from_file
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "filename"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Name of file to load, in the GLib file\n    name encoding"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GdkPixbuf" , name = "PixbufAnimation" })
-- throws : True
-- Skip return : False

foreign import ccall "gdk_pixbuf_animation_new_from_file" gdk_pixbuf_animation_new_from_file :: 
    CString ->                              -- filename : TBasicType TFileName
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr PixbufAnimation)

-- | Creates a new animation by loading it from a file. The file format is
-- detected automatically. If the file\'s format does not support multi-frame
-- images, then an animation with a single frame will be created. Possible errors
-- are in the @/GDK_PIXBUF_ERROR/@ and @/G_FILE_ERROR/@ domains.
pixbufAnimationNewFromFile ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Char]
    -- ^ /@filename@/: Name of file to load, in the GLib file
    --     name encoding
    -> m PixbufAnimation
    -- ^ __Returns:__ A newly-created animation with a reference count of 1, or 'P.Nothing'
    -- if any of several error conditions ocurred:  the file could not be opened,
    -- there was no loader for the file\'s format, there was not enough memory to
    -- allocate the image buffer, or the image file contained invalid data. /(Can throw 'Data.GI.Base.GError.GError')/
pixbufAnimationNewFromFile :: [Char] -> m PixbufAnimation
pixbufAnimationNewFromFile [Char]
filename = IO PixbufAnimation -> m PixbufAnimation
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PixbufAnimation -> m PixbufAnimation)
-> IO PixbufAnimation -> m PixbufAnimation
forall a b. (a -> b) -> a -> b
$ do
    CString
filename' <- [Char] -> IO CString
stringToCString [Char]
filename
    IO PixbufAnimation -> IO () -> IO PixbufAnimation
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr PixbufAnimation
result <- (Ptr (Ptr GError) -> IO (Ptr PixbufAnimation))
-> IO (Ptr PixbufAnimation)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr PixbufAnimation))
 -> IO (Ptr PixbufAnimation))
-> (Ptr (Ptr GError) -> IO (Ptr PixbufAnimation))
-> IO (Ptr PixbufAnimation)
forall a b. (a -> b) -> a -> b
$ CString -> Ptr (Ptr GError) -> IO (Ptr PixbufAnimation)
gdk_pixbuf_animation_new_from_file CString
filename'
        Text -> Ptr PixbufAnimation -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pixbufAnimationNewFromFile" Ptr PixbufAnimation
result
        PixbufAnimation
result' <- ((ManagedPtr PixbufAnimation -> PixbufAnimation)
-> Ptr PixbufAnimation -> IO PixbufAnimation
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr PixbufAnimation -> PixbufAnimation
PixbufAnimation) Ptr PixbufAnimation
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
        PixbufAnimation -> IO PixbufAnimation
forall (m :: * -> *) a. Monad m => a -> m a
return PixbufAnimation
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method PixbufAnimation::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 = "GdkPixbuf" , name = "PixbufAnimation" })
-- throws : True
-- Skip return : False

foreign import ccall "gdk_pixbuf_animation_new_from_resource" gdk_pixbuf_animation_new_from_resource :: 
    CString ->                              -- resource_path : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr PixbufAnimation)

-- | Creates a new pixbuf animation by loading an image from an resource.
-- 
-- The file format is detected automatically. If 'P.Nothing' is returned, then
-- /@error@/ will be set.
-- 
-- /Since: 2.28/
pixbufAnimationNewFromResource ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@resourcePath@/: the path of the resource file
    -> m PixbufAnimation
    -- ^ __Returns:__ A newly-created animation, or 'P.Nothing' if any of several error
    -- conditions occurred: the file could not be opened, the image format is
    -- not supported, there was not enough memory to allocate the image buffer,
    -- the stream contained invalid data, or the operation was cancelled. /(Can throw 'Data.GI.Base.GError.GError')/
pixbufAnimationNewFromResource :: Text -> m PixbufAnimation
pixbufAnimationNewFromResource Text
resourcePath = IO PixbufAnimation -> m PixbufAnimation
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PixbufAnimation -> m PixbufAnimation)
-> IO PixbufAnimation -> m PixbufAnimation
forall a b. (a -> b) -> a -> b
$ do
    CString
resourcePath' <- Text -> IO CString
textToCString Text
resourcePath
    IO PixbufAnimation -> IO () -> IO PixbufAnimation
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr PixbufAnimation
result <- (Ptr (Ptr GError) -> IO (Ptr PixbufAnimation))
-> IO (Ptr PixbufAnimation)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr PixbufAnimation))
 -> IO (Ptr PixbufAnimation))
-> (Ptr (Ptr GError) -> IO (Ptr PixbufAnimation))
-> IO (Ptr PixbufAnimation)
forall a b. (a -> b) -> a -> b
$ CString -> Ptr (Ptr GError) -> IO (Ptr PixbufAnimation)
gdk_pixbuf_animation_new_from_resource CString
resourcePath'
        Text -> Ptr PixbufAnimation -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pixbufAnimationNewFromResource" Ptr PixbufAnimation
result
        PixbufAnimation
result' <- ((ManagedPtr PixbufAnimation -> PixbufAnimation)
-> Ptr PixbufAnimation -> IO PixbufAnimation
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr PixbufAnimation -> PixbufAnimation
PixbufAnimation) Ptr PixbufAnimation
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
resourcePath'
        PixbufAnimation -> IO PixbufAnimation
forall (m :: * -> *) a. Monad m => a -> m a
return PixbufAnimation
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
resourcePath'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method PixbufAnimation::new_from_stream
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "InputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GInputStream to load the pixbuf from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GdkPixbuf" , name = "PixbufAnimation" })
-- throws : True
-- Skip return : False

foreign import ccall "gdk_pixbuf_animation_new_from_stream" gdk_pixbuf_animation_new_from_stream :: 
    Ptr Gio.InputStream.InputStream ->      -- stream : TInterface (Name {namespace = "Gio", name = "InputStream"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr PixbufAnimation)

-- | Creates a new animation by loading it from an input stream.
-- 
-- The file format is detected automatically. If 'P.Nothing' is returned, then
-- /@error@/ will be set. The /@cancellable@/ can be used to abort the operation
-- from another thread. If the operation was cancelled, the error
-- 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned. Other possible errors are in
-- the @/GDK_PIXBUF_ERROR/@ and @/G_IO_ERROR/@ domains.
-- 
-- The stream is not closed.
-- 
-- /Since: 2.28/
pixbufAnimationNewFromStream ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.InputStream.IsInputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.InputStream.InputStream' to load the pixbuf from
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore
    -> m PixbufAnimation
    -- ^ __Returns:__ A newly-created pixbuf, or 'P.Nothing' if any of several error
    -- conditions occurred: the file could not be opened, the image format is
    -- not supported, there was not enough memory to allocate the image buffer,
    -- the stream contained invalid data, or the operation was cancelled. /(Can throw 'Data.GI.Base.GError.GError')/
pixbufAnimationNewFromStream :: a -> Maybe b -> m PixbufAnimation
pixbufAnimationNewFromStream a
stream Maybe b
cancellable = IO PixbufAnimation -> m PixbufAnimation
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PixbufAnimation -> m PixbufAnimation)
-> IO PixbufAnimation -> m PixbufAnimation
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputStream
stream' <- a -> IO (Ptr InputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO PixbufAnimation -> IO () -> IO PixbufAnimation
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr PixbufAnimation
result <- (Ptr (Ptr GError) -> IO (Ptr PixbufAnimation))
-> IO (Ptr PixbufAnimation)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr PixbufAnimation))
 -> IO (Ptr PixbufAnimation))
-> (Ptr (Ptr GError) -> IO (Ptr PixbufAnimation))
-> IO (Ptr PixbufAnimation)
forall a b. (a -> b) -> a -> b
$ Ptr InputStream
-> Ptr Cancellable -> Ptr (Ptr GError) -> IO (Ptr PixbufAnimation)
gdk_pixbuf_animation_new_from_stream Ptr InputStream
stream' Ptr Cancellable
maybeCancellable
        Text -> Ptr PixbufAnimation -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pixbufAnimationNewFromStream" Ptr PixbufAnimation
result
        PixbufAnimation
result' <- ((ManagedPtr PixbufAnimation -> PixbufAnimation)
-> Ptr PixbufAnimation -> IO PixbufAnimation
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr PixbufAnimation -> PixbufAnimation
PixbufAnimation) Ptr PixbufAnimation
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        PixbufAnimation -> IO PixbufAnimation
forall (m :: * -> *) a. Monad m => a -> m a
return PixbufAnimation
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "gdk_pixbuf_animation_new_from_stream_finish" gdk_pixbuf_animation_new_from_stream_finish :: 
    Ptr Gio.AsyncResult.AsyncResult ->      -- async_result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr PixbufAnimation)

-- | Finishes an asynchronous pixbuf animation creation operation started with
-- 'GI.GdkPixbuf.Objects.PixbufAnimation.pixbufAnimationNewFromStreamAsync'.
-- 
-- /Since: 2.28/
pixbufAnimationNewFromStreamFinish ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.AsyncResult.IsAsyncResult a) =>
    a
    -- ^ /@asyncResult@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m PixbufAnimation
    -- ^ __Returns:__ a t'GI.GdkPixbuf.Objects.PixbufAnimation.PixbufAnimation' or 'P.Nothing' on error. Free the returned
    -- object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
pixbufAnimationNewFromStreamFinish :: a -> m PixbufAnimation
pixbufAnimationNewFromStreamFinish a
asyncResult = IO PixbufAnimation -> m PixbufAnimation
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PixbufAnimation -> m PixbufAnimation)
-> IO PixbufAnimation -> m PixbufAnimation
forall a b. (a -> b) -> a -> b
$ do
    Ptr AsyncResult
asyncResult' <- a -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
asyncResult
    IO PixbufAnimation -> IO () -> IO PixbufAnimation
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr PixbufAnimation
result <- (Ptr (Ptr GError) -> IO (Ptr PixbufAnimation))
-> IO (Ptr PixbufAnimation)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr PixbufAnimation))
 -> IO (Ptr PixbufAnimation))
-> (Ptr (Ptr GError) -> IO (Ptr PixbufAnimation))
-> IO (Ptr PixbufAnimation)
forall a b. (a -> b) -> a -> b
$ Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr PixbufAnimation)
gdk_pixbuf_animation_new_from_stream_finish Ptr AsyncResult
asyncResult'
        Text -> Ptr PixbufAnimation -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pixbufAnimationNewFromStreamFinish" Ptr PixbufAnimation
result
        PixbufAnimation
result' <- ((ManagedPtr PixbufAnimation -> PixbufAnimation)
-> Ptr PixbufAnimation -> IO PixbufAnimation
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr PixbufAnimation -> PixbufAnimation
PixbufAnimation) Ptr PixbufAnimation
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
asyncResult
        PixbufAnimation -> IO PixbufAnimation
forall (m :: * -> *) a. Monad m => a -> m a
return PixbufAnimation
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method PixbufAnimation::get_height
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animation"
--           , argType =
--               TInterface
--                 Name { namespace = "GdkPixbuf" , name = "PixbufAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An animation." , 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_pixbuf_animation_get_height" gdk_pixbuf_animation_get_height :: 
    Ptr PixbufAnimation ->                  -- animation : TInterface (Name {namespace = "GdkPixbuf", name = "PixbufAnimation"})
    IO Int32

-- | Queries the height of the bounding box of a pixbuf animation.
pixbufAnimationGetHeight ::
    (B.CallStack.HasCallStack, MonadIO m, IsPixbufAnimation a) =>
    a
    -- ^ /@animation@/: An animation.
    -> m Int32
    -- ^ __Returns:__ Height of the bounding box of the animation.
pixbufAnimationGetHeight :: a -> m Int32
pixbufAnimationGetHeight a
animation = 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 PixbufAnimation
animation' <- a -> IO (Ptr PixbufAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    Int32
result <- Ptr PixbufAnimation -> IO Int32
gdk_pixbuf_animation_get_height Ptr PixbufAnimation
animation'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animation
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data PixbufAnimationGetHeightMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsPixbufAnimation a) => O.MethodInfo PixbufAnimationGetHeightMethodInfo a signature where
    overloadedMethod = pixbufAnimationGetHeight

#endif

-- method PixbufAnimation::get_iter
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animation"
--           , argType =
--               TInterface
--                 Name { namespace = "GdkPixbuf" , name = "PixbufAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkPixbufAnimation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start_time"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "TimeVal" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "time when the animation starts playing"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GdkPixbuf" , name = "PixbufAnimationIter" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_pixbuf_animation_get_iter" gdk_pixbuf_animation_get_iter :: 
    Ptr PixbufAnimation ->                  -- animation : TInterface (Name {namespace = "GdkPixbuf", name = "PixbufAnimation"})
    Ptr GLib.TimeVal.TimeVal ->             -- start_time : TInterface (Name {namespace = "GLib", name = "TimeVal"})
    IO (Ptr GdkPixbuf.PixbufAnimationIter.PixbufAnimationIter)

-- | Get an iterator for displaying an animation. The iterator provides
-- the frames that should be displayed at a given time. It should be
-- freed after use with 'GI.GObject.Objects.Object.objectUnref'.
-- 
-- /@startTime@/ would normally come from 'GI.GLib.Functions.getCurrentTime', and marks
-- the beginning of animation playback. After creating an iterator, you
-- should immediately display the pixbuf returned by
-- 'GI.GdkPixbuf.Objects.PixbufAnimationIter.pixbufAnimationIterGetPixbuf'. Then, you should install
-- a timeout (with @/g_timeout_add()/@) or by some other mechanism ensure
-- that you\'ll update the image after
-- 'GI.GdkPixbuf.Objects.PixbufAnimationIter.pixbufAnimationIterGetDelayTime' milliseconds. Each time
-- the image is updated, you should reinstall the timeout with the new,
-- possibly-changed delay time.
-- 
-- As a shortcut, if /@startTime@/ is 'P.Nothing', the result of
-- 'GI.GLib.Functions.getCurrentTime' will be used automatically.
-- 
-- To update the image (i.e. possibly change the result of
-- 'GI.GdkPixbuf.Objects.PixbufAnimationIter.pixbufAnimationIterGetPixbuf' to a new frame of the animation),
-- call 'GI.GdkPixbuf.Objects.PixbufAnimationIter.pixbufAnimationIterAdvance'.
-- 
-- If you\'re using t'GI.GdkPixbuf.Objects.PixbufLoader.PixbufLoader', in addition to updating the image
-- after the delay time, you should also update it whenever you
-- receive the area_updated signal and
-- 'GI.GdkPixbuf.Objects.PixbufAnimationIter.pixbufAnimationIterOnCurrentlyLoadingFrame' returns
-- 'P.True'. In this case, the frame currently being fed into the loader
-- has received new data, so needs to be refreshed. The delay time for
-- a frame may also be modified after an area_updated signal, for
-- example if the delay time for a frame is encoded in the data after
-- the frame itself. So your timeout should be reinstalled after any
-- area_updated signal.
-- 
-- A delay time of -1 is possible, indicating \"infinite.\"
pixbufAnimationGetIter ::
    (B.CallStack.HasCallStack, MonadIO m, IsPixbufAnimation a) =>
    a
    -- ^ /@animation@/: a t'GI.GdkPixbuf.Objects.PixbufAnimation.PixbufAnimation'
    -> Maybe (GLib.TimeVal.TimeVal)
    -- ^ /@startTime@/: time when the animation starts playing
    -> m GdkPixbuf.PixbufAnimationIter.PixbufAnimationIter
    -- ^ __Returns:__ an iterator to move over the animation
pixbufAnimationGetIter :: a -> Maybe TimeVal -> m PixbufAnimationIter
pixbufAnimationGetIter a
animation Maybe TimeVal
startTime = IO PixbufAnimationIter -> m PixbufAnimationIter
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PixbufAnimationIter -> m PixbufAnimationIter)
-> IO PixbufAnimationIter -> m PixbufAnimationIter
forall a b. (a -> b) -> a -> b
$ do
    Ptr PixbufAnimation
animation' <- a -> IO (Ptr PixbufAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    Ptr TimeVal
maybeStartTime <- case Maybe TimeVal
startTime of
        Maybe TimeVal
Nothing -> Ptr TimeVal -> IO (Ptr TimeVal)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TimeVal
forall a. Ptr a
nullPtr
        Just TimeVal
jStartTime -> do
            Ptr TimeVal
jStartTime' <- TimeVal -> IO (Ptr TimeVal)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TimeVal
jStartTime
            Ptr TimeVal -> IO (Ptr TimeVal)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TimeVal
jStartTime'
    Ptr PixbufAnimationIter
result <- Ptr PixbufAnimation -> Ptr TimeVal -> IO (Ptr PixbufAnimationIter)
gdk_pixbuf_animation_get_iter Ptr PixbufAnimation
animation' Ptr TimeVal
maybeStartTime
    Text -> Ptr PixbufAnimationIter -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pixbufAnimationGetIter" Ptr PixbufAnimationIter
result
    PixbufAnimationIter
result' <- ((ManagedPtr PixbufAnimationIter -> PixbufAnimationIter)
-> Ptr PixbufAnimationIter -> IO PixbufAnimationIter
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr PixbufAnimationIter -> PixbufAnimationIter
GdkPixbuf.PixbufAnimationIter.PixbufAnimationIter) Ptr PixbufAnimationIter
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animation
    Maybe TimeVal -> (TimeVal -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe TimeVal
startTime TimeVal -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    PixbufAnimationIter -> IO PixbufAnimationIter
forall (m :: * -> *) a. Monad m => a -> m a
return PixbufAnimationIter
result'

#if defined(ENABLE_OVERLOADING)
data PixbufAnimationGetIterMethodInfo
instance (signature ~ (Maybe (GLib.TimeVal.TimeVal) -> m GdkPixbuf.PixbufAnimationIter.PixbufAnimationIter), MonadIO m, IsPixbufAnimation a) => O.MethodInfo PixbufAnimationGetIterMethodInfo a signature where
    overloadedMethod = pixbufAnimationGetIter

#endif

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

foreign import ccall "gdk_pixbuf_animation_get_static_image" gdk_pixbuf_animation_get_static_image :: 
    Ptr PixbufAnimation ->                  -- animation : TInterface (Name {namespace = "GdkPixbuf", name = "PixbufAnimation"})
    IO (Ptr GdkPixbuf.Pixbuf.Pixbuf)

-- | If an animation is really just a plain image (has only one frame),
-- this function returns that image. If the animation is an animation,
-- this function returns a reasonable thing to display as a static
-- unanimated image, which might be the first frame, or something more
-- sophisticated. If an animation hasn\'t loaded any frames yet, this
-- function will return 'P.Nothing'.
pixbufAnimationGetStaticImage ::
    (B.CallStack.HasCallStack, MonadIO m, IsPixbufAnimation a) =>
    a
    -- ^ /@animation@/: a t'GI.GdkPixbuf.Objects.PixbufAnimation.PixbufAnimation'
    -> m GdkPixbuf.Pixbuf.Pixbuf
    -- ^ __Returns:__ unanimated image representing the animation
pixbufAnimationGetStaticImage :: a -> m Pixbuf
pixbufAnimationGetStaticImage a
animation = IO Pixbuf -> m Pixbuf
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Pixbuf -> m Pixbuf) -> IO Pixbuf -> m Pixbuf
forall a b. (a -> b) -> a -> b
$ do
    Ptr PixbufAnimation
animation' <- a -> IO (Ptr PixbufAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    Ptr Pixbuf
result <- Ptr PixbufAnimation -> IO (Ptr Pixbuf)
gdk_pixbuf_animation_get_static_image Ptr PixbufAnimation
animation'
    Text -> Ptr Pixbuf -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pixbufAnimationGetStaticImage" Ptr Pixbuf
result
    Pixbuf
result' <- ((ManagedPtr Pixbuf -> Pixbuf) -> Ptr Pixbuf -> IO Pixbuf
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Pixbuf -> Pixbuf
GdkPixbuf.Pixbuf.Pixbuf) Ptr Pixbuf
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animation
    Pixbuf -> IO Pixbuf
forall (m :: * -> *) a. Monad m => a -> m a
return Pixbuf
result'

#if defined(ENABLE_OVERLOADING)
data PixbufAnimationGetStaticImageMethodInfo
instance (signature ~ (m GdkPixbuf.Pixbuf.Pixbuf), MonadIO m, IsPixbufAnimation a) => O.MethodInfo PixbufAnimationGetStaticImageMethodInfo a signature where
    overloadedMethod = pixbufAnimationGetStaticImage

#endif

-- method PixbufAnimation::get_width
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animation"
--           , argType =
--               TInterface
--                 Name { namespace = "GdkPixbuf" , name = "PixbufAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An animation." , 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_pixbuf_animation_get_width" gdk_pixbuf_animation_get_width :: 
    Ptr PixbufAnimation ->                  -- animation : TInterface (Name {namespace = "GdkPixbuf", name = "PixbufAnimation"})
    IO Int32

-- | Queries the width of the bounding box of a pixbuf animation.
pixbufAnimationGetWidth ::
    (B.CallStack.HasCallStack, MonadIO m, IsPixbufAnimation a) =>
    a
    -- ^ /@animation@/: An animation.
    -> m Int32
    -- ^ __Returns:__ Width of the bounding box of the animation.
pixbufAnimationGetWidth :: a -> m Int32
pixbufAnimationGetWidth a
animation = 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 PixbufAnimation
animation' <- a -> IO (Ptr PixbufAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    Int32
result <- Ptr PixbufAnimation -> IO Int32
gdk_pixbuf_animation_get_width Ptr PixbufAnimation
animation'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animation
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data PixbufAnimationGetWidthMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsPixbufAnimation a) => O.MethodInfo PixbufAnimationGetWidthMethodInfo a signature where
    overloadedMethod = pixbufAnimationGetWidth

#endif

-- method PixbufAnimation::is_static_image
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animation"
--           , argType =
--               TInterface
--                 Name { namespace = "GdkPixbuf" , name = "PixbufAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkPixbufAnimation"
--                 , 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_pixbuf_animation_is_static_image" gdk_pixbuf_animation_is_static_image :: 
    Ptr PixbufAnimation ->                  -- animation : TInterface (Name {namespace = "GdkPixbuf", name = "PixbufAnimation"})
    IO CInt

-- | If you load a file with 'GI.GdkPixbuf.Objects.PixbufAnimation.pixbufAnimationNewFromFile' and it
-- turns out to be a plain, unanimated image, then this function will
-- return 'P.True'. Use 'GI.GdkPixbuf.Objects.PixbufAnimation.pixbufAnimationGetStaticImage' to retrieve
-- the image.
pixbufAnimationIsStaticImage ::
    (B.CallStack.HasCallStack, MonadIO m, IsPixbufAnimation a) =>
    a
    -- ^ /@animation@/: a t'GI.GdkPixbuf.Objects.PixbufAnimation.PixbufAnimation'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the \"animation\" was really just an image
pixbufAnimationIsStaticImage :: a -> m Bool
pixbufAnimationIsStaticImage a
animation = 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 PixbufAnimation
animation' <- a -> IO (Ptr PixbufAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    CInt
result <- Ptr PixbufAnimation -> IO CInt
gdk_pixbuf_animation_is_static_image Ptr PixbufAnimation
animation'
    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
animation
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PixbufAnimationIsStaticImageMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPixbufAnimation a) => O.MethodInfo PixbufAnimationIsStaticImageMethodInfo a signature where
    overloadedMethod = pixbufAnimationIsStaticImage

#endif

-- method PixbufAnimation::new_from_stream_async
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "InputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GInputStream from which to load the animation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GAsyncReadyCallback to call when the pixbuf is loaded"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to the callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_pixbuf_animation_new_from_stream_async" gdk_pixbuf_animation_new_from_stream_async :: 
    Ptr Gio.InputStream.InputStream ->      -- stream : TInterface (Name {namespace = "Gio", name = "InputStream"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Creates a new animation by asynchronously loading an image from an input stream.
-- 
-- For more details see 'GI.GdkPixbuf.Objects.Pixbuf.pixbufNewFromStream', which is the synchronous
-- version of this function.
-- 
-- When the operation is finished, /@callback@/ will be called in the main thread.
-- You can then call 'GI.GdkPixbuf.Objects.PixbufAnimation.pixbufAnimationNewFromStreamFinish' to get the
-- result of the operation.
-- 
-- /Since: 2.28/
pixbufAnimationNewFromStreamAsync ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.InputStream.IsInputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.InputStream.InputStream' from which to load the animation
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the pixbuf is loaded
    -> m ()
pixbufAnimationNewFromStreamAsync :: a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
pixbufAnimationNewFromStreamAsync a
stream Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 InputStream
stream' <- a -> IO (Ptr InputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr InputStream
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
gdk_pixbuf_animation_new_from_stream_async Ptr InputStream
stream' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif