{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Clutter.Objects.Animation.Animation' structure contains only private data and should
-- be accessed using the provided functions.
-- 
-- /Since: 1.0/

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

module GI.Clutter.Objects.Animation
    ( 

-- * Exported types
    Animation(..)                           ,
    IsAnimation                             ,
    toAnimation                             ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bind]("GI.Clutter.Objects.Animation#g:method:bind"), [bindInterval]("GI.Clutter.Objects.Animation#g:method:bindInterval"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [completed]("GI.Clutter.Objects.Animation#g:method:completed"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasProperty]("GI.Clutter.Objects.Animation#g:method:hasProperty"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [parseCustomNode]("GI.Clutter.Interfaces.Scriptable#g:method:parseCustomNode"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unbindProperty]("GI.Clutter.Objects.Animation#g:method:unbindProperty"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [update]("GI.Clutter.Objects.Animation#g:method:update"), [updateInterval]("GI.Clutter.Objects.Animation#g:method:updateInterval"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAlpha]("GI.Clutter.Objects.Animation#g:method:getAlpha"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDuration]("GI.Clutter.Objects.Animation#g:method:getDuration"), [getId]("GI.Clutter.Interfaces.Scriptable#g:method:getId"), [getInterval]("GI.Clutter.Objects.Animation#g:method:getInterval"), [getLoop]("GI.Clutter.Objects.Animation#g:method:getLoop"), [getMode]("GI.Clutter.Objects.Animation#g:method:getMode"), [getObject]("GI.Clutter.Objects.Animation#g:method:getObject"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getTimeline]("GI.Clutter.Objects.Animation#g:method:getTimeline").
-- 
-- ==== Setters
-- [setAlpha]("GI.Clutter.Objects.Animation#g:method:setAlpha"), [setCustomProperty]("GI.Clutter.Interfaces.Scriptable#g:method:setCustomProperty"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDuration]("GI.Clutter.Objects.Animation#g:method:setDuration"), [setId]("GI.Clutter.Interfaces.Scriptable#g:method:setId"), [setLoop]("GI.Clutter.Objects.Animation#g:method:setLoop"), [setMode]("GI.Clutter.Objects.Animation#g:method:setMode"), [setObject]("GI.Clutter.Objects.Animation#g:method:setObject"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setTimeline]("GI.Clutter.Objects.Animation#g:method:setTimeline").

#if defined(ENABLE_OVERLOADING)
    ResolveAnimationMethod                  ,
#endif

-- ** bind #method:bind#

#if defined(ENABLE_OVERLOADING)
    AnimationBindMethodInfo                 ,
#endif
    animationBind                           ,


-- ** bindInterval #method:bindInterval#

#if defined(ENABLE_OVERLOADING)
    AnimationBindIntervalMethodInfo         ,
#endif
    animationBindInterval                   ,


-- ** completed #method:completed#

#if defined(ENABLE_OVERLOADING)
    AnimationCompletedMethodInfo            ,
#endif
    animationCompleted                      ,


-- ** getAlpha #method:getAlpha#

#if defined(ENABLE_OVERLOADING)
    AnimationGetAlphaMethodInfo             ,
#endif
    animationGetAlpha                       ,


-- ** getDuration #method:getDuration#

#if defined(ENABLE_OVERLOADING)
    AnimationGetDurationMethodInfo          ,
#endif
    animationGetDuration                    ,


-- ** getInterval #method:getInterval#

#if defined(ENABLE_OVERLOADING)
    AnimationGetIntervalMethodInfo          ,
#endif
    animationGetInterval                    ,


-- ** getLoop #method:getLoop#

#if defined(ENABLE_OVERLOADING)
    AnimationGetLoopMethodInfo              ,
#endif
    animationGetLoop                        ,


-- ** getMode #method:getMode#

#if defined(ENABLE_OVERLOADING)
    AnimationGetModeMethodInfo              ,
#endif
    animationGetMode                        ,


-- ** getObject #method:getObject#

#if defined(ENABLE_OVERLOADING)
    AnimationGetObjectMethodInfo            ,
#endif
    animationGetObject                      ,


-- ** getTimeline #method:getTimeline#

#if defined(ENABLE_OVERLOADING)
    AnimationGetTimelineMethodInfo          ,
#endif
    animationGetTimeline                    ,


-- ** hasProperty #method:hasProperty#

#if defined(ENABLE_OVERLOADING)
    AnimationHasPropertyMethodInfo          ,
#endif
    animationHasProperty                    ,


-- ** new #method:new#

    animationNew                            ,


-- ** setAlpha #method:setAlpha#

#if defined(ENABLE_OVERLOADING)
    AnimationSetAlphaMethodInfo             ,
#endif
    animationSetAlpha                       ,


-- ** setDuration #method:setDuration#

#if defined(ENABLE_OVERLOADING)
    AnimationSetDurationMethodInfo          ,
#endif
    animationSetDuration                    ,


-- ** setLoop #method:setLoop#

#if defined(ENABLE_OVERLOADING)
    AnimationSetLoopMethodInfo              ,
#endif
    animationSetLoop                        ,


-- ** setMode #method:setMode#

#if defined(ENABLE_OVERLOADING)
    AnimationSetModeMethodInfo              ,
#endif
    animationSetMode                        ,


-- ** setObject #method:setObject#

#if defined(ENABLE_OVERLOADING)
    AnimationSetObjectMethodInfo            ,
#endif
    animationSetObject                      ,


-- ** setTimeline #method:setTimeline#

#if defined(ENABLE_OVERLOADING)
    AnimationSetTimelineMethodInfo          ,
#endif
    animationSetTimeline                    ,


-- ** unbindProperty #method:unbindProperty#

#if defined(ENABLE_OVERLOADING)
    AnimationUnbindPropertyMethodInfo       ,
#endif
    animationUnbindProperty                 ,


-- ** update #method:update#

#if defined(ENABLE_OVERLOADING)
    AnimationUpdateMethodInfo               ,
#endif
    animationUpdate                         ,


-- ** updateInterval #method:updateInterval#

#if defined(ENABLE_OVERLOADING)
    AnimationUpdateIntervalMethodInfo       ,
#endif
    animationUpdateInterval                 ,




 -- * Properties


-- ** alpha #attr:alpha#
-- | The t'GI.Clutter.Objects.Alpha.Alpha' used by the animation.
-- 
-- /Since: 1.0/

#if defined(ENABLE_OVERLOADING)
    AnimationAlphaPropertyInfo              ,
#endif
#if defined(ENABLE_OVERLOADING)
    animationAlpha                          ,
#endif
    constructAnimationAlpha                 ,
    getAnimationAlpha                       ,
    setAnimationAlpha                       ,


-- ** duration #attr:duration#
-- | The duration of the animation, expressed in milliseconds.
-- 
-- /Since: 1.0/

#if defined(ENABLE_OVERLOADING)
    AnimationDurationPropertyInfo           ,
#endif
#if defined(ENABLE_OVERLOADING)
    animationDuration                       ,
#endif
    constructAnimationDuration              ,
    getAnimationDuration                    ,
    setAnimationDuration                    ,


-- ** loop #attr:loop#
-- | Whether the animation should loop.
-- 
-- /Since: 1.0/

#if defined(ENABLE_OVERLOADING)
    AnimationLoopPropertyInfo               ,
#endif
#if defined(ENABLE_OVERLOADING)
    animationLoop                           ,
#endif
    constructAnimationLoop                  ,
    getAnimationLoop                        ,
    setAnimationLoop                        ,


-- ** mode #attr:mode#
-- | The animation mode, either a value from t'GI.Clutter.Enums.AnimationMode'
-- or a value returned by @/clutter_alpha_register_func()/@. The
-- default value is 'GI.Clutter.Enums.AnimationModeLinear'.
-- 
-- /Since: 1.0/

#if defined(ENABLE_OVERLOADING)
    AnimationModePropertyInfo               ,
#endif
#if defined(ENABLE_OVERLOADING)
    animationMode                           ,
#endif
    constructAnimationMode                  ,
    getAnimationMode                        ,
    setAnimationMode                        ,


-- ** object #attr:object#
-- | The t'GI.GObject.Objects.Object.Object' to which the animation applies.
-- 
-- /Since: 1.0/

#if defined(ENABLE_OVERLOADING)
    AnimationObjectPropertyInfo             ,
#endif
#if defined(ENABLE_OVERLOADING)
    animationObject                         ,
#endif
    constructAnimationObject                ,
    getAnimationObject                      ,
    setAnimationObject                      ,


-- ** timeline #attr:timeline#
-- | The t'GI.Clutter.Objects.Timeline.Timeline' used by the animation.
-- 
-- /Since: 1.0/

#if defined(ENABLE_OVERLOADING)
    AnimationTimelinePropertyInfo           ,
#endif
#if defined(ENABLE_OVERLOADING)
    animationTimeline                       ,
#endif
    clearAnimationTimeline                  ,
    constructAnimationTimeline              ,
    getAnimationTimeline                    ,
    setAnimationTimeline                    ,




 -- * Signals


-- ** completed #signal:completed#

    AnimationCompletedCallback              ,
#if defined(ENABLE_OVERLOADING)
    AnimationCompletedSignalInfo            ,
#endif
    afterAnimationCompleted                 ,
    onAnimationCompleted                    ,


-- ** started #signal:started#

    AnimationStartedCallback                ,
#if defined(ENABLE_OVERLOADING)
    AnimationStartedSignalInfo              ,
#endif
    afterAnimationStarted                   ,
    onAnimationStarted                      ,




    ) 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.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 {-# SOURCE #-} qualified GI.Clutter.Interfaces.Scriptable as Clutter.Scriptable
import {-# SOURCE #-} qualified GI.Clutter.Objects.Alpha as Clutter.Alpha
import {-# SOURCE #-} qualified GI.Clutter.Objects.Interval as Clutter.Interval
import {-# SOURCE #-} qualified GI.Clutter.Objects.Timeline as Clutter.Timeline
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "clutter_animation_get_type"
    c_clutter_animation_get_type :: IO B.Types.GType

instance B.Types.TypedObject Animation where
    glibType :: IO GType
glibType = IO GType
c_clutter_animation_get_type

instance B.Types.GObject Animation

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

instance O.HasParentTypes Animation
type instance O.ParentTypes Animation = '[GObject.Object.Object, Clutter.Scriptable.Scriptable]

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

-- | Convert 'Animation' 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 Animation) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_clutter_animation_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Animation -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Animation
P.Nothing = Ptr GValue -> Ptr Animation -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Animation
forall a. Ptr a
FP.nullPtr :: FP.Ptr Animation)
    gvalueSet_ Ptr GValue
gv (P.Just Animation
obj) = Animation -> (Ptr Animation -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Animation
obj (Ptr GValue -> Ptr Animation -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Animation)
gvalueGet_ Ptr GValue
gv = do
        Ptr Animation
ptr <- Ptr GValue -> IO (Ptr Animation)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Animation)
        if Ptr Animation
ptr Ptr Animation -> Ptr Animation -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Animation
forall a. Ptr a
FP.nullPtr
        then Animation -> Maybe Animation
forall a. a -> Maybe a
P.Just (Animation -> Maybe Animation)
-> IO Animation -> IO (Maybe Animation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Animation -> Animation)
-> Ptr Animation -> IO Animation
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Animation -> Animation
Animation Ptr Animation
ptr
        else Maybe Animation -> IO (Maybe Animation)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Animation
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveAnimationMethod (t :: Symbol) (o :: *) :: * where
    ResolveAnimationMethod "bind" o = AnimationBindMethodInfo
    ResolveAnimationMethod "bindInterval" o = AnimationBindIntervalMethodInfo
    ResolveAnimationMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAnimationMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAnimationMethod "completed" o = AnimationCompletedMethodInfo
    ResolveAnimationMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAnimationMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAnimationMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAnimationMethod "hasProperty" o = AnimationHasPropertyMethodInfo
    ResolveAnimationMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAnimationMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAnimationMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAnimationMethod "parseCustomNode" o = Clutter.Scriptable.ScriptableParseCustomNodeMethodInfo
    ResolveAnimationMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveAnimationMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAnimationMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAnimationMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAnimationMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAnimationMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAnimationMethod "unbindProperty" o = AnimationUnbindPropertyMethodInfo
    ResolveAnimationMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveAnimationMethod "update" o = AnimationUpdateMethodInfo
    ResolveAnimationMethod "updateInterval" o = AnimationUpdateIntervalMethodInfo
    ResolveAnimationMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAnimationMethod "getAlpha" o = AnimationGetAlphaMethodInfo
    ResolveAnimationMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAnimationMethod "getDuration" o = AnimationGetDurationMethodInfo
    ResolveAnimationMethod "getId" o = Clutter.Scriptable.ScriptableGetIdMethodInfo
    ResolveAnimationMethod "getInterval" o = AnimationGetIntervalMethodInfo
    ResolveAnimationMethod "getLoop" o = AnimationGetLoopMethodInfo
    ResolveAnimationMethod "getMode" o = AnimationGetModeMethodInfo
    ResolveAnimationMethod "getObject" o = AnimationGetObjectMethodInfo
    ResolveAnimationMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAnimationMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAnimationMethod "getTimeline" o = AnimationGetTimelineMethodInfo
    ResolveAnimationMethod "setAlpha" o = AnimationSetAlphaMethodInfo
    ResolveAnimationMethod "setCustomProperty" o = Clutter.Scriptable.ScriptableSetCustomPropertyMethodInfo
    ResolveAnimationMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAnimationMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAnimationMethod "setDuration" o = AnimationSetDurationMethodInfo
    ResolveAnimationMethod "setId" o = Clutter.Scriptable.ScriptableSetIdMethodInfo
    ResolveAnimationMethod "setLoop" o = AnimationSetLoopMethodInfo
    ResolveAnimationMethod "setMode" o = AnimationSetModeMethodInfo
    ResolveAnimationMethod "setObject" o = AnimationSetObjectMethodInfo
    ResolveAnimationMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAnimationMethod "setTimeline" o = AnimationSetTimelineMethodInfo
    ResolveAnimationMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveAnimationMethod t Animation, O.OverloadedMethod info Animation p) => OL.IsLabel t (Animation -> 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 ~ ResolveAnimationMethod t Animation, O.OverloadedMethod info Animation p, R.HasField t Animation p) => R.HasField t Animation p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveAnimationMethod t Animation, O.OverloadedMethodInfo info Animation) => OL.IsLabel t (O.MethodProxy info Animation) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

-- signal Animation::completed
{-# DEPRECATED AnimationCompletedCallback ["(Since version 1.12)","Use t'GI.Clutter.Objects.PropertyTransition.PropertyTransition' instead"] #-}
-- | The [completed](#g:signal:completed) signal is emitted once the animation has
-- been completed.
-- 
-- The /@animation@/ instance is guaranteed to be valid for the entire
-- duration of the signal emission chain.
-- 
-- /Since: 1.0/
type AnimationCompletedCallback =
    IO ()

type C_AnimationCompletedCallback =
    Ptr Animation ->                        -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_AnimationCompletedCallback`.
foreign import ccall "wrapper"
    mk_AnimationCompletedCallback :: C_AnimationCompletedCallback -> IO (FunPtr C_AnimationCompletedCallback)

wrap_AnimationCompletedCallback :: 
    GObject a => (a -> AnimationCompletedCallback) ->
    C_AnimationCompletedCallback
wrap_AnimationCompletedCallback :: forall a. GObject a => (a -> IO ()) -> C_AnimationCompletedCallback
wrap_AnimationCompletedCallback a -> IO ()
gi'cb Ptr Animation
gi'selfPtr Ptr ()
_ = do
    Ptr Animation -> (Animation -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Animation
gi'selfPtr ((Animation -> IO ()) -> IO ()) -> (Animation -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Animation
gi'self -> a -> IO ()
gi'cb (Animation -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Animation
gi'self) 


-- | Connect a signal handler for the [completed](#signal:completed) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' animation #completed callback
-- @
-- 
-- 
onAnimationCompleted :: (IsAnimation a, MonadIO m) => a -> ((?self :: a) => AnimationCompletedCallback) -> m SignalHandlerId
onAnimationCompleted :: forall a (m :: * -> *).
(IsAnimation a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onAnimationCompleted a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_AnimationCompletedCallback
wrapped' = (a -> IO ()) -> C_AnimationCompletedCallback
forall a. GObject a => (a -> IO ()) -> C_AnimationCompletedCallback
wrap_AnimationCompletedCallback a -> IO ()
wrapped
    FunPtr C_AnimationCompletedCallback
wrapped'' <- C_AnimationCompletedCallback
-> IO (FunPtr C_AnimationCompletedCallback)
mk_AnimationCompletedCallback C_AnimationCompletedCallback
wrapped'
    a
-> Text
-> FunPtr C_AnimationCompletedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"completed" FunPtr C_AnimationCompletedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [completed](#signal:completed) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' animation #completed callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterAnimationCompleted :: (IsAnimation a, MonadIO m) => a -> ((?self :: a) => AnimationCompletedCallback) -> m SignalHandlerId
afterAnimationCompleted :: forall a (m :: * -> *).
(IsAnimation a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterAnimationCompleted a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_AnimationCompletedCallback
wrapped' = (a -> IO ()) -> C_AnimationCompletedCallback
forall a. GObject a => (a -> IO ()) -> C_AnimationCompletedCallback
wrap_AnimationCompletedCallback a -> IO ()
wrapped
    FunPtr C_AnimationCompletedCallback
wrapped'' <- C_AnimationCompletedCallback
-> IO (FunPtr C_AnimationCompletedCallback)
mk_AnimationCompletedCallback C_AnimationCompletedCallback
wrapped'
    a
-> Text
-> FunPtr C_AnimationCompletedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"completed" FunPtr C_AnimationCompletedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data AnimationCompletedSignalInfo
instance SignalInfo AnimationCompletedSignalInfo where
    type HaskellCallbackType AnimationCompletedSignalInfo = AnimationCompletedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_AnimationCompletedCallback cb
        cb'' <- mk_AnimationCompletedCallback cb'
        connectSignalFunPtr obj "completed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation::completed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#g:signal:completed"})

#endif

-- signal Animation::started
{-# DEPRECATED AnimationStartedCallback ["(Since version 1.12)","Use t'GI.Clutter.Objects.PropertyTransition.PropertyTransition' instead"] #-}
-- | The [started](#g:signal:started) signal is emitted once the animation has been
-- started
-- 
-- /Since: 1.0/
type AnimationStartedCallback =
    IO ()

type C_AnimationStartedCallback =
    Ptr Animation ->                        -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_AnimationStartedCallback`.
foreign import ccall "wrapper"
    mk_AnimationStartedCallback :: C_AnimationStartedCallback -> IO (FunPtr C_AnimationStartedCallback)

wrap_AnimationStartedCallback :: 
    GObject a => (a -> AnimationStartedCallback) ->
    C_AnimationStartedCallback
wrap_AnimationStartedCallback :: forall a. GObject a => (a -> IO ()) -> C_AnimationCompletedCallback
wrap_AnimationStartedCallback a -> IO ()
gi'cb Ptr Animation
gi'selfPtr Ptr ()
_ = do
    Ptr Animation -> (Animation -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Animation
gi'selfPtr ((Animation -> IO ()) -> IO ()) -> (Animation -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Animation
gi'self -> a -> IO ()
gi'cb (Animation -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Animation
gi'self) 


-- | Connect a signal handler for the [started](#signal:started) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' animation #started callback
-- @
-- 
-- 
onAnimationStarted :: (IsAnimation a, MonadIO m) => a -> ((?self :: a) => AnimationStartedCallback) -> m SignalHandlerId
onAnimationStarted :: forall a (m :: * -> *).
(IsAnimation a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onAnimationStarted a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_AnimationCompletedCallback
wrapped' = (a -> IO ()) -> C_AnimationCompletedCallback
forall a. GObject a => (a -> IO ()) -> C_AnimationCompletedCallback
wrap_AnimationStartedCallback a -> IO ()
wrapped
    FunPtr C_AnimationCompletedCallback
wrapped'' <- C_AnimationCompletedCallback
-> IO (FunPtr C_AnimationCompletedCallback)
mk_AnimationStartedCallback C_AnimationCompletedCallback
wrapped'
    a
-> Text
-> FunPtr C_AnimationCompletedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"started" FunPtr C_AnimationCompletedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [started](#signal:started) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' animation #started callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterAnimationStarted :: (IsAnimation a, MonadIO m) => a -> ((?self :: a) => AnimationStartedCallback) -> m SignalHandlerId
afterAnimationStarted :: forall a (m :: * -> *).
(IsAnimation a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterAnimationStarted a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_AnimationCompletedCallback
wrapped' = (a -> IO ()) -> C_AnimationCompletedCallback
forall a. GObject a => (a -> IO ()) -> C_AnimationCompletedCallback
wrap_AnimationStartedCallback a -> IO ()
wrapped
    FunPtr C_AnimationCompletedCallback
wrapped'' <- C_AnimationCompletedCallback
-> IO (FunPtr C_AnimationCompletedCallback)
mk_AnimationStartedCallback C_AnimationCompletedCallback
wrapped'
    a
-> Text
-> FunPtr C_AnimationCompletedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"started" FunPtr C_AnimationCompletedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data AnimationStartedSignalInfo
instance SignalInfo AnimationStartedSignalInfo where
    type HaskellCallbackType AnimationStartedSignalInfo = AnimationStartedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_AnimationStartedCallback cb
        cb'' <- mk_AnimationStartedCallback cb'
        connectSignalFunPtr obj "started" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation::started"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#g:signal:started"})

#endif

-- VVV Prop "alpha"
   -- Type: TInterface (Name {namespace = "Clutter", name = "Alpha"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@alpha@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' animation #alpha
-- @
getAnimationAlpha :: (MonadIO m, IsAnimation o) => o -> m Clutter.Alpha.Alpha
getAnimationAlpha :: forall (m :: * -> *) o. (MonadIO m, IsAnimation o) => o -> m Alpha
getAnimationAlpha o
obj = IO Alpha -> m Alpha
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Alpha -> m Alpha) -> IO Alpha -> m Alpha
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Alpha) -> IO Alpha
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getAnimationAlpha" (IO (Maybe Alpha) -> IO Alpha) -> IO (Maybe Alpha) -> IO Alpha
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Alpha -> Alpha) -> IO (Maybe Alpha)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"alpha" ManagedPtr Alpha -> Alpha
Clutter.Alpha.Alpha

-- | Set the value of the “@alpha@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' animation [ #alpha 'Data.GI.Base.Attributes.:=' value ]
-- @
setAnimationAlpha :: (MonadIO m, IsAnimation o, Clutter.Alpha.IsAlpha a) => o -> a -> m ()
setAnimationAlpha :: forall (m :: * -> *) o a.
(MonadIO m, IsAnimation o, IsAlpha a) =>
o -> a -> m ()
setAnimationAlpha o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"alpha" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@alpha@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAnimationAlpha :: (IsAnimation o, MIO.MonadIO m, Clutter.Alpha.IsAlpha a) => a -> m (GValueConstruct o)
constructAnimationAlpha :: forall o (m :: * -> *) a.
(IsAnimation o, MonadIO m, IsAlpha a) =>
a -> m (GValueConstruct o)
constructAnimationAlpha a
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 -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"alpha" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data AnimationAlphaPropertyInfo
instance AttrInfo AnimationAlphaPropertyInfo where
    type AttrAllowedOps AnimationAlphaPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AnimationAlphaPropertyInfo = IsAnimation
    type AttrSetTypeConstraint AnimationAlphaPropertyInfo = Clutter.Alpha.IsAlpha
    type AttrTransferTypeConstraint AnimationAlphaPropertyInfo = Clutter.Alpha.IsAlpha
    type AttrTransferType AnimationAlphaPropertyInfo = Clutter.Alpha.Alpha
    type AttrGetType AnimationAlphaPropertyInfo = Clutter.Alpha.Alpha
    type AttrLabel AnimationAlphaPropertyInfo = "alpha"
    type AttrOrigin AnimationAlphaPropertyInfo = Animation
    attrGet = getAnimationAlpha
    attrSet = setAnimationAlpha
    attrTransfer _ v = do
        unsafeCastTo Clutter.Alpha.Alpha v
    attrConstruct = constructAnimationAlpha
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.alpha"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#g:attr:alpha"
        })
#endif

-- VVV Prop "duration"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@duration@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' animation [ #duration 'Data.GI.Base.Attributes.:=' value ]
-- @
setAnimationDuration :: (MonadIO m, IsAnimation o) => o -> Word32 -> m ()
setAnimationDuration :: forall (m :: * -> *) o.
(MonadIO m, IsAnimation o) =>
o -> Word32 -> m ()
setAnimationDuration o
obj Word32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"duration" Word32
val

-- | Construct a `GValueConstruct` with valid value for the “@duration@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAnimationDuration :: (IsAnimation o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructAnimationDuration :: forall o (m :: * -> *).
(IsAnimation o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructAnimationDuration Word32
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 -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"duration" Word32
val

#if defined(ENABLE_OVERLOADING)
data AnimationDurationPropertyInfo
instance AttrInfo AnimationDurationPropertyInfo where
    type AttrAllowedOps AnimationDurationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AnimationDurationPropertyInfo = IsAnimation
    type AttrSetTypeConstraint AnimationDurationPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint AnimationDurationPropertyInfo = (~) Word32
    type AttrTransferType AnimationDurationPropertyInfo = Word32
    type AttrGetType AnimationDurationPropertyInfo = Word32
    type AttrLabel AnimationDurationPropertyInfo = "duration"
    type AttrOrigin AnimationDurationPropertyInfo = Animation
    attrGet = getAnimationDuration
    attrSet = setAnimationDuration
    attrTransfer _ v = do
        return v
    attrConstruct = constructAnimationDuration
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.duration"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#g:attr:duration"
        })
#endif

-- VVV Prop "loop"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@loop@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' animation [ #loop 'Data.GI.Base.Attributes.:=' value ]
-- @
setAnimationLoop :: (MonadIO m, IsAnimation o) => o -> Bool -> m ()
setAnimationLoop :: forall (m :: * -> *) o.
(MonadIO m, IsAnimation o) =>
o -> Bool -> m ()
setAnimationLoop o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"loop" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@loop@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAnimationLoop :: (IsAnimation o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructAnimationLoop :: forall o (m :: * -> *).
(IsAnimation o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructAnimationLoop Bool
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 -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"loop" Bool
val

#if defined(ENABLE_OVERLOADING)
data AnimationLoopPropertyInfo
instance AttrInfo AnimationLoopPropertyInfo where
    type AttrAllowedOps AnimationLoopPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AnimationLoopPropertyInfo = IsAnimation
    type AttrSetTypeConstraint AnimationLoopPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint AnimationLoopPropertyInfo = (~) Bool
    type AttrTransferType AnimationLoopPropertyInfo = Bool
    type AttrGetType AnimationLoopPropertyInfo = Bool
    type AttrLabel AnimationLoopPropertyInfo = "loop"
    type AttrOrigin AnimationLoopPropertyInfo = Animation
    attrGet = getAnimationLoop
    attrSet = setAnimationLoop
    attrTransfer _ v = do
        return v
    attrConstruct = constructAnimationLoop
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.loop"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#g:attr:loop"
        })
#endif

-- VVV Prop "mode"
   -- Type: TBasicType TULong
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@mode@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' animation [ #mode 'Data.GI.Base.Attributes.:=' value ]
-- @
setAnimationMode :: (MonadIO m, IsAnimation o) => o -> CULong -> m ()
setAnimationMode :: forall (m :: * -> *) o.
(MonadIO m, IsAnimation o) =>
o -> SignalHandlerId -> m ()
setAnimationMode o
obj SignalHandlerId
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> SignalHandlerId -> IO ()
forall a. GObject a => a -> String -> SignalHandlerId -> IO ()
B.Properties.setObjectPropertyULong o
obj String
"mode" SignalHandlerId
val

-- | Construct a `GValueConstruct` with valid value for the “@mode@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAnimationMode :: (IsAnimation o, MIO.MonadIO m) => CULong -> m (GValueConstruct o)
constructAnimationMode :: forall o (m :: * -> *).
(IsAnimation o, MonadIO m) =>
SignalHandlerId -> m (GValueConstruct o)
constructAnimationMode SignalHandlerId
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 -> SignalHandlerId -> IO (GValueConstruct o)
forall o. String -> SignalHandlerId -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyULong String
"mode" SignalHandlerId
val

#if defined(ENABLE_OVERLOADING)
data AnimationModePropertyInfo
instance AttrInfo AnimationModePropertyInfo where
    type AttrAllowedOps AnimationModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AnimationModePropertyInfo = IsAnimation
    type AttrSetTypeConstraint AnimationModePropertyInfo = (~) CULong
    type AttrTransferTypeConstraint AnimationModePropertyInfo = (~) CULong
    type AttrTransferType AnimationModePropertyInfo = CULong
    type AttrGetType AnimationModePropertyInfo = CULong
    type AttrLabel AnimationModePropertyInfo = "mode"
    type AttrOrigin AnimationModePropertyInfo = Animation
    attrGet = getAnimationMode
    attrSet = setAnimationMode
    attrTransfer _ v = do
        return v
    attrConstruct = constructAnimationMode
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.mode"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#g:attr:mode"
        })
#endif

-- VVV Prop "object"
   -- Type: TInterface (Name {namespace = "GObject", name = "Object"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@object@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' animation #object
-- @
getAnimationObject :: (MonadIO m, IsAnimation o) => o -> m GObject.Object.Object
getAnimationObject :: forall (m :: * -> *) o. (MonadIO m, IsAnimation o) => o -> m Object
getAnimationObject o
obj = IO Object -> m Object
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Object -> m Object) -> IO Object -> m Object
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Object) -> IO Object
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getAnimationObject" (IO (Maybe Object) -> IO Object) -> IO (Maybe Object) -> IO Object
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Object -> Object) -> IO (Maybe Object)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"object" ManagedPtr Object -> Object
GObject.Object.Object

-- | Set the value of the “@object@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' animation [ #object 'Data.GI.Base.Attributes.:=' value ]
-- @
setAnimationObject :: (MonadIO m, IsAnimation o, GObject.Object.IsObject a) => o -> a -> m ()
setAnimationObject :: forall (m :: * -> *) o a.
(MonadIO m, IsAnimation o, IsObject a) =>
o -> a -> m ()
setAnimationObject o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"object" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@object@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAnimationObject :: (IsAnimation o, MIO.MonadIO m, GObject.Object.IsObject a) => a -> m (GValueConstruct o)
constructAnimationObject :: forall o (m :: * -> *) a.
(IsAnimation o, MonadIO m, IsObject a) =>
a -> m (GValueConstruct o)
constructAnimationObject a
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 -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"object" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data AnimationObjectPropertyInfo
instance AttrInfo AnimationObjectPropertyInfo where
    type AttrAllowedOps AnimationObjectPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AnimationObjectPropertyInfo = IsAnimation
    type AttrSetTypeConstraint AnimationObjectPropertyInfo = GObject.Object.IsObject
    type AttrTransferTypeConstraint AnimationObjectPropertyInfo = GObject.Object.IsObject
    type AttrTransferType AnimationObjectPropertyInfo = GObject.Object.Object
    type AttrGetType AnimationObjectPropertyInfo = GObject.Object.Object
    type AttrLabel AnimationObjectPropertyInfo = "object"
    type AttrOrigin AnimationObjectPropertyInfo = Animation
    attrGet = getAnimationObject
    attrSet = setAnimationObject
    attrTransfer _ v = do
        unsafeCastTo GObject.Object.Object v
    attrConstruct = constructAnimationObject
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.object"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#g:attr:object"
        })
