{-# LANGUAGE 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.Animator.Animator' structure contains only private data and
-- should be accessed using the provided API
-- 
-- /Since: 1.2/

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

module GI.Clutter.Objects.Animator
    ( 

-- * Exported types
    Animator(..)                            ,
    IsAnimator                              ,
    toAnimator                              ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [computeValue]("GI.Clutter.Objects.Animator#g:method:computeValue"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [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"), [propertyGetEaseIn]("GI.Clutter.Objects.Animator#g:method:propertyGetEaseIn"), [propertyGetInterpolation]("GI.Clutter.Objects.Animator#g:method:propertyGetInterpolation"), [propertySetEaseIn]("GI.Clutter.Objects.Animator#g:method:propertySetEaseIn"), [propertySetInterpolation]("GI.Clutter.Objects.Animator#g:method:propertySetInterpolation"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeKey]("GI.Clutter.Objects.Animator#g:method:removeKey"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [start]("GI.Clutter.Objects.Animator#g:method:start"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDuration]("GI.Clutter.Objects.Animator#g:method:getDuration"), [getId]("GI.Clutter.Interfaces.Scriptable#g:method:getId"), [getKeys]("GI.Clutter.Objects.Animator#g:method:getKeys"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getTimeline]("GI.Clutter.Objects.Animator#g:method:getTimeline").
-- 
-- ==== Setters
-- [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.Animator#g:method:setDuration"), [setId]("GI.Clutter.Interfaces.Scriptable#g:method:setId"), [setKey]("GI.Clutter.Objects.Animator#g:method:setKey"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setTimeline]("GI.Clutter.Objects.Animator#g:method:setTimeline").

#if defined(ENABLE_OVERLOADING)
    ResolveAnimatorMethod                   ,
#endif

-- ** computeValue #method:computeValue#

#if defined(ENABLE_OVERLOADING)
    AnimatorComputeValueMethodInfo          ,
#endif
    animatorComputeValue                    ,


-- ** getDuration #method:getDuration#

#if defined(ENABLE_OVERLOADING)
    AnimatorGetDurationMethodInfo           ,
#endif
    animatorGetDuration                     ,


-- ** getKeys #method:getKeys#

#if defined(ENABLE_OVERLOADING)
    AnimatorGetKeysMethodInfo               ,
#endif
    animatorGetKeys                         ,


-- ** getTimeline #method:getTimeline#

#if defined(ENABLE_OVERLOADING)
    AnimatorGetTimelineMethodInfo           ,
#endif
    animatorGetTimeline                     ,


-- ** new #method:new#

    animatorNew                             ,


-- ** propertyGetEaseIn #method:propertyGetEaseIn#

#if defined(ENABLE_OVERLOADING)
    AnimatorPropertyGetEaseInMethodInfo     ,
#endif
    animatorPropertyGetEaseIn               ,


-- ** propertyGetInterpolation #method:propertyGetInterpolation#

#if defined(ENABLE_OVERLOADING)
    AnimatorPropertyGetInterpolationMethodInfo,
#endif
    animatorPropertyGetInterpolation        ,


-- ** propertySetEaseIn #method:propertySetEaseIn#

#if defined(ENABLE_OVERLOADING)
    AnimatorPropertySetEaseInMethodInfo     ,
#endif
    animatorPropertySetEaseIn               ,


-- ** propertySetInterpolation #method:propertySetInterpolation#

#if defined(ENABLE_OVERLOADING)
    AnimatorPropertySetInterpolationMethodInfo,
#endif
    animatorPropertySetInterpolation        ,


-- ** removeKey #method:removeKey#

#if defined(ENABLE_OVERLOADING)
    AnimatorRemoveKeyMethodInfo             ,
#endif
    animatorRemoveKey                       ,


-- ** setDuration #method:setDuration#

#if defined(ENABLE_OVERLOADING)
    AnimatorSetDurationMethodInfo           ,
#endif
    animatorSetDuration                     ,


-- ** setKey #method:setKey#

#if defined(ENABLE_OVERLOADING)
    AnimatorSetKeyMethodInfo                ,
#endif
    animatorSetKey                          ,


-- ** setTimeline #method:setTimeline#

#if defined(ENABLE_OVERLOADING)
    AnimatorSetTimelineMethodInfo           ,
#endif
    animatorSetTimeline                     ,


-- ** start #method:start#

#if defined(ENABLE_OVERLOADING)
    AnimatorStartMethodInfo                 ,
#endif
    animatorStart                           ,




 -- * Properties


-- ** duration #attr:duration#
-- | The duration of the t'GI.Clutter.Objects.Timeline.Timeline' used by the t'GI.Clutter.Objects.Animator.Animator'
-- to drive the animation
-- 
-- /Since: 1.2/

#if defined(ENABLE_OVERLOADING)
    AnimatorDurationPropertyInfo            ,
#endif
#if defined(ENABLE_OVERLOADING)
    animatorDuration                        ,
#endif
    constructAnimatorDuration               ,
    getAnimatorDuration                     ,
    setAnimatorDuration                     ,


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

#if defined(ENABLE_OVERLOADING)
    AnimatorTimelinePropertyInfo            ,
#endif
#if defined(ENABLE_OVERLOADING)
    animatorTimeline                        ,
#endif
    constructAnimatorTimeline               ,
    getAnimatorTimeline                     ,
    setAnimatorTimeline                     ,




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

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

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

foreign import ccall "clutter_animator_get_type"
    c_clutter_animator_get_type :: IO B.Types.GType

instance B.Types.TypedObject Animator where
    glibType :: IO GType
glibType = IO GType
c_clutter_animator_get_type

instance B.Types.GObject Animator

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveAnimatorMethod (t :: Symbol) (o :: *) :: * where
    ResolveAnimatorMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAnimatorMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAnimatorMethod "computeValue" o = AnimatorComputeValueMethodInfo
    ResolveAnimatorMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAnimatorMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAnimatorMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAnimatorMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAnimatorMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAnimatorMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAnimatorMethod "parseCustomNode" o = Clutter.Scriptable.ScriptableParseCustomNodeMethodInfo
    ResolveAnimatorMethod "propertyGetEaseIn" o = AnimatorPropertyGetEaseInMethodInfo
    ResolveAnimatorMethod "propertyGetInterpolation" o = AnimatorPropertyGetInterpolationMethodInfo
    ResolveAnimatorMethod "propertySetEaseIn" o = AnimatorPropertySetEaseInMethodInfo
    ResolveAnimatorMethod "propertySetInterpolation" o = AnimatorPropertySetInterpolationMethodInfo
    ResolveAnimatorMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveAnimatorMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAnimatorMethod "removeKey" o = AnimatorRemoveKeyMethodInfo
    ResolveAnimatorMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAnimatorMethod "start" o = AnimatorStartMethodInfo
    ResolveAnimatorMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAnimatorMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAnimatorMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAnimatorMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveAnimatorMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAnimatorMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAnimatorMethod "getDuration" o = AnimatorGetDurationMethodInfo
    ResolveAnimatorMethod "getId" o = Clutter.Scriptable.ScriptableGetIdMethodInfo
    ResolveAnimatorMethod "getKeys" o = AnimatorGetKeysMethodInfo
    ResolveAnimatorMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAnimatorMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAnimatorMethod "getTimeline" o = AnimatorGetTimelineMethodInfo
    ResolveAnimatorMethod "setCustomProperty" o = Clutter.Scriptable.ScriptableSetCustomPropertyMethodInfo
    ResolveAnimatorMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAnimatorMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAnimatorMethod "setDuration" o = AnimatorSetDurationMethodInfo
    ResolveAnimatorMethod "setId" o = Clutter.Scriptable.ScriptableSetIdMethodInfo
    ResolveAnimatorMethod "setKey" o = AnimatorSetKeyMethodInfo
    ResolveAnimatorMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAnimatorMethod "setTimeline" o = AnimatorSetTimelineMethodInfo
    ResolveAnimatorMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#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' animator #duration
-- @
getAnimatorDuration :: (MonadIO m, IsAnimator o) => o -> m Word32
getAnimatorDuration :: forall (m :: * -> *) o. (MonadIO m, IsAnimator o) => o -> m Word32
getAnimatorDuration o
obj = IO Word32 -> m Word32
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' animator [ #duration 'Data.GI.Base.Attributes.:=' value ]
-- @
setAnimatorDuration :: (MonadIO m, IsAnimator o) => o -> Word32 -> m ()
setAnimatorDuration :: forall (m :: * -> *) o.
(MonadIO m, IsAnimator o) =>
o -> Word32 -> m ()
setAnimatorDuration o
obj Word32
val = IO () -> m ()
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`.
constructAnimatorDuration :: (IsAnimator o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructAnimatorDuration :: forall o (m :: * -> *).
(IsAnimator o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructAnimatorDuration Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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 AnimatorDurationPropertyInfo
instance AttrInfo AnimatorDurationPropertyInfo where
    type AttrAllowedOps AnimatorDurationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AnimatorDurationPropertyInfo = IsAnimator
    type AttrSetTypeConstraint AnimatorDurationPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint AnimatorDurationPropertyInfo = (~) Word32
    type AttrTransferType AnimatorDurationPropertyInfo = Word32
    type AttrGetType AnimatorDurationPropertyInfo = Word32
    type AttrLabel AnimatorDurationPropertyInfo = "duration"
    type AttrOrigin AnimatorDurationPropertyInfo = Animator
    attrGet = getAnimatorDuration
    attrSet = setAnimatorDuration
    attrTransfer _ v = do
        return v
    attrConstruct = constructAnimatorDuration
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Animator.duration"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-Animator.html#g:attr:duration"
        })
#endif

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

-- | 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' animator #timeline
-- @
getAnimatorTimeline :: (MonadIO m, IsAnimator o) => o -> m Clutter.Timeline.Timeline
getAnimatorTimeline :: forall (m :: * -> *) o.
(MonadIO m, IsAnimator o) =>
o -> m Timeline
getAnimatorTimeline o
obj = IO Timeline -> m Timeline
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
"getAnimatorTimeline" (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' animator [ #timeline 'Data.GI.Base.Attributes.:=' value ]
-- @
setAnimatorTimeline :: (MonadIO m, IsAnimator o, Clutter.Timeline.IsTimeline a) => o -> a -> m ()
setAnimatorTimeline :: forall (m :: * -> *) o a.
(MonadIO m, IsAnimator o, IsTimeline a) =>
o -> a -> m ()
setAnimatorTimeline o
obj a
val = IO () -> m ()
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`.
constructAnimatorTimeline :: (IsAnimator o, MIO.MonadIO m, Clutter.Timeline.IsTimeline a) => a -> m (GValueConstruct o)
constructAnimatorTimeline :: forall o (m :: * -> *) a.
(IsAnimator o, MonadIO m, IsTimeline a) =>
a -> m (GValueConstruct o)
constructAnimatorTimeline a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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)

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Animator
type instance O.AttributeList Animator = AnimatorAttributeList
type AnimatorAttributeList = ('[ '("duration", AnimatorDurationPropertyInfo), '("timeline", AnimatorTimelinePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
animatorDuration :: AttrLabelProxy "duration"
animatorDuration = AttrLabelProxy

animatorTimeline :: AttrLabelProxy "timeline"
animatorTimeline = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "clutter_animator_new" clutter_animator_new :: 
    IO (Ptr Animator)

{-# DEPRECATED animatorNew ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' instead"] #-}
-- | Creates a new t'GI.Clutter.Objects.Animator.Animator' instance
-- 
-- /Since: 1.2/
animatorNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Animator
    -- ^ __Returns:__ a new t'GI.Clutter.Objects.Animator.Animator'.
animatorNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Animator
animatorNew  = IO Animator -> m Animator
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Animator -> m Animator) -> IO Animator -> m Animator
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animator
result <- IO (Ptr Animator)
clutter_animator_new
    Text -> Ptr Animator -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"animatorNew" Ptr Animator
result
    Animator
result' <- ((ManagedPtr Animator -> Animator) -> Ptr Animator -> IO Animator
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Animator -> Animator
Animator) Ptr Animator
result
    Animator -> IO Animator
forall (m :: * -> *) a. Monad m => a -> m a
return Animator
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Animator::compute_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animator"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimator" , 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
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the property on object to check"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "progress"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a value between 0.0 and 1.0"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "an initialized value to store the computed result"
--                 , 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_animator_compute_value" clutter_animator_compute_value :: 
    Ptr Animator ->                         -- animator : TInterface (Name {namespace = "Clutter", name = "Animator"})
    Ptr GObject.Object.Object ->            -- object : TInterface (Name {namespace = "GObject", name = "Object"})
    CString ->                              -- property_name : TBasicType TUTF8
    CDouble ->                              -- progress : TBasicType TDouble
    Ptr GValue ->                           -- value : TGValue
    IO CInt

{-# DEPRECATED animatorComputeValue ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' instead"] #-}
-- | Compute the value for a managed property at a given progress.
-- 
-- If the property is an ease-in property, the current value of the property
-- on the object will be used as the starting point for computation.
-- 
-- /Since: 1.2/
animatorComputeValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimator a, GObject.Object.IsObject b) =>
    a
    -- ^ /@animator@/: a t'GI.Clutter.Objects.Animator.Animator'
    -> b
    -- ^ /@object@/: a t'GI.GObject.Objects.Object.Object'
    -> T.Text
    -- ^ /@propertyName@/: the name of the property on object to check
    -> Double
    -- ^ /@progress@/: a value between 0.0 and 1.0
    -> GValue
    -- ^ /@value@/: an initialized value to store the computed result
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the computation yields has a value, otherwise (when
    --   an error occurs or the progress is before any of the keys) 'P.False' is
    --   returned and the t'GI.GObject.Structs.Value.Value' is left untouched
animatorComputeValue :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAnimator a, IsObject b) =>
a -> b -> Text -> Double -> GValue -> m Bool
animatorComputeValue a
animator b
object Text
propertyName Double
progress GValue
value = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animator
animator' <- a -> IO (Ptr Animator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animator
    Ptr Object
object' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
object
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    let progress' :: CDouble
progress' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
progress
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    CInt
result <- Ptr Animator
-> Ptr Object -> CString -> CDouble -> Ptr GValue -> IO CInt
clutter_animator_compute_value Ptr Animator
animator' Ptr Object
object' CString
propertyName' CDouble
progress' Ptr GValue
value'
    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
animator
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
object
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AnimatorComputeValueMethodInfo
instance (signature ~ (b -> T.Text -> Double -> GValue -> m Bool), MonadIO m, IsAnimator a, GObject.Object.IsObject b) => O.OverloadedMethod AnimatorComputeValueMethodInfo a signature where
    overloadedMethod = animatorComputeValue

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


#endif

-- method Animator::get_duration
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animator"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimator" , 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_animator_get_duration" clutter_animator_get_duration :: 
    Ptr Animator ->                         -- animator : TInterface (Name {namespace = "Clutter", name = "Animator"})
    IO Word32

{-# DEPRECATED animatorGetDuration ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' instead"] #-}
-- | Retrieves the current duration of an animator
-- 
-- /Since: 1.2/
animatorGetDuration ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimator a) =>
    a
    -- ^ /@animator@/: a t'GI.Clutter.Objects.Animator.Animator'
    -> m Word32
    -- ^ __Returns:__ the duration of the animation, in milliseconds
animatorGetDuration :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimator a) =>
a -> m Word32
animatorGetDuration a
animator = IO Word32 -> m Word32
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 Animator
animator' <- a -> IO (Ptr Animator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animator
    Word32
result <- Ptr Animator -> IO Word32
clutter_animator_get_duration Ptr Animator
animator'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animator
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data AnimatorGetDurationMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsAnimator a) => O.OverloadedMethod AnimatorGetDurationMethodInfo a signature where
    overloadedMethod = animatorGetDuration

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


#endif

-- method Animator::get_keys
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animator"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimator instance"
--                 , 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 = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GObject to search for, or %NULL for all objects"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a specific property name to query for,\n  or %NULL for all properties"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "progress"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a specific progress to search for, or a negative value for all\n  progresses"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "Clutter" , name = "AnimatorKey" }))
-- throws : False
-- Skip return : False

foreign import ccall "clutter_animator_get_keys" clutter_animator_get_keys :: 
    Ptr Animator ->                         -- animator : TInterface (Name {namespace = "Clutter", name = "Animator"})
    Ptr GObject.Object.Object ->            -- object : TInterface (Name {namespace = "GObject", name = "Object"})
    CString ->                              -- property_name : TBasicType TUTF8
    CDouble ->                              -- progress : TBasicType TDouble
    IO (Ptr (GList (Ptr Clutter.AnimatorKey.AnimatorKey)))

{-# DEPRECATED animatorGetKeys ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' instead"] #-}
-- | Returns a list of pointers to opaque structures with accessor functions
-- that describe the keys added to an animator.
-- 
-- /Since: 1.2/
animatorGetKeys ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimator a, GObject.Object.IsObject b) =>
    a
    -- ^ /@animator@/: a t'GI.Clutter.Objects.Animator.Animator' instance
    -> Maybe (b)
    -- ^ /@object@/: a t'GI.GObject.Objects.Object.Object' to search for, or 'P.Nothing' for all objects
    -> Maybe (T.Text)
    -- ^ /@propertyName@/: a specific property name to query for,
    --   or 'P.Nothing' for all properties
    -> Double
    -- ^ /@progress@/: a specific progress to search for, or a negative value for all
    --   progresses
    -> m [Clutter.AnimatorKey.AnimatorKey]
    -- ^ __Returns:__ a
    --   list of t'GI.Clutter.Structs.AnimatorKey.AnimatorKey's; the contents of the list are owned
    --   by the t'GI.Clutter.Objects.Animator.Animator', but you should free the returned list when done,
    --   using @/g_list_free()/@
animatorGetKeys :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAnimator a, IsObject b) =>
a -> Maybe b -> Maybe Text -> Double -> m [AnimatorKey]
animatorGetKeys a
animator Maybe b
object Maybe Text
propertyName Double
progress = IO [AnimatorKey] -> m [AnimatorKey]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [AnimatorKey] -> m [AnimatorKey])
-> IO [AnimatorKey] -> m [AnimatorKey]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animator
animator' <- a -> IO (Ptr Animator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animator
    Ptr Object
