{-# LINE 2 "./Graphics/UI/Gtk/ImageView/AnimView.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget AnimView
--
-- Author : Andy Stewart
--
-- Created: 19 Aug 2010
--
-- Copyright (C) 2010 Andy Stewart
--
-- 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.ImageView.AnimView (
-- * Details
-- | 'AnimView' subclasses 'ImageView'. It has the same look and feel as its parent but is also capable
-- of displaying GIF animations.

-- * Tyeps
   AnimView,
   AnimViewClass,

-- * Methods
   animViewNew,
   animViewGetAnim,
   animViewSetAnim,
   animViewSetIsPlaying,
   animViewGetIsPlaying,
   animViewStep,

-- * Signals
   step,
   toggleRunning,
) where

import Control.Monad (liftM)
import Data.Maybe (fromMaybe)

import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.ImageView.Enums
import System.Glib.Attributes
import System.Glib.FFI
import System.Glib.UTFString

import Graphics.UI.Gtk.ImageView.Signals
{-# LINE 58 "./Graphics/UI/Gtk/ImageView/AnimView.chs" #-}
import Graphics.UI.Gtk.ImageView.Types
{-# LINE 59 "./Graphics/UI/Gtk/ImageView/AnimView.chs" #-}
import System.Glib.Properties
{-# LINE 60 "./Graphics/UI/Gtk/ImageView/AnimView.chs" #-}


{-# LINE 62 "./Graphics/UI/Gtk/ImageView/AnimView.chs" #-}

-- | Creates a new 'AnimView' with default values. The default values are:
--
-- * anim : 'Nothing'
-- * @isPlaying@ : 'False'
animViewNew =
  makeNewObject mkAnimView $
  liftM (castPtr :: Ptr Widget -> Ptr AnimView) $
  gtk_anim_view_new
{-# LINE 71 "./Graphics/UI/Gtk/ImageView/AnimView.chs" #-}

-- | Returns the current animation of the view.
animViewGetAnim :: AnimViewClass view => view
                -> IO PixbufAnimation -- ^ returns the current animation
animViewGetAnim view =
  wrapNewGObject mkPixbufAnimation $
  (\(AnimView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_anim_view_get_anim argPtr1)
{-# LINE 78 "./Graphics/UI/Gtk/ImageView/AnimView.chs" #-}
    (toAnimView view)

-- | Sets the pixbuf animation to play, or 'Nothing' to not play any animation.
--
-- If the animation is a static image or only has one frame, then the static image will be displayed
-- instead. If more frames are loaded into the animation, then 'AnimView' will automatically animate
-- to those frames.
--
-- The effect of this method is analoguous to 'imageViewSetPixbuf'. Fit mode is reset to
-- 'FitSizeIfLarger' so that the whole area of the animation fits in the view. Three signals are
-- emitted, first the 'ImageView' will emit 'zoomChanged' and then 'pixbufChanged', second,
-- 'AnimView' itself will emit 'animChanged'.
--
-- The default pixbuf animation is 'Nothing'.
animViewSetAnim :: AnimViewClass view => view
                -> Maybe PixbufAnimation -- ^ @anim@ A pixbuf animation to play.
                -> IO ()
animViewSetAnim view anim =
    (\(AnimView arg1) (PixbufAnimation arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_anim_view_set_anim argPtr1 argPtr2)
{-# LINE 97 "./Graphics/UI/Gtk/ImageView/AnimView.chs" #-}
      (toAnimView view)
      (fromMaybe (PixbufAnimation nullForeignPtr) anim)

-- | Sets whether the animation should play or not. If there is no current animation this method does not
-- have any effect.
animViewSetIsPlaying :: AnimViewClass view => view
                     -> Bool -- ^ @playing@ 'True' to play the animation, 'False' otherwise
                     -> IO ()
animViewSetIsPlaying view playing =
  (\(AnimView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_anim_view_set_is_playing argPtr1 arg2)
{-# LINE 107 "./Graphics/UI/Gtk/ImageView/AnimView.chs" #-}
    (toAnimView view)
    (fromBool playing)

-- | Returns whether the animation is playing or not. If there is no current animation, this method will
-- always returns 'False'.
animViewGetIsPlaying :: AnimViewClass view => view
                     -> IO Bool -- ^ returns 'True' if an animation is playing, 'False' otherwise.
animViewGetIsPlaying view =
  liftM toBool $
  (\(AnimView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_anim_view_get_is_playing argPtr1)
{-# LINE 117 "./Graphics/UI/Gtk/ImageView/AnimView.chs" #-}
      (toAnimView view)

-- | Steps the animation one frame forward. If the animation is playing it will be stopped. Will it wrap
-- around if the animation is at its last frame?
animViewStep :: AnimViewClass view => view -> IO ()
animViewStep view =
  (\(AnimView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_anim_view_step argPtr1)
{-# LINE 124 "./Graphics/UI/Gtk/ImageView/AnimView.chs" #-}
      (toAnimView view)

-- | Steps the animation one frame forward. If the animation is playing it will first be stopped. 'step'
-- is a keybinding signal emitted when GDK_j is pressed on the widget and should not be used by clients
-- of this library.
step :: AnimViewClass view => Signal view (IO ())
step = Signal (connect_NONE__NONE "step")

-- | Stops the animation if it was playing or resumes it, if it was playing. 'toggleRunning' is a
-- keybinding signal emitted when GDK_p is pressed on the widget and should not be used by clients of
-- this library.
toggleRunning :: AnimViewClass view => Signal view (IO ())
toggleRunning = Signal (connect_NONE__NONE "toggle-running")

foreign import ccall unsafe "gtk_anim_view_new"
  gtk_anim_view_new :: (IO (Ptr Widget))

foreign import ccall safe "gtk_anim_view_get_anim"
  gtk_anim_view_get_anim :: ((Ptr AnimView) -> (IO (Ptr PixbufAnimation)))

foreign import ccall safe "gtk_anim_view_set_anim"
  gtk_anim_view_set_anim :: ((Ptr AnimView) -> ((Ptr PixbufAnimation) -> (IO ())))

foreign import ccall safe "gtk_anim_view_set_is_playing"
  gtk_anim_view_set_is_playing :: ((Ptr AnimView) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_anim_view_get_is_playing"
  gtk_anim_view_get_is_playing :: ((Ptr AnimView) -> (IO CInt))

foreign import ccall safe "gtk_anim_view_step"
  gtk_anim_view_step :: ((Ptr AnimView) -> (IO ()))