#endif

-- VVV Prop "timeline"
   -- Type: TInterface (Name {namespace = "Clutter", name = "Timeline"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just True)

-- | Get the value of the “@timeline@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' animation #timeline
-- @
getAnimationTimeline :: (MonadIO m, IsAnimation o) => o -> m Clutter.Timeline.Timeline
getAnimationTimeline :: forall (m :: * -> *) o.
(MonadIO m, IsAnimation o) =>
o -> m Timeline
getAnimationTimeline o
obj = IO Timeline -> m Timeline
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Timeline -> m Timeline) -> IO Timeline -> m Timeline
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Timeline) -> IO Timeline
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getAnimationTimeline" (IO (Maybe Timeline) -> IO Timeline)
-> IO (Maybe Timeline) -> IO Timeline
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr Timeline -> Timeline)
-> IO (Maybe Timeline)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"timeline" ManagedPtr Timeline -> Timeline
Clutter.Timeline.Timeline

-- | Set the value of the “@timeline@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' animation [ #timeline 'Data.GI.Base.Attributes.:=' value ]
-- @
setAnimationTimeline :: (MonadIO m, IsAnimation o, Clutter.Timeline.IsTimeline a) => o -> a -> m ()
setAnimationTimeline :: forall (m :: * -> *) o a.
(MonadIO m, IsAnimation o, IsTimeline a) =>
o -> a -> m ()
setAnimationTimeline o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"timeline" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@timeline@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAnimationTimeline :: (IsAnimation o, MIO.MonadIO m, Clutter.Timeline.IsTimeline a) => a -> m (GValueConstruct o)
constructAnimationTimeline :: forall o (m :: * -> *) a.
(IsAnimation o, MonadIO m, IsTimeline a) =>
a -> m (GValueConstruct o)
constructAnimationTimeline a
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 -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"timeline" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@timeline@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #timeline
-- @
clearAnimationTimeline :: (MonadIO m, IsAnimation o) => o -> m ()
clearAnimationTimeline :: forall (m :: * -> *) o. (MonadIO m, IsAnimation o) => o -> m ()
clearAnimationTimeline o
obj = 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
$ o -> String -> Maybe Timeline -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"timeline" (Maybe Timeline
forall a. Maybe a
Nothing :: Maybe Clutter.Timeline.Timeline)