maybeObject <- case Maybe b
object of
        Maybe b
Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just b
jObject -> do
            Ptr Object
jObject' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jObject
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jObject'
    CString
maybePropertyName <- case Maybe Text
propertyName of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jPropertyName -> do
            CString
jPropertyName' <- Text -> IO CString
textToCString Text
jPropertyName
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jPropertyName'
    let progress' :: CDouble
progress' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
progress
    Ptr (GList (Ptr AnimatorKey))
result <- Ptr Animator
-> Ptr Object
-> CString
-> CDouble
-> IO (Ptr (GList (Ptr AnimatorKey)))
clutter_animator_get_keys Ptr Animator
animator' Ptr Object
maybeObject CString
maybePropertyName CDouble
progress'
    [Ptr AnimatorKey]
result' <- Ptr (GList (Ptr AnimatorKey)) -> IO [Ptr AnimatorKey]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr AnimatorKey))
result
    [AnimatorKey]
result'' <- (Ptr AnimatorKey -> IO AnimatorKey)
-> [Ptr AnimatorKey] -> IO [AnimatorKey]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr AnimatorKey -> AnimatorKey)
-> Ptr AnimatorKey -> IO AnimatorKey
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr AnimatorKey -> AnimatorKey
Clutter.AnimatorKey.AnimatorKey) [Ptr AnimatorKey]
result'
    Ptr (GList (Ptr AnimatorKey)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr AnimatorKey))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animator
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
object b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybePropertyName
    [AnimatorKey] -> IO [AnimatorKey]
