{-# LINE 2 "./Graphics/UI/Gtk/Gdk/PixbufAnimation.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Pixbuf Animation
--
-- Author : Matthew Arsenault
--
-- Created: 14 November 2009
--
-- Copyright (C) 2009 Matthew Arsenault
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
module Graphics.UI.Gtk.Gdk.PixbufAnimation (
-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----'PixbufAnimation'
-- | +----'PixbufSimpleAnim'
-- @

-- * Types
  PixbufAnimation,
  PixbufAnimationClass,
  castToPixbufAnimation, gTypePixbufAnimation,
  toPixbufAnimation,

  PixbufAnimationIter,
  PixbufAnimationIterClass,
  castToPixbufAnimationIter, gTypePixbufAnimationIter,
  toPixbufAnimationIter,

  PixbufSimpleAnim,
  PixbufSimpleAnimClass,
  castToPixbufSimpleAnim, gTypePixbufSimpleAnim,
  toPixbufSimpleAnim,

-- * Constructors
  pixbufAnimationNewFromFile,

  pixbufSimpleAnimNew,


-- * Methods
  pixbufAnimationGetWidth,
  pixbufAnimationGetHeight,
  pixbufAnimationGetIter,
  pixbufAnimationIsStaticImage,
  pixbufAnimationGetStaticImage,
  pixbufAnimationIterAdvance,
  pixbufAnimationIterGetDelayTime,
  pixbufAnimationIterOnCurrentlyLoadingFrame,
  pixbufAnimationIterGetPixbuf,

  pixbufSimpleAnimAddFrame,



  pixbufSimpleAnimSetLoop,
  pixbufSimpleAnimGetLoop

  ) where

import Control.Monad (liftM)
import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GDateTime
import System.Glib.GObject
import Graphics.UI.Gtk.Types
{-# LINE 83 "./Graphics/UI/Gtk/Gdk/PixbufAnimation.chs" #-}
import System.Glib.GError (propagateGError)


{-# LINE 86 "./Graphics/UI/Gtk/Gdk/PixbufAnimation.chs" #-}


--CHECKME: Domain error doc, GFileError ???
-- | 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 'PixbufError' and
-- 'GFileError' domains.
--
-- Any of several error conditions may occur: 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.
--
-- * If an error occurs, the function will throw an exception that can
-- be caught using e.g. 'System.Glib.GError.catchGErrorJust' and one of the
-- error codes in 'PixbufError' or 'GFileError'
--
pixbufAnimationNewFromFile :: GlibFilePath fp
                           => fp -- ^ Name of file to load, in the GLib file name encoding
                           -> IO PixbufAnimation -- ^ A newly-created animation
pixbufAnimationNewFromFile :: forall fp. GlibFilePath fp => fp -> IO PixbufAnimation
pixbufAnimationNewFromFile fp
fname =
  (ForeignPtr PixbufAnimation -> PixbufAnimation,
 FinalizerPtr PixbufAnimation)
-> IO (Ptr PixbufAnimation) -> IO PixbufAnimation
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr PixbufAnimation -> PixbufAnimation,
 FinalizerPtr PixbufAnimation)
forall {a}.
(ForeignPtr PixbufAnimation -> PixbufAnimation, FinalizerPtr a)
mkPixbufAnimation (IO (Ptr PixbufAnimation) -> IO PixbufAnimation)
-> IO (Ptr PixbufAnimation) -> IO PixbufAnimation
forall a b. (a -> b) -> a -> b
$
  (Ptr (Ptr ()) -> IO (Ptr PixbufAnimation))
-> IO (Ptr PixbufAnimation)
forall a. (Ptr (Ptr ()) -> IO a) -> IO a
propagateGError ((Ptr (Ptr ()) -> IO (Ptr PixbufAnimation))
 -> IO (Ptr PixbufAnimation))
-> (Ptr (Ptr ()) -> IO (Ptr PixbufAnimation))
-> IO (Ptr PixbufAnimation)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
errPtrPtr ->
     fp
-> (CString -> IO (Ptr PixbufAnimation))
-> IO (Ptr PixbufAnimation)
forall a. fp -> (CString -> IO a) -> IO a
forall fp a. GlibFilePath fp => fp -> (CString -> IO a) -> IO a
withUTFFilePath fp
fname ((CString -> IO (Ptr PixbufAnimation)) -> IO (Ptr PixbufAnimation))
-> (CString -> IO (Ptr PixbufAnimation))
-> IO (Ptr PixbufAnimation)
forall a b. (a -> b) -> a -> b
$ \CString
strPtr ->



     CString -> Ptr (Ptr ()) -> IO (Ptr PixbufAnimation)
gdk_pixbuf_animation_new_from_file CString
strPtr Ptr (Ptr ())
errPtrPtr


-- | Queries the width of the bounding box of a pixbuf animation.
pixbufAnimationGetWidth :: PixbufAnimation -- ^ An animation.
                        -> IO Int -- ^ Width of the bounding box of the animation.
pixbufAnimationGetWidth :: PixbufAnimation -> IO Int
pixbufAnimationGetWidth PixbufAnimation
self = (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ (\(PixbufAnimation ForeignPtr PixbufAnimation
arg1) -> ForeignPtr PixbufAnimation
-> (Ptr PixbufAnimation -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PixbufAnimation
arg1 ((Ptr PixbufAnimation -> IO CInt) -> IO CInt)
-> (Ptr PixbufAnimation -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufAnimation
argPtr1 ->Ptr PixbufAnimation -> IO CInt
gdk_pixbuf_animation_get_width Ptr PixbufAnimation
argPtr1) PixbufAnimation
self

-- | Queries the height of the bounding box of a pixbuf animation.
pixbufAnimationGetHeight :: PixbufAnimation -- ^ An animation.
                         -> IO Int -- ^ Height of the bounding box of the animation.
pixbufAnimationGetHeight :: PixbufAnimation -> IO Int
pixbufAnimationGetHeight PixbufAnimation
self = (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ (\(PixbufAnimation ForeignPtr PixbufAnimation
arg1) -> ForeignPtr PixbufAnimation
-> (Ptr PixbufAnimation -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PixbufAnimation
arg1 ((Ptr PixbufAnimation -> IO CInt) -> IO CInt)
-> (Ptr PixbufAnimation -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufAnimation
argPtr1 ->Ptr PixbufAnimation -> IO CInt
gdk_pixbuf_animation_get_height Ptr PixbufAnimation
argPtr1) PixbufAnimation
self


-- | Get an iterator for displaying an animation. The iterator
-- provides the frames that should be displayed at a given time. The
-- start time would normally come from 'gGetCurrentTime', and marks
-- the beginning of animation playback. After creating an iterator,
-- you should immediately display the pixbuf returned by
-- 'pixbufAnimationIterGetPixbuf'. Then, you should install a
-- timeout (with 'timeoutAdd') or by some other mechanism ensure
-- that you'll update the image after
-- 'pixbufAnimationIterGetDelayTime' milliseconds. Each time the
-- image is updated, you should reinstall the timeout with the new,
-- possibly-changed delay time.
--
-- As a shortcut, if start_time is @Nothing@, the result of
-- 'gGetCurrentTime' will be used automatically.
--
-- To update the image (i.e. possibly change the result of
-- 'pixbufAnimationIterGetPixbuf' to a new frame of the animation),
-- call 'pixbufAnimationIterAdvance'.
--
-- If you're using 'PixbufLoader', in addition to updating the image
-- after the delay time, you should also update it whenever you
-- receive the area_updated signal and
-- 'pixbufAnimationIterOnCurrentlyLoadingFrame' returns @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 :: PixbufAnimation -- ^ a 'PixbufAnimation'
                       -> Maybe GTimeVal -- ^ time when the animation starts playing
                       -> IO PixbufAnimationIter -- ^ an iterator to move over the animation
pixbufAnimationGetIter :: PixbufAnimation -> Maybe GTimeVal -> IO PixbufAnimationIter
pixbufAnimationGetIter PixbufAnimation
self Maybe GTimeVal
tv = (GTimeVal
 -> (Ptr GTimeVal -> IO PixbufAnimationIter)
 -> IO PixbufAnimationIter)
-> Maybe GTimeVal
-> (Ptr GTimeVal -> IO PixbufAnimationIter)
-> IO PixbufAnimationIter
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith GTimeVal
-> (Ptr GTimeVal -> IO PixbufAnimationIter)
-> IO PixbufAnimationIter
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Maybe GTimeVal
tv ((Ptr GTimeVal -> IO PixbufAnimationIter)
 -> IO PixbufAnimationIter)
-> (Ptr GTimeVal -> IO PixbufAnimationIter)
-> IO PixbufAnimationIter
forall a b. (a -> b) -> a -> b
$ \Ptr GTimeVal
stPtr ->
                                 (ForeignPtr PixbufAnimationIter -> PixbufAnimationIter,
 FinalizerPtr PixbufAnimationIter)
-> IO (Ptr PixbufAnimationIter) -> IO PixbufAnimationIter
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr PixbufAnimationIter -> PixbufAnimationIter,
 FinalizerPtr PixbufAnimationIter)
forall {a}.
(ForeignPtr PixbufAnimationIter -> PixbufAnimationIter,
 FinalizerPtr a)
mkPixbufAnimationIter (IO (Ptr PixbufAnimationIter) -> IO PixbufAnimationIter)
-> IO (Ptr PixbufAnimationIter) -> IO PixbufAnimationIter
forall a b. (a -> b) -> a -> b
$
                                   (\(PixbufAnimation ForeignPtr PixbufAnimation
arg1) Ptr ()
arg2 -> ForeignPtr PixbufAnimation
-> (Ptr PixbufAnimation -> IO (Ptr PixbufAnimationIter))
-> IO (Ptr PixbufAnimationIter)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PixbufAnimation
arg1 ((Ptr PixbufAnimation -> IO (Ptr PixbufAnimationIter))
 -> IO (Ptr PixbufAnimationIter))
-> (Ptr PixbufAnimation -> IO (Ptr PixbufAnimationIter))
-> IO (Ptr PixbufAnimationIter)
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufAnimation
argPtr1 ->Ptr PixbufAnimation -> Ptr () -> IO (Ptr PixbufAnimationIter)
gdk_pixbuf_animation_get_iter Ptr PixbufAnimation
argPtr1 Ptr ()
arg2) PixbufAnimation
self (Ptr GTimeVal -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr GTimeVal
stPtr)



-- | If you load a file with 'pixbufAnimationNewFromFile' and it turns
-- out to be a plain, unanimated image, then this function will
-- return @True@. Use 'pixbufAnimationGetStaticImage' to retrieve
-- the image.
--
pixbufAnimationIsStaticImage :: PixbufAnimation
                             -> IO Bool -- ^ (!(0)) if the "animation" was really just an image
pixbufAnimationIsStaticImage :: PixbufAnimation -> IO Bool
pixbufAnimationIsStaticImage PixbufAnimation
self = (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$ (\(PixbufAnimation ForeignPtr PixbufAnimation
arg1) -> ForeignPtr PixbufAnimation
-> (Ptr PixbufAnimation -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PixbufAnimation
arg1 ((Ptr PixbufAnimation -> IO CInt) -> IO CInt)
-> (Ptr PixbufAnimation -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufAnimation
argPtr1 ->Ptr PixbufAnimation -> IO CInt
gdk_pixbuf_animation_is_static_image Ptr PixbufAnimation
argPtr1) PixbufAnimation
self


-- | 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 @Nothing@.
--
pixbufAnimationGetStaticImage :: PixbufAnimation
                              -> IO (Maybe Pixbuf) -- ^ unanimated image representing the animation
pixbufAnimationGetStaticImage :: PixbufAnimation -> IO (Maybe Pixbuf)
pixbufAnimationGetStaticImage PixbufAnimation
self =
  (IO (Ptr Pixbuf) -> IO Pixbuf)
-> IO (Ptr Pixbuf) -> IO (Maybe Pixbuf)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
-> IO (Ptr Pixbuf) -> IO Pixbuf
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
forall {a}. (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr a)
mkPixbuf) (IO (Ptr Pixbuf) -> IO (Maybe Pixbuf))
-> IO (Ptr Pixbuf) -> IO (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ (\(PixbufAnimation ForeignPtr PixbufAnimation
arg1) -> ForeignPtr PixbufAnimation
-> (Ptr PixbufAnimation -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PixbufAnimation
arg1 ((Ptr PixbufAnimation -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr PixbufAnimation -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufAnimation
argPtr1 ->Ptr PixbufAnimation -> IO (Ptr Pixbuf)
gdk_pixbuf_animation_get_static_image Ptr PixbufAnimation
argPtr1) PixbufAnimation
self



-- | Possibly advances an animation to a new frame. Chooses the frame
-- based on the start time passed to 'pixbufAnimationGetIter'.
--
-- current_time would normally come from 'gGetCurrentTime', and must
-- be greater than or equal to the time passed to
-- 'pixbufAnimationGetIter', and must increase or remain unchanged
-- each time 'pixbufAnimationIterGetPixbuf' is called. That is, you
-- can't go backward in time; animations only play forward.
--
-- As a shortcut, pass @Nothing@ for the current time and
-- 'gGetCurrentTime' will be invoked on your behalf. So you only need
-- to explicitly pass current_time if you're doing something odd like
-- playing the animation at double speed.
--
-- If this function returns @False@, there's no need to update the
-- animation display, assuming the display had been rendered prior to
-- advancing; if @True@, you need to call 'animationIterGetPixbuf' and
-- update the display with the new pixbuf.
--
pixbufAnimationIterAdvance :: PixbufAnimationIter -- ^ A 'PixbufAnimationIter'
                           -> Maybe GTimeVal -- ^ current time
                           -> IO Bool -- ^ @True@ if the image may need updating
pixbufAnimationIterAdvance :: PixbufAnimationIter -> Maybe GTimeVal -> IO Bool
pixbufAnimationIterAdvance PixbufAnimationIter
iter Maybe GTimeVal
currentTime = (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$ (GTimeVal -> (Ptr GTimeVal -> IO CInt) -> IO CInt)
-> Maybe GTimeVal -> (Ptr GTimeVal -> IO CInt) -> IO CInt
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith GTimeVal -> (Ptr GTimeVal -> IO CInt) -> IO CInt
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Maybe GTimeVal
currentTime ((Ptr GTimeVal -> IO CInt) -> IO CInt)
-> (Ptr GTimeVal -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr GTimeVal
tvPtr ->
                                                (\(PixbufAnimationIter ForeignPtr PixbufAnimationIter
arg1) Ptr ()
arg2 -> ForeignPtr PixbufAnimationIter
-> (Ptr PixbufAnimationIter -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PixbufAnimationIter
arg1 ((Ptr PixbufAnimationIter -> IO CInt) -> IO CInt)
-> (Ptr PixbufAnimationIter -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufAnimationIter
argPtr1 ->Ptr PixbufAnimationIter -> Ptr () -> IO CInt
gdk_pixbuf_animation_iter_advance Ptr PixbufAnimationIter
argPtr1 Ptr ()
arg2) PixbufAnimationIter
iter (Ptr GTimeVal -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr GTimeVal
tvPtr)


-- | Gets the number of milliseconds the current pixbuf should be
-- displayed, or -1 if the current pixbuf should be displayed
-- forever. 'timeoutAdd' conveniently takes a timeout in
-- milliseconds, so you can use a timeout to schedule the next
-- update.
--
pixbufAnimationIterGetDelayTime :: PixbufAnimationIter -- ^ an animation iterator
                                -> IO Int -- ^ delay time in milliseconds (thousandths of a second)
pixbufAnimationIterGetDelayTime :: PixbufAnimationIter -> IO Int
pixbufAnimationIterGetDelayTime PixbufAnimationIter
self = (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$
  (\(PixbufAnimationIter ForeignPtr PixbufAnimationIter
arg1) -> ForeignPtr PixbufAnimationIter
-> (Ptr PixbufAnimationIter -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PixbufAnimationIter
arg1 ((Ptr PixbufAnimationIter -> IO CInt) -> IO CInt)
-> (Ptr PixbufAnimationIter -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufAnimationIter
argPtr1 ->Ptr PixbufAnimationIter -> IO CInt
gdk_pixbuf_animation_iter_get_delay_time Ptr PixbufAnimationIter
argPtr1) PixbufAnimationIter
self


-- | Used to determine how to respond to the area_updated signal on
-- 'PixbufLoader' when loading an animation. area_updated is emitted
-- for an area of the frame currently streaming in to the loader. So
-- if you're on the currently loading frame, you need to redraw the
-- screen for the updated area.
--
pixbufAnimationIterOnCurrentlyLoadingFrame :: PixbufAnimationIter
                                           -> IO Bool -- ^ @True@ if the frame we're on is partially loaded, or the last frame
pixbufAnimationIterOnCurrentlyLoadingFrame :: PixbufAnimationIter -> IO Bool
pixbufAnimationIterOnCurrentlyLoadingFrame PixbufAnimationIter
iter = (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
  (\(PixbufAnimationIter ForeignPtr PixbufAnimationIter
arg1) -> ForeignPtr PixbufAnimationIter
-> (Ptr PixbufAnimationIter -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PixbufAnimationIter
arg1 ((Ptr PixbufAnimationIter -> IO CInt) -> IO CInt)
-> (Ptr PixbufAnimationIter -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufAnimationIter
argPtr1 ->Ptr PixbufAnimationIter -> IO CInt
gdk_pixbuf_animation_iter_on_currently_loading_frame Ptr PixbufAnimationIter
argPtr1) PixbufAnimationIter
iter

--CHECKME: referencing, usage of constructNewGObject
-- | Gets the current pixbuf which should be displayed; the pixbuf will
-- be the same size as the animation itself
-- ('pixbufAnimationGetWidth', 'pixbufAnimationGetHeight'). This
-- pixbuf should be displayed for 'pixbufAnimationIterGetDelayTime'
-- milliseconds. The caller of this function does not own a reference
-- to the returned pixbuf; the returned pixbuf will become invalid
-- when the iterator advances to the next frame, which may happen
-- anytime you call 'pixbufAnimationIterAdvance'. Copy the pixbuf to
-- keep it (don't just add a reference), as it may get recycled as you
-- advance the iterator.
--
pixbufAnimationIterGetPixbuf :: PixbufAnimationIter -- ^ an animation iterator
                                -> IO Pixbuf -- ^ the pixbuf to be displayed
pixbufAnimationIterGetPixbuf :: PixbufAnimationIter -> IO Pixbuf
pixbufAnimationIterGetPixbuf PixbufAnimationIter
iter = (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
-> IO (Ptr Pixbuf) -> IO Pixbuf
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
forall {a}. (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr a)
mkPixbuf (IO (Ptr Pixbuf) -> IO Pixbuf) -> IO (Ptr Pixbuf) -> IO Pixbuf
forall a b. (a -> b) -> a -> b
$
   (\(PixbufAnimationIter ForeignPtr PixbufAnimationIter
arg1) -> ForeignPtr PixbufAnimationIter
-> (Ptr PixbufAnimationIter -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PixbufAnimationIter
arg1 ((Ptr PixbufAnimationIter -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr PixbufAnimationIter -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufAnimationIter
argPtr1 ->Ptr PixbufAnimationIter -> IO (Ptr Pixbuf)
gdk_pixbuf_animation_iter_get_pixbuf Ptr PixbufAnimationIter
argPtr1) PixbufAnimationIter
iter



-- | Creates a new, empty animation.
--
-- * Available since Gtk+ version 2.8
--
pixbufSimpleAnimNew :: Int -- ^ the width of the animation
                    -> Int -- ^ the height of the animation
                    -> Float -- ^ the speed of the animation, in frames per second
                    -> IO PixbufSimpleAnim -- ^ a newly allocated 'PixbufSimpleAnim'
pixbufSimpleAnimNew :: Int -> Int -> Float -> IO PixbufSimpleAnim
pixbufSimpleAnimNew Int
width Int
height Float
rate = (ForeignPtr PixbufSimpleAnim -> PixbufSimpleAnim,
 FinalizerPtr PixbufSimpleAnim)
-> IO (Ptr PixbufSimpleAnim) -> IO PixbufSimpleAnim
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr PixbufSimpleAnim -> PixbufSimpleAnim,
 FinalizerPtr PixbufSimpleAnim)
forall {a}.
(ForeignPtr PixbufSimpleAnim -> PixbufSimpleAnim, FinalizerPtr a)
mkPixbufSimpleAnim (IO (Ptr PixbufSimpleAnim) -> IO PixbufSimpleAnim)
-> IO (Ptr PixbufSimpleAnim) -> IO PixbufSimpleAnim
forall a b. (a -> b) -> a -> b
$
  CInt -> CInt -> CFloat -> IO (Ptr PixbufSimpleAnim)
gdk_pixbuf_simple_anim_new (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
rate)


-- | Adds a new frame to animation. The pixbuf must have the
-- dimensions specified when the animation was constructed.
--
-- * Available since Gtk+ version 2.8
--
pixbufSimpleAnimAddFrame :: PixbufSimpleAnim -- ^ a 'PixbufSimpleAnim'
                         -> Pixbuf -- ^ the pixbuf to add
                         -> IO ()
pixbufSimpleAnimAddFrame :: PixbufSimpleAnim -> Pixbuf -> IO ()
pixbufSimpleAnimAddFrame PixbufSimpleAnim
psa Pixbuf
pb = (\(PixbufSimpleAnim ForeignPtr PixbufSimpleAnim
arg1) (Pixbuf ForeignPtr Pixbuf
arg2) -> ForeignPtr PixbufSimpleAnim
-> (Ptr PixbufSimpleAnim -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PixbufSimpleAnim
arg1 ((Ptr PixbufSimpleAnim -> IO ()) -> IO ())
-> (Ptr PixbufSimpleAnim -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufSimpleAnim
argPtr1 ->ForeignPtr Pixbuf -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg2 ((Ptr Pixbuf -> IO ()) -> IO ()) -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr2 ->Ptr PixbufSimpleAnim -> Ptr Pixbuf -> IO ()
gdk_pixbuf_simple_anim_add_frame Ptr PixbufSimpleAnim
argPtr1 Ptr Pixbuf
argPtr2) PixbufSimpleAnim
psa Pixbuf
pb





-- | Sets whether animation should loop indefinitely when it reaches
-- the end.
--
-- * Available since Gtk+ version 2.18
--
pixbufSimpleAnimSetLoop :: PixbufSimpleAnim -- ^ a 'PixbufSimpleAnim'
                           -> Bool -- ^ whether to loop the animation
                           -> IO ()
pixbufSimpleAnimSetLoop :: PixbufSimpleAnim -> Bool -> IO ()
pixbufSimpleAnimSetLoop PixbufSimpleAnim
animation Bool
loop = (\(PixbufSimpleAnim ForeignPtr PixbufSimpleAnim
arg1) CInt
arg2 -> ForeignPtr PixbufSimpleAnim
-> (Ptr PixbufSimpleAnim -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PixbufSimpleAnim
arg1 ((Ptr PixbufSimpleAnim -> IO ()) -> IO ())
-> (Ptr PixbufSimpleAnim -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufSimpleAnim
argPtr1 ->Ptr PixbufSimpleAnim -> CInt -> IO ()
gdk_pixbuf_simple_anim_set_loop Ptr PixbufSimpleAnim
argPtr1 CInt
arg2) PixbufSimpleAnim
animation (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
loop)


-- | Gets whether animation should loop indefinitely when it reaches
-- the end.
--
-- * Available since Gtk+ version 2.18
--
pixbufSimpleAnimGetLoop :: PixbufSimpleAnim -- ^ a 'PixbufSimpleAnim'
                           -> IO Bool -- ^ @True@ if the animation loops forever, @False@ otherwise
pixbufSimpleAnimGetLoop :: PixbufSimpleAnim -> IO Bool
pixbufSimpleAnimGetLoop PixbufSimpleAnim
animation = (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$ (\(PixbufSimpleAnim ForeignPtr PixbufSimpleAnim
arg1) -> ForeignPtr PixbufSimpleAnim
-> (Ptr PixbufSimpleAnim -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PixbufSimpleAnim
arg1 ((Ptr PixbufSimpleAnim -> IO CInt) -> IO CInt)
-> (Ptr PixbufSimpleAnim -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufSimpleAnim
argPtr1 ->Ptr PixbufSimpleAnim -> IO CInt
gdk_pixbuf_simple_anim_get_loop Ptr PixbufSimpleAnim
argPtr1) PixbufSimpleAnim
animation

foreign import ccall unsafe "gdk_pixbuf_animation_new_from_file"
  gdk_pixbuf_animation_new_from_file :: ((Ptr CChar) -> ((Ptr (Ptr ())) -> (IO (Ptr PixbufAnimation))))

foreign import ccall unsafe "gdk_pixbuf_animation_get_width"
  gdk_pixbuf_animation_get_width :: ((Ptr PixbufAnimation) -> (IO CInt))

foreign import ccall unsafe "gdk_pixbuf_animation_get_height"
  gdk_pixbuf_animation_get_height :: ((Ptr PixbufAnimation) -> (IO CInt))

foreign import ccall unsafe "gdk_pixbuf_animation_get_iter"
  gdk_pixbuf_animation_get_iter :: ((Ptr PixbufAnimation) -> ((Ptr ()) -> (IO (Ptr PixbufAnimationIter))))

foreign import ccall unsafe "gdk_pixbuf_animation_is_static_image"
  gdk_pixbuf_animation_is_static_image :: ((Ptr PixbufAnimation) -> (IO CInt))

foreign import ccall unsafe "gdk_pixbuf_animation_get_static_image"
  gdk_pixbuf_animation_get_static_image :: ((Ptr PixbufAnimation) -> (IO (Ptr Pixbuf)))

foreign import ccall unsafe "gdk_pixbuf_animation_iter_advance"
  gdk_pixbuf_animation_iter_advance :: ((Ptr PixbufAnimationIter) -> ((Ptr ()) -> (IO CInt)))

foreign import ccall unsafe "gdk_pixbuf_animation_iter_get_delay_time"
  gdk_pixbuf_animation_iter_get_delay_time :: ((Ptr PixbufAnimationIter) -> (IO CInt))

foreign import ccall unsafe "gdk_pixbuf_animation_iter_on_currently_loading_frame"
  gdk_pixbuf_animation_iter_on_currently_loading_frame :: ((Ptr PixbufAnimationIter) -> (IO CInt))

foreign import ccall unsafe "gdk_pixbuf_animation_iter_get_pixbuf"
  gdk_pixbuf_animation_iter_get_pixbuf :: ((Ptr PixbufAnimationIter) -> (IO (Ptr Pixbuf)))

foreign import ccall unsafe "gdk_pixbuf_simple_anim_new"
  gdk_pixbuf_simple_anim_new :: (CInt -> (CInt -> (CFloat -> (IO (Ptr PixbufSimpleAnim)))))

foreign import ccall unsafe "gdk_pixbuf_simple_anim_add_frame"
  gdk_pixbuf_simple_anim_add_frame :: ((Ptr PixbufSimpleAnim) -> ((Ptr Pixbuf) -> (IO ())))

foreign import ccall unsafe "gdk_pixbuf_simple_anim_set_loop"
  gdk_pixbuf_simple_anim_set_loop :: ((Ptr PixbufSimpleAnim) -> (CInt -> (IO ())))

foreign import ccall unsafe "gdk_pixbuf_simple_anim_get_loop"
  gdk_pixbuf_simple_anim_get_loop :: ((Ptr PixbufSimpleAnim) -> (IO CInt))