#if defined(ENABLE_OVERLOADING)
data AnimationTimelinePropertyInfo
instance AttrInfo AnimationTimelinePropertyInfo where
    type AttrAllowedOps AnimationTimelinePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint AnimationTimelinePropertyInfo = IsAnimation
    type AttrSetTypeConstraint AnimationTimelinePropertyInfo = Clutter.Timeline.IsTimeline
    type AttrTransferTypeConstraint AnimationTimelinePropertyInfo = Clutter.Timeline.IsTimeline
    type AttrTransferType AnimationTimelinePropertyInfo = Clutter.Timeline.Timeline
    type AttrGetType AnimationTimelinePropertyInfo = Clutter.Timeline.Timeline
    type AttrLabel AnimationTimelinePropertyInfo = "timeline"
    type AttrOrigin AnimationTimelinePropertyInfo = Animation
    attrGet = getAnimationTimeline
    attrSet = setAnimationTimeline
    attrTransfer _ v = do
        unsafeCastTo Clutter.Timeline.Timeline v
    attrConstruct = constructAnimationTimeline
    attrClear = clearAnimationTimeline
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.timeline"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#g:attr:timeline"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Animation
type instance O.AttributeList Animation = AnimationAttributeList
type AnimationAttributeList = ('[ '("alpha", AnimationAlphaPropertyInfo), '("duration", AnimationDurationPropertyInfo), '("loop", AnimationLoopPropertyInfo), '("mode", AnimationModePropertyInfo), '("object", AnimationObjectPropertyInfo), '("timeline", AnimationTimelinePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
animationAlpha :: AttrLabelProxy "alpha"
animationAlpha = AttrLabelProxy

animationDuration :: AttrLabelProxy "duration"
animationDuration = AttrLabelProxy

animationLoop :: AttrLabelProxy "loop"
animationLoop = AttrLabelProxy

animationMode :: AttrLabelProxy "mode"
animationMode = AttrLabelProxy

animationObject :: AttrLabelProxy "object"
animationObject = AttrLabelProxy

animationTimeline :: AttrLabelProxy "timeline"
animationTimeline = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Animation = AnimationSignalList
type AnimationSignalList = ('[ '("completed", AnimationCompletedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("started", AnimationStartedSignalInfo)] :: [(Symbol, *)])

#endif

-- method Animation::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "Animation" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_animation_new" clutter_animation_new :: 
    IO (Ptr Animation)

{-# DEPRECATED animationNew ["(Since version 1.12)","Use t'GI.Clutter.Objects.PropertyTransition.PropertyTransition' instead"] #-}
-- | Creates a new t'GI.Clutter.Objects.Animation.Animation' instance. You should set the
-- t'GI.GObject.Objects.Object.Object' to be animated using 'GI.Clutter.Objects.Animation.animationSetObject',
-- set the duration with 'GI.Clutter.Objects.Animation.animationSetDuration' and the
-- easing mode using 'GI.Clutter.Objects.Animation.animationSetMode'.
-- 
-- Use 'GI.Clutter.Objects.Animation.animationBind' or 'GI.Clutter.Objects.Animation.animationBindInterval'
-- to define the properties to be animated. The interval and the
-- animated properties can be updated at runtime.
-- 
-- The @/clutter_actor_animate()/@ and relative family of functions provide
-- an easy way to animate a t'GI.Clutter.Objects.Actor.Actor' and automatically manage the
-- lifetime of a t'GI.Clutter.Objects.Animation.Animation' instance, so you should consider using
-- those functions instead of manually creating an animation.
-- 
-- /Since: 1.0/
animationNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Animation
    -- ^ __Returns:__ the newly created t'GI.Clutter.Objects.Animation.Animation'. Use 'GI.GObject.Objects.Object.objectUnref'
    --   to release the associated resources
animationNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Animation
animationNew  = IO Animation -> m Animation
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Animation -> m Animation) -> IO Animation -> m Animation
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animation
result <- IO (Ptr Animation)
clutter_animation_new
    Text -> Ptr Animation -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"animationNew" Ptr Animation
result
    Animation
result' <- ((ManagedPtr Animation -> Animation)
-> Ptr Animation -> IO Animation
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Animation -> Animation
Animation) Ptr Animation
result
    Animation -> IO Animation
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Animation
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Animation::bind
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animation"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the property to control"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "final"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The final value of the property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "Animation" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_animation_bind" clutter_animation_bind :: 
    Ptr Animation ->                        -- animation : TInterface (Name {namespace = "Clutter", name = "Animation"})
    CString ->                              -- property_name : TBasicType TUTF8
    Ptr GValue ->                           -- final : TGValue
    IO (Ptr Animation)