forall (m :: * -> *) a. Monad m => a -> m a
return [AnimatorKey]
result''

#if defined(ENABLE_OVERLOADING)
data AnimatorGetKeysMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (T.Text) -> Double -> m [Clutter.AnimatorKey.AnimatorKey]), MonadIO m, IsAnimator a, GObject.Object.IsObject b) => O.OverloadedMethod AnimatorGetKeysMethodInfo a signature where
    overloadedMethod = animatorGetKeys

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


#endif

-- method Animator::get_timeline
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animator"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimator" , 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_animator_get_timeline" clutter_animator_get_timeline :: 
    Ptr Animator ->                         -- animator : TInterface (Name {namespace = "Clutter", name = "Animator"})
    IO (Ptr Clutter.Timeline.Timeline)

{-# DEPRECATED animatorGetTimeline ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' instead"] #-}
-- | Get the timeline hooked up for driving the t'GI.Clutter.Objects.Animator.Animator'
-- 
-- /Since: 1.2/
animatorGetTimeline ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimator a) =>
    a
    -- ^ /@animator@/: a t'GI.Clutter.Objects.Animator.Animator'
    -> m Clutter.Timeline.Timeline
    -- ^ __Returns:__ the t'GI.Clutter.Objects.Timeline.Timeline' that drives the animator
animatorGetTimeline :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimator a) =>
a -> m Timeline
animatorGetTimeline a
animator = IO Timeline -> m Timeline
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 Animator
animator' <- a -> IO (Ptr Animator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animator
    Ptr Timeline
result <- Ptr Animator -> IO (Ptr Timeline)
clutter_animator_get_timeline Ptr Animator
animator'
    Text -> Ptr Timeline -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"animatorGetTimeline" 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
animator
    Timeline -> IO Timeline
forall (m :: * -> *) a. Monad m => a -> m a
return Timeline
result'

#if defined(ENABLE_OVERLOADING)
data AnimatorGetTimelineMethodInfo
instance (signature ~ (m Clutter.Timeline.Timeline), MonadIO m, IsAnimator a) => O.OverloadedMethod AnimatorGetTimelineMethodInfo a signature where
    overloadedMethod = animatorGetTimeline

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


#endif

-- method Animator::property_get_ease_in
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animator"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimatorKey"
--                 , 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
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a property on object"
--                 , 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_animator_property_get_ease_in" clutter_animator_property_get_ease_in :: 
    Ptr Animator ->                         -- animator : TInterface (Name {namespace = "Clutter", name = "Animator"})
    Ptr GObject.Object.Object ->            -- object : TInterface (Name {namespace = "GObject", name = "Object"})
    CString ->                              -- property_name : TBasicType TUTF8
    IO CInt