{-# DEPRECATED animationBind ["(Since version 1.12)","Use t'GI.Clutter.Objects.PropertyTransition.PropertyTransition' instead"] #-}
-- | Adds a single property with name /@propertyName@/ to the
-- animation /@animation@/.  For more information about animations,
-- see @/clutter_actor_animate()/@.
-- 
-- This method returns the animation primarily to make chained
-- calls convenient in language bindings.
-- 
-- /Since: 1.0/
animationBind ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@animation@/: a t'GI.Clutter.Objects.Animation.Animation'
    -> T.Text
    -- ^ /@propertyName@/: the property to control
    -> GValue
    -- ^ /@final@/: The final value of the property
    -> m Animation
    -- ^ __Returns:__ The animation itself.
animationBind :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> Text -> GValue -> m Animation
animationBind a
animation Text
propertyName GValue
final = IO Animation -> m Animation
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Animation -> m Animation) -> IO Animation -> m Animation
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animation
animation' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    Ptr GValue
final' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
final
    Ptr Animation
result <- Ptr Animation -> CString -> Ptr GValue -> IO (Ptr Animation)
clutter_animation_bind Ptr Animation
animation' CString
propertyName' Ptr GValue
final'
    Text -> Ptr Animation -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"animationBind" Ptr Animation