{-# DEPRECATED animatorPropertyGetEaseIn ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' instead"] #-}
-- | Checks if a property value is to be eased into the animation.
-- 
-- /Since: 1.2/
animatorPropertyGetEaseIn ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimator a, GObject.Object.IsObject b) =>
    a
    -- ^ /@animator@/: a t'GI.Clutter.Structs.AnimatorKey.AnimatorKey'
    -> b
    -- ^ /@object@/: a t'GI.GObject.Objects.Object.Object'
    -> T.Text
    -- ^ /@propertyName@/: the name of a property on object
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the property is eased in
animatorPropertyGetEaseIn :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAnimator a, IsObject b) =>
a -> b -> Text -> m Bool
animatorPropertyGetEaseIn a
animator b
object Text
propertyName = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animator
animator' <- a -> IO (Ptr Animator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animator
    Ptr Object
object' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
object
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    CInt
result <- Ptr Animator -> Ptr Object -> CString -> IO CInt
clutter_animator_property_get_ease_in Ptr Animator
animator' Ptr Object
object' 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
animator
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AnimatorPropertyGetEaseInMethodInfo
instance (signature ~ (b -> T.Text -> m Bool), MonadIO m, IsAnimator a, GObject.Object.IsObject b) => O.OverloadedMethod AnimatorPropertyGetEaseInMethodInfo a signature where
    overloadedMethod = animatorPropertyGetEaseIn

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


#endif

-- method Animator::property_get_interpolation
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animator"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimatorKey"
--                 , 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
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a property on object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Clutter" , name = "Interpolation" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_animator_property_get_interpolation" clutter_animator_property_get_interpolation :: 
    Ptr Animator ->                         -- animator : TInterface (Name {namespace = "Clutter", name = "Animator"})
    Ptr GObject.Object.Object ->            -- object : TInterface (Name {namespace = "GObject", name = "Object"})
    CString ->                              -- property_name : TBasicType TUTF8
    IO CUInt

{-# DEPRECATED animatorPropertyGetInterpolation ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' instead"] #-}
-- | Get the interpolation used by animator for a property on a particular
-- object.
-- 
-- /Since: 1.2/
animatorPropertyGetInterpolation ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimator a, GObject.Object.IsObject b) =>
    a
    -- ^ /@animator@/: a t'GI.Clutter.Structs.AnimatorKey.AnimatorKey'
    -> b
    -- ^ /@object@/: a t'GI.GObject.Objects.Object.Object'
    -> T.Text
    -- ^ /@propertyName@/: the name of a property on object
    -> m Clutter.Enums.Interpolation
    -- ^ __Returns:__ a ClutterInterpolation value.
animatorPropertyGetInterpolation :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAnimator a, IsObject b) =>
a -> b -> Text -> m Interpolation
animatorPropertyGetInterpolation a
animator b
object Text
propertyName = IO Interpolation -> m Interpolation
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Interpolation -> m Interpolation)
-> IO Interpolation -> m Interpolation
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animator
animator' <- a -> IO (Ptr Animator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animator
    Ptr Object
object' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
object
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    CUInt
result <- Ptr Animator -> Ptr Object -> CString -> IO CUInt
clutter_animator_property_get_interpolation Ptr Animator
animator' Ptr Object
object' CString
propertyName'
    let result' :: Interpolation
result' = (Int -> Interpolation
forall a. Enum a => Int -> a
toEnum (Int -> Interpolation) -> (CUInt -> Int) -> CUInt -> Interpolation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animator
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    Interpolation -> IO Interpolation
forall (m :: * -> *) a. Monad m => a -> m a
return Interpolation
result'

#if defined(ENABLE_OVERLOADING)
data AnimatorPropertyGetInterpolationMethodInfo
instance (signature ~ (b -> T.Text -> m Clutter.Enums.Interpolation), MonadIO m, IsAnimator a, GObject.Object.IsObject b) => O.OverloadedMethod AnimatorPropertyGetInterpolationMethodInfo a signature where
    overloadedMethod = animatorPropertyGetInterpolation

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


#endif

-- method Animator::property_set_ease_in
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animator"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimatorKey"
--                 , 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
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a property on object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ease_in"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "we are going to be easing in this 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_animator_property_set_ease_in" clutter_animator_property_set_ease_in :: 
    Ptr Animator ->                         -- animator : TInterface (Name {namespace = "Clutter", name = "Animator"})
    Ptr GObject.Object.Object ->            -- object : TInterface (Name {namespace = "GObject", name = "Object"})
    CString ->                              -- property_name : TBasicType TUTF8
    CInt ->                                 -- ease_in : TBasicType TBoolean
    IO ()

{-# DEPRECATED animatorPropertySetEaseIn ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' instead"] #-}
-- | Sets whether a property value is to be eased into the animation.
-- 
-- /Since: 1.2/
animatorPropertySetEaseIn ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimator a, GObject.Object.IsObject b) =>
    a
    -- ^ /@animator@/: a t'GI.Clutter.Structs.AnimatorKey.AnimatorKey'
    -> b
    -- ^ /@object@/: a t'GI.GObject.Objects.Object.Object'
    -> T.Text
    -- ^ /@propertyName@/: the name of a property on object
    -> Bool
    -- ^ /@easeIn@/: we are going to be easing in this property
    -> m ()
animatorPropertySetEaseIn :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAnimator a, IsObject b) =>
a -> b -> Text -> Bool -> m ()
animatorPropertySetEaseIn a
animator b
object Text
propertyName Bool
easeIn = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animator
animator' <- a -> IO (Ptr Animator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animator
    Ptr Object
object' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
object
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    let easeIn' :: CInt
easeIn' = (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
easeIn
    Ptr Animator -> Ptr Object -> CString -> CInt -> IO ()
clutter_animator_property_set_ease_in Ptr Animator
animator' Ptr Object
object' CString
propertyName' CInt
easeIn'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animator
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnimatorPropertySetEaseInMethodInfo
instance (signature ~ (b -> T.Text -> Bool -> m ()), MonadIO m, IsAnimator a, GObject.Object.IsObject b) => O.OverloadedMethod AnimatorPropertySetEaseInMethodInfo a signature where
    overloadedMethod = animatorPropertySetEaseIn

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


#endif

-- method Animator::property_set_interpolation
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animator"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimatorKey"
--                 , 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
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a property on object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interpolation"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Interpolation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #ClutterInterpolation to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_animator_property_set_interpolation" clutter_animator_property_set_interpolation :: 
    Ptr Animator ->                         -- animator : TInterface (Name {namespace = "Clutter", name = "Animator"})
    Ptr GObject.Object.Object ->            -- object : TInterface (Name {namespace = "GObject", name = "Object"})
    CString ->                              -- property_name : TBasicType TUTF8
    CUInt ->                                -- interpolation : TInterface (Name {namespace = "Clutter", name = "Interpolation"})
    IO ()

{-# DEPRECATED animatorPropertySetInterpolation ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' instead"] #-}
-- | Set the interpolation method to use, 'GI.Clutter.Enums.InterpolationLinear' causes
-- the values to linearly change between the values, and
-- 'GI.Clutter.Enums.InterpolationCubic' causes the values to smoothly change between
-- the values.
-- 
-- /Since: 1.2/
animatorPropertySetInterpolation ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimator a, GObject.Object.IsObject b) =>
    a
    -- ^ /@animator@/: a t'GI.Clutter.Structs.AnimatorKey.AnimatorKey'
    -> b
    -- ^ /@object@/: a t'GI.GObject.Objects.Object.Object'
    -> T.Text
    -- ^ /@propertyName@/: the name of a property on object
    -> Clutter.Enums.Interpolation
    -- ^ /@interpolation@/: the t'GI.Clutter.Enums.Interpolation' to use
    -> m ()
animatorPropertySetInterpolation :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAnimator a, IsObject b) =>
a -> b -> Text -> Interpolation -> m ()
animatorPropertySetInterpolation a
animator b
object Text
propertyName Interpolation
interpolation = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animator
animator' <- a -> IO (Ptr Animator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animator
    Ptr Object
object' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
object
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    let interpolation' :: CUInt
interpolation' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Interpolation -> Int) -> Interpolation -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interpolation -> Int
forall a. Enum a => a -> Int
fromEnum) Interpolation
interpolation
    Ptr Animator -> Ptr Object -> CString -> CUInt -> IO ()
clutter_animator_property_set_interpolation Ptr Animator
animator' Ptr Object
object' CString
propertyName' CUInt
interpolation'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animator
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnimatorPropertySetInterpolationMethodInfo
instance (signature ~ (b -> T.Text -> Clutter.Enums.Interpolation -> m ()), MonadIO m, IsAnimator a, GObject.Object.IsObject b) => O.OverloadedMethod AnimatorPropertySetInterpolationMethodInfo a signature where
    overloadedMethod = animatorPropertySetInterpolation

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