result
    Animation
result' <- ((ManagedPtr Animation -> Animation)
-> Ptr Animation -> IO Animation
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Animation -> Animation
Animation) Ptr Animation
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animation
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
final
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    Animation -> IO Animation
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Animation
result'

#if defined(ENABLE_OVERLOADING)
data AnimationBindMethodInfo
instance (signature ~ (T.Text -> GValue -> m Animation), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationBindMethodInfo a signature where
    overloadedMethod = animationBind

instance O.OverloadedMethodInfo AnimationBindMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.animationBind",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#v:animationBind"
        })


#endif

-- method Animation::bind_interval
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animation"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the property to control"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interval"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Interval" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInterval" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "Animation" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_animation_bind_interval" clutter_animation_bind_interval :: 
    Ptr Animation ->                        -- animation : TInterface (Name {namespace = "Clutter", name = "Animation"})
    CString ->                              -- property_name : TBasicType TUTF8
    Ptr Clutter.Interval.Interval ->        -- interval : TInterface (Name {namespace = "Clutter", name = "Interval"})
    IO (Ptr Animation)

{-# DEPRECATED animationBindInterval ["(Since version 1.12)","Use t'GI.Clutter.Objects.PropertyTransition.PropertyTransition' instead"] #-}
-- | Binds /@interval@/ to the /@propertyName@/ of the t'GI.GObject.Objects.Object.Object'
-- attached to /@animation@/. The t'GI.Clutter.Objects.Animation.Animation' will take
-- ownership of the passed t'GI.Clutter.Objects.Interval.Interval'.  For more information
-- about animations, see @/clutter_actor_animate()/@.
-- 
-- If you need to update the interval instance use
-- 'GI.Clutter.Objects.Animation.animationUpdateInterval' instead.
-- 
-- /Since: 1.0/
animationBindInterval ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a, Clutter.Interval.IsInterval b) =>
    a
    -- ^ /@animation@/: a t'GI.Clutter.Objects.Animation.Animation'
    -> T.Text
    -- ^ /@propertyName@/: the property to control
    -> b
    -- ^ /@interval@/: a t'GI.Clutter.Objects.Interval.Interval'
    -> m Animation
    -- ^ __Returns:__ The animation itself.
animationBindInterval :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAnimation a, IsInterval b) =>
a -> Text -> b -> m Animation
animationBindInterval a
animation Text
propertyName b
interval = IO Animation -> m Animation
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Animation -> m Animation) -> IO Animation -> m Animation
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animation
animation' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    Ptr Interval
interval' <- b -> IO (Ptr Interval)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject b
interval
    Ptr Animation
result <- Ptr Animation -> CString -> Ptr Interval -> IO (Ptr Animation)
clutter_animation_bind_interval Ptr Animation
animation' CString
propertyName' Ptr Interval
interval'
    Text -> Ptr Animation -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"animationBindInterval" Ptr Animation
result
    Animation
result' <- ((ManagedPtr Animation -> Animation)
-> Ptr Animation -> IO Animation
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Animation -> Animation
Animation) Ptr Animation
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animation
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
interval
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    Animation -> IO Animation
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Animation
result'

#if defined(ENABLE_OVERLOADING)
data AnimationBindIntervalMethodInfo
instance (signature ~ (T.Text -> b -> m Animation), MonadIO m, IsAnimation a, Clutter.Interval.IsInterval b) => O.OverloadedMethod AnimationBindIntervalMethodInfo a signature where
    overloadedMethod = animationBindInterval

instance O.OverloadedMethodInfo AnimationBindIntervalMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.animationBindInterval",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#v:animationBindInterval"
        })


#endif

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

foreign import ccall "clutter_animation_completed" clutter_animation_completed :: 
    Ptr Animation ->                        -- animation : TInterface (Name {namespace = "Clutter", name = "Animation"})
    IO ()

{-# DEPRECATED animationCompleted ["(Since version 1.12)","Use t'GI.Clutter.Objects.PropertyTransition.PropertyTransition' instead"] #-}
-- | Emits the [completed](#g:signal:completed) signal on /@animation@/
-- 
-- When using this function with a t'GI.Clutter.Objects.Animation.Animation' created
-- by the @/clutter_actor_animate()/@ family of functions, /@animation@/
-- will be unreferenced and it will not be valid anymore,
-- unless 'GI.GObject.Objects.Object.objectRef' was called before calling this function
-- or unless a reference was taken inside a handler for the
-- [Animation::completed]("GI.Clutter.Objects.Animation#g:signal:completed") signal
-- 
-- /Since: 1.0/
animationCompleted ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@animation@/: a t'GI.Clutter.Objects.Animation.Animation'
    -> m ()
animationCompleted :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> m ()
animationCompleted a
animation = 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
    Ptr Animation
animation' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    Ptr Animation -> IO ()
clutter_animation_completed Ptr Animation
animation'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animation
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnimationCompletedMethodInfo
instance (signature ~ (m ()), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationCompletedMethodInfo a signature where
    overloadedMethod = animationCompleted

instance O.OverloadedMethodInfo AnimationCompletedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.animationCompleted",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#v:animationCompleted"
        })


#endif

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

foreign import ccall "clutter_animation_get_alpha" clutter_animation_get_alpha :: 
    Ptr Animation ->                        -- animation : TInterface (Name {namespace = "Clutter", name = "Animation"})
    IO (Ptr Clutter.Alpha.Alpha)

{-# DEPRECATED animationGetAlpha ["(Since version 1.10)","Use 'GI.Clutter.Objects.Animation.animationGetTimeline' and","  'GI.Clutter.Objects.Timeline.timelineGetProgressMode' instead."] #-}
-- | Retrieves the t'GI.Clutter.Objects.Alpha.Alpha' used by /@animation@/.
-- 
-- /Since: 1.0/
animationGetAlpha ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@animation@/: a t'GI.Clutter.Objects.Animation.Animation'
    -> m Clutter.Alpha.Alpha
    -- ^ __Returns:__ the alpha object used by the animation
animationGetAlpha :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> m Alpha
animationGetAlpha a
animation = IO Alpha -> m Alpha
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Alpha -> m Alpha) -> IO Alpha -> m Alpha
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animation
animation' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    Ptr Alpha
result <- Ptr Animation -> IO (Ptr Alpha)
clutter_animation_get_alpha Ptr Animation
animation'
    Text -> Ptr Alpha -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"animationGetAlpha" Ptr Alpha
result
    Alpha
result' <- ((ManagedPtr Alpha -> Alpha) -> Ptr Alpha -> IO Alpha
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Alpha -> Alpha
Clutter.Alpha.Alpha) Ptr Alpha
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animation
    Alpha -> IO Alpha
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Alpha
result'