#endif

-- method Animator::remove_key
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animator"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimator" , 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 = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GObject to search for, or %NULL for all"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a specific property name to query for,\n  or %NULL for all"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "progress"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a specific progress to search for or a negative value\n  for all"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_animator_remove_key" clutter_animator_remove_key :: 
    Ptr Animator ->                         -- animator : TInterface (Name {namespace = "Clutter", name = "Animator"})
    Ptr GObject.Object.Object ->            -- object : TInterface (Name {namespace = "GObject", name = "Object"})
    CString ->                              -- property_name : TBasicType TUTF8
    CDouble ->                              -- progress : TBasicType TDouble
    IO ()

{-# DEPRECATED animatorRemoveKey ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' instead"] #-}
-- | Removes all keys matching the conditions specificed in the arguments.
-- 
-- /Since: 1.2/
animatorRemoveKey ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimator a, GObject.Object.IsObject b) =>
    a
    -- ^ /@animator@/: a t'GI.Clutter.Objects.Animator.Animator'
    -> Maybe (b)
    -- ^ /@object@/: a t'GI.GObject.Objects.Object.Object' to search for, or 'P.Nothing' for all
    -> Maybe (T.Text)
    -- ^ /@propertyName@/: a specific property name to query for,
    --   or 'P.Nothing' for all
    -> Double
    -- ^ /@progress@/: a specific progress to search for or a negative value
    --   for all
    -> m ()
animatorRemoveKey :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAnimator a, IsObject b) =>
a -> Maybe b -> Maybe Text -> Double -> m ()
animatorRemoveKey a
animator Maybe b
object Maybe Text
propertyName Double
progress = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animator
animator' <- a -> IO (Ptr Animator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animator
    Ptr Object
maybeObject <- case Maybe b
object of
        Maybe b
Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just b
jObject -> do
            Ptr Object
jObject' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jObject
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jObject'
    CString
maybePropertyName <- case Maybe Text
propertyName of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jPropertyName -> do
            CString
jPropertyName' <- Text -> IO CString
textToCString Text
jPropertyName
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jPropertyName'
    let progress' :: CDouble
progress' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
progress
    Ptr Animator -> Ptr Object -> CString -> CDouble -> IO ()
clutter_animator_remove_key Ptr Animator
animator' Ptr Object
maybeObject CString
maybePropertyName CDouble
progress'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animator
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
object b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybePropertyName
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnimatorRemoveKeyMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (T.Text) -> Double -> m ()), MonadIO m, IsAnimator a, GObject.Object.IsObject b) => O.OverloadedMethod AnimatorRemoveKeyMethodInfo a signature where
    overloadedMethod = animatorRemoveKey

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


#endif

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

foreign import ccall "clutter_animator_set_duration" clutter_animator_set_duration :: 
    Ptr Animator ->                         -- animator : TInterface (Name {namespace = "Clutter", name = "Animator"})
    Word32 ->                               -- duration : TBasicType TUInt
    IO ()

{-# DEPRECATED animatorSetDuration ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' instead"] #-}
-- | Runs the timeline of the t'GI.Clutter.Objects.Animator.Animator' with a duration in msecs
-- as specified.
-- 
-- /Since: 1.2/
animatorSetDuration ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimator a) =>
    a
    -- ^ /@animator@/: a t'GI.Clutter.Objects.Animator.Animator'
    -> Word32
    -- ^ /@duration@/: milliseconds a run of the animator should last.
    -> m ()
animatorSetDuration :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimator a) =>
a -> Word32 -> m ()
animatorSetDuration a
animator Word32
duration = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animator
animator' <- a -> IO (Ptr Animator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animator
    Ptr Animator -> Word32 -> IO ()
clutter_animator_set_duration Ptr Animator
animator' Word32
duration
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animator
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnimatorSetDurationMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsAnimator a) => O.OverloadedMethod AnimatorSetDurationMethodInfo a signature where
    overloadedMethod = animatorSetDuration

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


#endif

-- method Animator::set_key
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animator"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimator" , 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
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the property to specify a key for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the id of the alpha function to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "progress"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the normalized range at which stage of the animation this\n  value applies"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the value property_name should have at progress."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "Animator" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_animator_set_key" clutter_animator_set_key :: 
    Ptr Animator ->                         -- animator : TInterface (Name {namespace = "Clutter", name = "Animator"})
    Ptr GObject.Object.Object ->            -- object : TInterface (Name {namespace = "GObject", name = "Object"})
    CString ->                              -- property_name : TBasicType TUTF8
    Word32 ->                               -- mode : TBasicType TUInt
    CDouble ->                              -- progress : TBasicType TDouble
    Ptr GValue ->                           -- value : TGValue
    IO (Ptr Animator)