#if defined(ENABLE_OVERLOADING)
data AnimationGetAlphaMethodInfo
instance (signature ~ (m Clutter.Alpha.Alpha), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationGetAlphaMethodInfo a signature where
    overloadedMethod = animationGetAlpha

instance O.OverloadedMethodInfo AnimationGetAlphaMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.animationGetAlpha",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#v:animationGetAlpha"
        })


#endif

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

foreign import ccall "clutter_animation_get_duration" clutter_animation_get_duration :: 
    Ptr Animation ->                        -- animation : TInterface (Name {namespace = "Clutter", name = "Animation"})
    IO Word32

{-# DEPRECATED animationGetDuration ["(Since version 1.12)","Use t'GI.Clutter.Objects.PropertyTransition.PropertyTransition' instead"] #-}
-- | Retrieves the duration of /@animation@/, in milliseconds.
-- 
-- /Since: 1.0/
animationGetDuration ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@animation@/: a t'GI.Clutter.Objects.Animation.Animation'
    -> m Word32
    -- ^ __Returns:__ the duration of the animation
animationGetDuration :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> m Word32
animationGetDuration a
animation = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animation
animation' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    Word32
result <- Ptr Animation -> IO Word32
clutter_animation_get_duration Ptr Animation
animation'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animation
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data AnimationGetDurationMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationGetDurationMethodInfo a signature where
    overloadedMethod = animationGetDuration

instance O.OverloadedMethodInfo AnimationGetDurationMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.animationGetDuration",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#v:animationGetDuration"
        })


#endif

-- method Animation::get_interval
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animation"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of the property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "Interval" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_animation_get_interval" clutter_animation_get_interval :: 
    Ptr Animation ->                        -- animation : TInterface (Name {namespace = "Clutter", name = "Animation"})
    CString ->                              -- property_name : TBasicType TUTF8
    IO (Ptr Clutter.Interval.Interval)

{-# DEPRECATED animationGetInterval ["(Since version 1.12)","Use t'GI.Clutter.Objects.PropertyTransition.PropertyTransition' instead"] #-}
-- | Retrieves the t'GI.Clutter.Objects.Interval.Interval' associated to /@propertyName@/
-- inside /@animation@/.
-- 
-- /Since: 1.0/
animationGetInterval ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@animation@/: a t'GI.Clutter.Objects.Animation.Animation'
    -> T.Text
    -- ^ /@propertyName@/: name of the property
    -> m Clutter.Interval.Interval
    -- ^ __Returns:__ a t'GI.Clutter.Objects.Interval.Interval' or 'P.Nothing' if no
    --   property with the same name was found. The returned interval is
    --   owned by the t'GI.Clutter.Objects.Animation.Animation' and should not be unreferenced
animationGetInterval :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> Text -> m Interval
animationGetInterval a
animation Text
propertyName = IO Interval -> m Interval
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Interval -> m Interval) -> IO Interval -> m Interval
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animation
animation' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    Ptr Interval
result <- Ptr Animation -> CString -> IO (Ptr Interval)
clutter_animation_get_interval Ptr Animation
animation' CString
propertyName'
    Text -> Ptr Interval -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"animationGetInterval" Ptr Interval
result
    Interval
result' <- ((ManagedPtr Interval -> Interval) -> Ptr Interval -> IO Interval
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Interval -> Interval
Clutter.Interval.Interval) Ptr Interval
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animation
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    Interval -> IO Interval
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Interval
result'

#if defined(ENABLE_OVERLOADING)
data AnimationGetIntervalMethodInfo
instance (signature ~ (T.Text -> m Clutter.Interval.Interval), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationGetIntervalMethodInfo a signature where
    overloadedMethod = animationGetInterval

instance O.OverloadedMethodInfo AnimationGetIntervalMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.animationGetInterval",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#v:animationGetInterval"
        })


#endif

-- method Animation::get_loop
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animation"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimation"
--                 , 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 "clutter_animation_get_loop" clutter_animation_get_loop :: 
    Ptr Animation ->                        -- animation : TInterface (Name {namespace = "Clutter", name = "Animation"})
    IO CInt

{-# DEPRECATED animationGetLoop ["(Since version 1.12)","Use t'GI.Clutter.Objects.PropertyTransition.PropertyTransition' instead"] #-}
-- | Retrieves whether /@animation@/ is looping.
-- 
-- /Since: 1.0/
animationGetLoop ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@animation@/: a t'GI.Clutter.Objects.Animation.Animation'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the animation is looping
animationGetLoop :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> m Bool
animationGetLoop a
animation = 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
    Ptr Animation
animation' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    CInt
result <- Ptr Animation -> IO CInt
clutter_animation_get_loop Ptr Animation
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AnimationGetLoopMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationGetLoopMethodInfo a signature where
    overloadedMethod = animationGetLoop

instance O.OverloadedMethodInfo AnimationGetLoopMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.animationGetLoop",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#v:animationGetLoop"
        })


#endif

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

foreign import ccall "clutter_animation_get_mode" clutter_animation_get_mode :: 
    Ptr Animation ->                        -- animation : TInterface (Name {namespace = "Clutter", name = "Animation"})
    IO CULong

{-# DEPRECATED animationGetMode ["(Since version 1.12)","Use t'GI.Clutter.Objects.PropertyTransition.PropertyTransition' instead"] #-}
-- | Retrieves the animation mode of /@animation@/, as set by
-- 'GI.Clutter.Objects.Animation.animationSetMode'.
-- 
-- /Since: 1.0/
animationGetMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@animation@/: a t'GI.Clutter.Objects.Animation.Animation'
    -> m CULong
    -- ^ __Returns:__ the mode for the animation
animationGetMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> m SignalHandlerId
animationGetMode a
animation = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animation
animation' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    SignalHandlerId
result <- Ptr Animation -> IO SignalHandlerId
clutter_animation_get_mode Ptr Animation
animation'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animation
    SignalHandlerId -> IO SignalHandlerId
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SignalHandlerId
result

#if defined(ENABLE_OVERLOADING)
data AnimationGetModeMethodInfo
instance (signature ~ (m CULong), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationGetModeMethodInfo a signature where
    overloadedMethod = animationGetMode

instance O.OverloadedMethodInfo AnimationGetModeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.animationGetMode",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#v:animationGetMode"
        })


#endif

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

foreign import ccall "clutter_animation_get_object" clutter_animation_get_object :: 
    Ptr Animation ->                        -- animation : TInterface (Name {namespace = "Clutter", name = "Animation"})
    IO (Ptr GObject.Object.Object)

{-# DEPRECATED animationGetObject ["(Since version 1.12)","Use t'GI.Clutter.Objects.PropertyTransition.PropertyTransition' instead"] #-}
-- | Retrieves the t'GI.GObject.Objects.Object.Object' attached to /@animation@/.
-- 
-- /Since: 1.0/
animationGetObject ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@animation@/: a t'GI.Clutter.Objects.Animation.Animation'
    -> m GObject.Object.Object
    -- ^ __Returns:__ a t'GI.GObject.Objects.Object.Object'
animationGetObject :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> m Object
animationGetObject a
animation = IO Object -> m Object
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Object -> m Object) -> IO Object -> m Object
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animation
animation' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    Ptr Object
result <- Ptr Animation -> IO (Ptr Object)
clutter_animation_get_object Ptr Animation
animation'
    Text -> Ptr Object -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"animationGetObject" Ptr Object
result
    Object
result' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
GObject.Object.Object) Ptr Object
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animation
    Object -> IO Object
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result'

#if defined(ENABLE_OVERLOADING)
data AnimationGetObjectMethodInfo
instance (signature ~ (m GObject.Object.Object), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationGetObjectMethodInfo a signature where
    overloadedMethod = animationGetObject

instance O.OverloadedMethodInfo AnimationGetObjectMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.animationGetObject",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#v:animationGetObject"
        })


#endif

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

foreign import ccall "clutter_animation_get_timeline" clutter_animation_get_timeline :: 
    Ptr Animation ->                        -- animation : TInterface (Name {namespace = "Clutter", name = "Animation"})
    IO (Ptr Clutter.Timeline.Timeline)

{-# DEPRECATED animationGetTimeline ["(Since version 1.12)","Use t'GI.Clutter.Objects.PropertyTransition.PropertyTransition' instead"] #-}
-- | Retrieves the t'GI.Clutter.Objects.Timeline.Timeline' used by /@animation@/
-- 
-- /Since: 1.0/
animationGetTimeline ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@animation@/: a t'GI.Clutter.Objects.Animation.Animation'
    -> m Clutter.Timeline.Timeline
    -- ^ __Returns:__ the timeline used by the animation
animationGetTimeline :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> m Timeline
animationGetTimeline a
animation = IO Timeline -> m Timeline
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Timeline -> m Timeline) -> IO Timeline -> m Timeline
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animation
animation' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    Ptr Timeline
result <- Ptr Animation -> IO (Ptr Timeline)
clutter_animation_get_timeline Ptr Animation
animation'
    Text -> Ptr Timeline -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"animationGetTimeline" Ptr Timeline
result
    Timeline
result' <- ((ManagedPtr Timeline -> Timeline) -> Ptr Timeline -> IO Timeline
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Timeline -> Timeline
Clutter.Timeline.Timeline) Ptr Timeline
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animation
    Timeline -> IO Timeline
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Timeline
result'

#if defined(ENABLE_OVERLOADING)
data AnimationGetTimelineMethodInfo
instance (signature ~ (m Clutter.Timeline.Timeline), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationGetTimelineMethodInfo a signature where
    overloadedMethod = animationGetTimeline

instance O.OverloadedMethodInfo AnimationGetTimelineMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.animationGetTimeline",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#v:animationGetTimeline"
        })


#endif

-- method Animation::has_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animation"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of the property"
--                 , 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 "clutter_animation_has_property" clutter_animation_has_property :: 
    Ptr Animation ->                        -- animation : TInterface (Name {namespace = "Clutter", name = "Animation"})
    CString ->                              -- property_name : TBasicType TUTF8
    IO CInt

{-# DEPRECATED animationHasProperty ["(Since version 1.12)","Use t'GI.Clutter.Objects.PropertyTransition.PropertyTransition' instead"] #-}
-- | Checks whether /@animation@/ is controlling /@propertyName@/.
-- 
-- /Since: 1.0/
animationHasProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@animation@/: a t'GI.Clutter.Objects.Animation.Animation'
    -> T.Text
    -- ^ /@propertyName@/: name of the property
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the property is animated by the
    --   t'GI.Clutter.Objects.Animation.Animation', 'P.False' otherwise
animationHasProperty :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> Text -> m Bool
animationHasProperty a
animation Text
propertyName = 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
    Ptr Animation
animation' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    CInt
result <- Ptr Animation -> CString -> IO CInt
clutter_animation_has_property Ptr Animation
animation' CString
propertyName'
    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
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

instance O.OverloadedMethodInfo AnimationHasPropertyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.animationHasProperty",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#v:animationHasProperty"
        })


#endif

-- method Animation::set_alpha
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animation"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "alpha"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Alpha" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #ClutterAlpha, or %NULL to unset the current #ClutterAlpha"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_animation_set_alpha" clutter_animation_set_alpha :: 
    Ptr Animation ->                        -- animation : TInterface (Name {namespace = "Clutter", name = "Animation"})
    Ptr Clutter.Alpha.Alpha ->              -- alpha : TInterface (Name {namespace = "Clutter", name = "Alpha"})
    IO ()

{-# DEPRECATED animationSetAlpha ["(Since version 1.10)","Use 'GI.Clutter.Objects.Animation.animationGetTimeline' and","  'GI.Clutter.Objects.Timeline.timelineSetProgressMode' instead."] #-}
-- | Sets /@alpha@/ as the t'GI.Clutter.Objects.Alpha.Alpha' used by /@animation@/.
-- 
-- If /@alpha@/ is not 'P.Nothing', the t'GI.Clutter.Objects.Animation.Animation' will take ownership
-- of the t'GI.Clutter.Objects.Alpha.Alpha' instance.
-- 
-- /Since: 1.0/
animationSetAlpha ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a, Clutter.Alpha.IsAlpha b) =>
    a
    -- ^ /@animation@/: a t'GI.Clutter.Objects.Animation.Animation'
    -> b
    -- ^ /@alpha@/: a t'GI.Clutter.Objects.Alpha.Alpha', or 'P.Nothing' to unset the current t'GI.Clutter.Objects.Alpha.Alpha'
    -> m ()
animationSetAlpha :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAnimation a, IsAlpha b) =>
a -> b -> m ()
animationSetAlpha a
animation b
alpha = 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
    Ptr Animation
animation' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    Ptr Alpha
alpha' <- b -> IO (Ptr Alpha)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
alpha
    Ptr Animation -> Ptr Alpha -> IO ()
clutter_animation_set_alpha Ptr Animation
animation' Ptr Alpha
alpha'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animation
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
alpha
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnimationSetAlphaMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsAnimation a, Clutter.Alpha.IsAlpha b) => O.OverloadedMethod AnimationSetAlphaMethodInfo a signature where
    overloadedMethod = animationSetAlpha

instance O.OverloadedMethodInfo AnimationSetAlphaMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.animationSetAlpha",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#v:animationSetAlpha"
        })


#endif

-- method Animation::set_duration
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animation"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "msecs"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the duration in milliseconds"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_animation_set_duration" clutter_animation_set_duration :: 
    Ptr Animation ->                        -- animation : TInterface (Name {namespace = "Clutter", name = "Animation"})
    Word32 ->                               -- msecs : TBasicType TUInt
    IO ()

{-# DEPRECATED animationSetDuration ["(Since version 1.12)","Use t'GI.Clutter.Objects.PropertyTransition.PropertyTransition' instead"] #-}
-- | Sets the duration of /@animation@/ in milliseconds.
-- 
-- This function will set [Animation:alpha]("GI.Clutter.Objects.Animation#g:attr:alpha") and
-- [Animation:timeline]("GI.Clutter.Objects.Animation#g:attr:timeline") if needed.
-- 
-- /Since: 1.0/
animationSetDuration ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@animation@/: a t'GI.Clutter.Objects.Animation.Animation'
    -> Word32
    -- ^ /@msecs@/: the duration in milliseconds
    -> m ()
animationSetDuration :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> Word32 -> m ()
animationSetDuration a
animation Word32
msecs = 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
    Ptr Animation
animation' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    Ptr Animation -> Word32 -> IO ()
clutter_animation_set_duration Ptr Animation
animation' Word32
msecs
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animation
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnimationSetDurationMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationSetDurationMethodInfo a signature where
    overloadedMethod = animationSetDuration

instance O.OverloadedMethodInfo AnimationSetDurationMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.animationSetDuration",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#v:animationSetDuration"
        })


#endif

-- method Animation::set_loop
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animation"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "loop"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE if the animation should loop"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_animation_set_loop" clutter_animation_set_loop :: 
    Ptr Animation ->                        -- animation : TInterface (Name {namespace = "Clutter", name = "Animation"})
    CInt ->                                 -- loop : TBasicType TBoolean
    IO ()

{-# DEPRECATED animationSetLoop ["(Since version 1.12)","Use t'GI.Clutter.Objects.PropertyTransition.PropertyTransition' instead"] #-}
-- | Sets whether /@animation@/ should loop over itself once finished.
-- 
-- A looping t'GI.Clutter.Objects.Animation.Animation' will not emit the [Animation::completed]("GI.Clutter.Objects.Animation#g:signal:completed")
-- signal when finished.
-- 
-- This function will set [Animation:alpha]("GI.Clutter.Objects.Animation#g:attr:alpha") and
-- [Animation:timeline]("GI.Clutter.Objects.Animation#g:attr:timeline") if needed.
-- 
-- /Since: 1.0/
animationSetLoop ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@animation@/: a t'GI.Clutter.Objects.Animation.Animation'
    -> Bool
    -- ^ /@loop@/: 'P.True' if the animation should loop
    -> m ()
animationSetLoop :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> Bool -> m ()
animationSetLoop a
animation Bool
loop = 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
    Ptr Animation
animation' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    let loop' :: CInt
loop' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
loop
    Ptr Animation -> CInt -> IO ()
clutter_animation_set_loop Ptr Animation
animation' CInt
loop'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animation
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnimationSetLoopMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationSetLoopMethodInfo a signature where
    overloadedMethod = animationSetLoop

instance O.OverloadedMethodInfo AnimationSetLoopMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.animationSetLoop",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#v:animationSetLoop"
        })


#endif

-- method Animation::set_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animation"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType = TBasicType TULong
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an animation mode logical id"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_animation_set_mode" clutter_animation_set_mode :: 
    Ptr Animation ->                        -- animation : TInterface (Name {namespace = "Clutter", name = "Animation"})
    CULong ->                               -- mode : TBasicType TULong
    IO ()

{-# DEPRECATED animationSetMode ["(Since version 1.12)","Use t'GI.Clutter.Objects.PropertyTransition.PropertyTransition' instead"] #-}
-- | Sets the animation /@mode@/ of /@animation@/. The animation /@mode@/ is
-- a logical id, either coming from the t'GI.Clutter.Enums.AnimationMode' enumeration
-- or the return value of @/clutter_alpha_register_func()/@.
-- 
-- This function will also set [Animation:alpha]("GI.Clutter.Objects.Animation#g:attr:alpha") if needed.
-- 
-- /Since: 1.0/
animationSetMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@animation@/: a t'GI.Clutter.Objects.Animation.Animation'
    -> CULong
    -- ^ /@mode@/: an animation mode logical id
    -> m ()
animationSetMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> SignalHandlerId -> m ()
animationSetMode a
animation SignalHandlerId
mode = 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
    Ptr Animation
animation' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    Ptr Animation -> SignalHandlerId -> IO ()
clutter_animation_set_mode Ptr Animation
animation' SignalHandlerId
mode
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animation
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnimationSetModeMethodInfo
instance (signature ~ (CULong -> m ()), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationSetModeMethodInfo a signature where
    overloadedMethod = animationSetMode

instance O.OverloadedMethodInfo AnimationSetModeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.animationSetMode",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#v:animationSetMode"
        })


#endif

-- method Animation::set_object
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animation"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GObject" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_animation_set_object" clutter_animation_set_object :: 
    Ptr Animation ->                        -- animation : TInterface (Name {namespace = "Clutter", name = "Animation"})
    Ptr GObject.Object.Object ->            -- object : TInterface (Name {namespace = "GObject", name = "Object"})
    IO ()