{-# DEPRECATED animatorSetKey ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' instead"] #-}
-- | Sets a single key in the t'GI.Clutter.Objects.Animator.Animator' for the /@propertyName@/ of
-- /@object@/ at /@progress@/.
-- 
-- See also: @/clutter_animator_set()/@
-- 
-- /Since: 1.2/
animatorSetKey ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimator a, GObject.Object.IsObject b) =>
    a
    -- ^ /@animator@/: a t'GI.Clutter.Objects.Animator.Animator'
    -> b
    -- ^ /@object@/: a t'GI.GObject.Objects.Object.Object'
    -> T.Text
    -- ^ /@propertyName@/: the property to specify a key for
    -> Word32
    -- ^ /@mode@/: the id of the alpha function to use
    -> Double
    -- ^ /@progress@/: the normalized range at which stage of the animation this
    --   value applies
    -> GValue
    -- ^ /@value@/: the value property_name should have at progress.
    -> m Animator
    -- ^ __Returns:__ The animator instance
animatorSetKey :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAnimator a, IsObject b) =>
a -> b -> Text -> Word32 -> Double -> GValue -> m Animator
animatorSetKey a
animator b
object Text
propertyName Word32
mode Double
progress GValue
value = IO Animator -> m Animator
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Animator -> m Animator) -> IO Animator -> m Animator
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animator
animator' <- a -> IO (Ptr Animator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animator
    Ptr Object
object' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
object
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    let progress' :: CDouble
progress' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
progress
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Animator
result <- Ptr Animator
-> Ptr Object
-> CString
-> Word32
-> CDouble
-> Ptr GValue
-> IO (Ptr Animator)
clutter_animator_set_key Ptr Animator
animator' Ptr Object
object' CString
propertyName' Word32
mode CDouble
progress' Ptr GValue
value'
    Text -> Ptr Animator -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"animatorSetKey" Ptr Animator
result
    Animator
result' <- ((ManagedPtr Animator -> Animator) -> Ptr Animator -> IO Animator
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Animator -> Animator
Animator) Ptr Animator
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animator
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
object
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    Animator -> IO Animator
forall (m :: * -> *) a. Monad m => a -> m a
return Animator
result'

#if defined(ENABLE_OVERLOADING)
data AnimatorSetKeyMethodInfo
instance (signature ~ (b -> T.Text -> Word32 -> Double -> GValue -> m Animator), MonadIO m, IsAnimator a, GObject.Object.IsObject b) => O.OverloadedMethod AnimatorSetKeyMethodInfo a signature where
    overloadedMethod = animatorSetKey

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


#endif

-- method Animator::set_timeline
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animator"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimator" , 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 = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #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_animator_set_timeline" clutter_animator_set_timeline :: 
    Ptr Animator ->                         -- animator : TInterface (Name {namespace = "Clutter", name = "Animator"})
    Ptr Clutter.Timeline.Timeline ->        -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    IO ()

{-# DEPRECATED animatorSetTimeline ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' instead"] #-}
-- | Sets an external timeline that will be used for driving the animation
-- 
-- /Since: 1.2/
animatorSetTimeline ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimator a, Clutter.Timeline.IsTimeline b) =>
    a
    -- ^ /@animator@/: a t'GI.Clutter.Objects.Animator.Animator'
    -> b
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> m ()
animatorSetTimeline :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAnimator a, IsTimeline b) =>
a -> b -> m ()
animatorSetTimeline a
animator b
timeline = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animator
animator' <- a -> IO (Ptr Animator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animator
    Ptr Timeline
timeline' <- b -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
timeline
    Ptr Animator -> Ptr Timeline -> IO ()
clutter_animator_set_timeline Ptr Animator
animator' Ptr Timeline
timeline'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
animator
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
timeline
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnimatorSetTimelineMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsAnimator a, Clutter.Timeline.IsTimeline b) => O.OverloadedMethod AnimatorSetTimelineMethodInfo a signature where
    overloadedMethod = animatorSetTimeline

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


#endif

-- method Animator::start
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "animator"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Animator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAnimator" , 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_animator_start" clutter_animator_start :: 
    Ptr Animator ->                         -- animator : TInterface (Name {namespace = "Clutter", name = "Animator"})
    IO (Ptr Clutter.Timeline.Timeline)

{-# DEPRECATED animatorStart ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' instead"] #-}
-- | Start the ClutterAnimator, this is a thin wrapper that rewinds
-- and starts the animators current timeline.
-- 
-- /Since: 1.2/
animatorStart ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimator a) =>
    a
    -- ^ /@animator@/: a t'GI.Clutter.Objects.Animator.Animator'
    -> m Clutter.Timeline.Timeline
    -- ^ __Returns:__ the t'GI.Clutter.Objects.Timeline.Timeline' that drives
    --   the animator. The returned timeline is owned by the t'GI.Clutter.Objects.Animator.Animator'
    --   and it should not be unreferenced
animatorStart :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimator a) =>
a -> m Timeline
animatorStart a
animator = IO Timeline -> m Timeline
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 Animator
animator' <- a -> IO (Ptr Animator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
animator
    Ptr Timeline
result <- Ptr Animator -> IO (Ptr Timeline)
clutter_animator_start Ptr Animator
animator'
    Text -> Ptr Timeline -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"animatorStart" 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
animator
    Timeline -> IO Timeline
forall (m :: * -> *) a. Monad m => a -> m a
return Timeline
result'

#if defined(ENABLE_OVERLOADING)
data AnimatorStartMethodInfo
instance (signature ~ (m Clutter.Timeline.Timeline), MonadIO m, IsAnimator a) => O.OverloadedMethod AnimatorStartMethodInfo a signature where
    overloadedMethod = animatorStart

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


#endif