{-# DEPRECATED animationSetObject ["(Since version 1.12)","Use t'GI.Clutter.Objects.PropertyTransition.PropertyTransition' instead"] #-}
-- | Attaches /@animation@/ to /@object@/. The t'GI.Clutter.Objects.Animation.Animation' will take a
-- reference on /@object@/.
-- 
-- /Since: 1.0/
animationSetObject ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a, GObject.Object.IsObject b) =>
    a
    -- ^ /@animation@/: a t'GI.Clutter.Objects.Animation.Animation'
    -> b
    -- ^ /@object@/: a t'GI.GObject.Objects.Object.Object'
    -> m ()
animationSetObject :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAnimation a, IsObject b) =>
a -> b -> m ()
animationSetObject a
animation b
object = 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
    Ptr Animation
animation' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    Ptr Object
object' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
object
    Ptr Animation -> Ptr Object -> IO ()
clutter_animation_set_object Ptr Animation
animation' Ptr Object
object'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animation
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
object
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnimationSetObjectMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsAnimation a, GObject.Object.IsObject b) => O.OverloadedMethod AnimationSetObjectMethodInfo a signature where
    overloadedMethod = animationSetObject

instance O.OverloadedMethodInfo AnimationSetObjectMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.animationSetObject",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#v:animationSetObject"
        })


#endif

-- method Animation::set_timeline
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animation"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeline"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Timeline" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #ClutterTimeline, or %NULL to unset the\n  current #ClutterTimeline"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_animation_set_timeline" clutter_animation_set_timeline :: 
    Ptr Animation ->                        -- animation : TInterface (Name {namespace = "Clutter", name = "Animation"})
    Ptr Clutter.Timeline.Timeline ->        -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    IO ()

{-# DEPRECATED animationSetTimeline ["(Since version 1.12)","Use t'GI.Clutter.Objects.PropertyTransition.PropertyTransition' instead"] #-}
-- | Sets the t'GI.Clutter.Objects.Timeline.Timeline' used by /@animation@/.
-- 
-- This function will take a reference on the passed /@timeline@/.
-- 
-- /Since: 1.0/
animationSetTimeline ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a, Clutter.Timeline.IsTimeline b) =>
    a
    -- ^ /@animation@/: a t'GI.Clutter.Objects.Animation.Animation'
    -> Maybe (b)
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline', or 'P.Nothing' to unset the
    --   current t'GI.Clutter.Objects.Timeline.Timeline'
    -> m ()
animationSetTimeline :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAnimation a, IsTimeline b) =>
a -> Maybe b -> m ()
animationSetTimeline a
animation Maybe b
timeline = 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
    Ptr Animation
animation' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    Ptr Timeline
maybeTimeline <- case Maybe b
timeline of
        Maybe b
Nothing -> Ptr Timeline -> IO (Ptr Timeline)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Timeline
forall a. Ptr a
nullPtr
        Just b
jTimeline -> do
            Ptr Timeline
jTimeline' <- b -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jTimeline
            Ptr Timeline -> IO (Ptr Timeline)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Timeline
jTimeline'
    Ptr Animation -> Ptr Timeline -> IO ()
clutter_animation_set_timeline Ptr Animation
animation' Ptr Timeline
maybeTimeline
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animation
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
timeline b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnimationSetTimelineMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsAnimation a, Clutter.Timeline.IsTimeline b) => O.OverloadedMethod AnimationSetTimelineMethodInfo a signature where
    overloadedMethod = animationSetTimeline

instance O.OverloadedMethodInfo AnimationSetTimelineMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.animationSetTimeline",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#v:animationSetTimeline"
        })


#endif

-- method Animation::unbind_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animation"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of the property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_animation_unbind_property" clutter_animation_unbind_property :: 
    Ptr Animation ->                        -- animation : TInterface (Name {namespace = "Clutter", name = "Animation"})
    CString ->                              -- property_name : TBasicType TUTF8
    IO ()

{-# DEPRECATED animationUnbindProperty ["(Since version 1.12)","Use t'GI.Clutter.Objects.PropertyTransition.PropertyTransition' instead"] #-}
-- | Removes /@propertyName@/ from the list of animated properties.
-- 
-- /Since: 1.0/
animationUnbindProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@animation@/: a t'GI.Clutter.Objects.Animation.Animation'
    -> T.Text
    -- ^ /@propertyName@/: name of the property
    -> m ()
animationUnbindProperty :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> Text -> m ()
animationUnbindProperty a
animation Text
propertyName = 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
    Ptr Animation
animation' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    Ptr Animation -> CString -> IO ()
clutter_animation_unbind_property Ptr Animation
animation' CString
propertyName'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animation
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnimationUnbindPropertyMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationUnbindPropertyMethodInfo a signature where
    overloadedMethod = animationUnbindProperty

instance O.OverloadedMethodInfo AnimationUnbindPropertyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.animationUnbindProperty",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#v:animationUnbindProperty"
        })


#endif

-- method Animation::update
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animation"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of the property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "final"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The final value of the property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "Animation" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_animation_update" clutter_animation_update :: 
    Ptr Animation ->                        -- animation : TInterface (Name {namespace = "Clutter", name = "Animation"})
    CString ->                              -- property_name : TBasicType TUTF8
    Ptr GValue ->                           -- final : TGValue
    IO (Ptr Animation)

{-# DEPRECATED animationUpdate ["(Since version 1.12)","Use t'GI.Clutter.Objects.PropertyTransition.PropertyTransition' instead"] #-}
-- | Updates the /@final@/ value of the interval for /@propertyName@/
-- 
-- /Since: 1.0/
animationUpdate ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@animation@/: a t'GI.Clutter.Objects.Animation.Animation'
    -> T.Text
    -- ^ /@propertyName@/: name of the property
    -> GValue
    -- ^ /@final@/: The final value of the property
    -> m Animation
    -- ^ __Returns:__ The animation itself.
animationUpdate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> Text -> GValue -> m Animation
animationUpdate a
animation Text
propertyName GValue
final = IO Animation -> m Animation
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Animation -> m Animation) -> IO Animation -> m Animation
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animation
animation' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    Ptr GValue
final' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
final
    Ptr Animation
result <- Ptr Animation -> CString -> Ptr GValue -> IO (Ptr Animation)
clutter_animation_update Ptr Animation
animation' CString
propertyName' Ptr GValue
final'
    Text -> Ptr Animation -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"animationUpdate" Ptr Animation
result
    Animation
result' <- ((ManagedPtr Animation -> Animation)
-> Ptr Animation -> IO Animation
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Animation -> Animation
Animation) Ptr Animation
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animation
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
final
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    Animation -> IO Animation
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Animation
result'

#if defined(ENABLE_OVERLOADING)
data AnimationUpdateMethodInfo
instance (signature ~ (T.Text -> GValue -> m Animation), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationUpdateMethodInfo a signature where
    overloadedMethod = animationUpdate

instance O.OverloadedMethodInfo AnimationUpdateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.animationUpdate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#v:animationUpdate"
        })


#endif

-- method Animation::update_interval
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animation"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of the property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interval"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Interval" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInterval" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_animation_update_interval" clutter_animation_update_interval :: 
    Ptr Animation ->                        -- animation : TInterface (Name {namespace = "Clutter", name = "Animation"})
    CString ->                              -- property_name : TBasicType TUTF8
    Ptr Clutter.Interval.Interval ->        -- interval : TInterface (Name {namespace = "Clutter", name = "Interval"})
    IO ()

{-# DEPRECATED animationUpdateInterval ["(Since version 1.12)","Use t'GI.Clutter.Objects.PropertyTransition.PropertyTransition' instead"] #-}
-- | Changes the /@interval@/ for /@propertyName@/. The t'GI.Clutter.Objects.Animation.Animation'
-- will take ownership of the passed t'GI.Clutter.Objects.Interval.Interval'.
-- 
-- /Since: 1.0/
animationUpdateInterval ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a, Clutter.Interval.IsInterval b) =>
    a
    -- ^ /@animation@/: a t'GI.Clutter.Objects.Animation.Animation'
    -> T.Text
    -- ^ /@propertyName@/: name of the property
    -> b
    -- ^ /@interval@/: a t'GI.Clutter.Objects.Interval.Interval'
    -> m ()
animationUpdateInterval :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAnimation a, IsInterval b) =>
a -> Text -> b -> m ()
animationUpdateInterval a
animation Text
propertyName b
interval = 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
    Ptr Animation
animation' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animation
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    Ptr Interval
interval' <- b -> IO (Ptr Interval)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
interval
    Ptr Animation -> CString -> Ptr Interval -> IO ()
clutter_animation_update_interval Ptr Animation
animation' CString
propertyName' Ptr Interval
interval'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animation
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
interval
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnimationUpdateIntervalMethodInfo
instance (signature ~ (T.Text -> b -> m ()), MonadIO m, IsAnimation a, Clutter.Interval.IsInterval b) => O.OverloadedMethod AnimationUpdateIntervalMethodInfo a signature where
    overloadedMethod = animationUpdateInterval

instance O.OverloadedMethodInfo AnimationUpdateIntervalMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animation.animationUpdateInterval",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Animation.html#v:animationUpdateInterval"
        })


#endif