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


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

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

module GI.Clutter.Objects.Timeline
    ( 

-- * Exported types
    Timeline(..)                            ,
    IsTimeline                              ,
    toTimeline                              ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addMarker]("GI.Clutter.Objects.Timeline#g:method:addMarker"), [addMarkerAtTime]("GI.Clutter.Objects.Timeline#g:method:addMarkerAtTime"), [advance]("GI.Clutter.Objects.Timeline#g:method:advance"), [advanceToMarker]("GI.Clutter.Objects.Timeline#g:method:advanceToMarker"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [clone]("GI.Clutter.Objects.Timeline#g:method:clone"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasMarker]("GI.Clutter.Objects.Timeline#g:method:hasMarker"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isPlaying]("GI.Clutter.Objects.Timeline#g:method:isPlaying"), [listMarkers]("GI.Clutter.Objects.Timeline#g:method:listMarkers"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [parseCustomNode]("GI.Clutter.Interfaces.Scriptable#g:method:parseCustomNode"), [pause]("GI.Clutter.Objects.Timeline#g:method:pause"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeMarker]("GI.Clutter.Objects.Timeline#g:method:removeMarker"), [rewind]("GI.Clutter.Objects.Timeline#g:method:rewind"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [skip]("GI.Clutter.Objects.Timeline#g:method:skip"), [start]("GI.Clutter.Objects.Timeline#g:method:start"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [stop]("GI.Clutter.Objects.Timeline#g:method:stop"), [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
-- [getAutoReverse]("GI.Clutter.Objects.Timeline#g:method:getAutoReverse"), [getCubicBezierProgress]("GI.Clutter.Objects.Timeline#g:method:getCubicBezierProgress"), [getCurrentRepeat]("GI.Clutter.Objects.Timeline#g:method:getCurrentRepeat"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDelay]("GI.Clutter.Objects.Timeline#g:method:getDelay"), [getDelta]("GI.Clutter.Objects.Timeline#g:method:getDelta"), [getDirection]("GI.Clutter.Objects.Timeline#g:method:getDirection"), [getDuration]("GI.Clutter.Objects.Timeline#g:method:getDuration"), [getDurationHint]("GI.Clutter.Objects.Timeline#g:method:getDurationHint"), [getElapsedTime]("GI.Clutter.Objects.Timeline#g:method:getElapsedTime"), [getId]("GI.Clutter.Interfaces.Scriptable#g:method:getId"), [getLoop]("GI.Clutter.Objects.Timeline#g:method:getLoop"), [getProgress]("GI.Clutter.Objects.Timeline#g:method:getProgress"), [getProgressMode]("GI.Clutter.Objects.Timeline#g:method:getProgressMode"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRepeatCount]("GI.Clutter.Objects.Timeline#g:method:getRepeatCount"), [getStepProgress]("GI.Clutter.Objects.Timeline#g:method:getStepProgress").
-- 
-- ==== Setters
-- [setAutoReverse]("GI.Clutter.Objects.Timeline#g:method:setAutoReverse"), [setCubicBezierProgress]("GI.Clutter.Objects.Timeline#g:method:setCubicBezierProgress"), [setCustomProperty]("GI.Clutter.Interfaces.Scriptable#g:method:setCustomProperty"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDelay]("GI.Clutter.Objects.Timeline#g:method:setDelay"), [setDirection]("GI.Clutter.Objects.Timeline#g:method:setDirection"), [setDuration]("GI.Clutter.Objects.Timeline#g:method:setDuration"), [setId]("GI.Clutter.Interfaces.Scriptable#g:method:setId"), [setLoop]("GI.Clutter.Objects.Timeline#g:method:setLoop"), [setProgressFunc]("GI.Clutter.Objects.Timeline#g:method:setProgressFunc"), [setProgressMode]("GI.Clutter.Objects.Timeline#g:method:setProgressMode"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setRepeatCount]("GI.Clutter.Objects.Timeline#g:method:setRepeatCount"), [setStepProgress]("GI.Clutter.Objects.Timeline#g:method:setStepProgress").

#if defined(ENABLE_OVERLOADING)
    ResolveTimelineMethod                   ,
#endif

-- ** addMarker #method:addMarker#

#if defined(ENABLE_OVERLOADING)
    TimelineAddMarkerMethodInfo             ,
#endif
    timelineAddMarker                       ,


-- ** addMarkerAtTime #method:addMarkerAtTime#

#if defined(ENABLE_OVERLOADING)
    TimelineAddMarkerAtTimeMethodInfo       ,
#endif
    timelineAddMarkerAtTime                 ,


-- ** advance #method:advance#

#if defined(ENABLE_OVERLOADING)
    TimelineAdvanceMethodInfo               ,
#endif
    timelineAdvance                         ,


-- ** advanceToMarker #method:advanceToMarker#

#if defined(ENABLE_OVERLOADING)
    TimelineAdvanceToMarkerMethodInfo       ,
#endif
    timelineAdvanceToMarker                 ,


-- ** clone #method:clone#

#if defined(ENABLE_OVERLOADING)
    TimelineCloneMethodInfo                 ,
#endif
    timelineClone                           ,


-- ** getAutoReverse #method:getAutoReverse#

#if defined(ENABLE_OVERLOADING)
    TimelineGetAutoReverseMethodInfo        ,
#endif
    timelineGetAutoReverse                  ,


-- ** getCubicBezierProgress #method:getCubicBezierProgress#

#if defined(ENABLE_OVERLOADING)
    TimelineGetCubicBezierProgressMethodInfo,
#endif
    timelineGetCubicBezierProgress          ,


-- ** getCurrentRepeat #method:getCurrentRepeat#

#if defined(ENABLE_OVERLOADING)
    TimelineGetCurrentRepeatMethodInfo      ,
#endif
    timelineGetCurrentRepeat                ,


-- ** getDelay #method:getDelay#

#if defined(ENABLE_OVERLOADING)
    TimelineGetDelayMethodInfo              ,
#endif
    timelineGetDelay                        ,


-- ** getDelta #method:getDelta#

#if defined(ENABLE_OVERLOADING)
    TimelineGetDeltaMethodInfo              ,
#endif
    timelineGetDelta                        ,


-- ** getDirection #method:getDirection#

#if defined(ENABLE_OVERLOADING)
    TimelineGetDirectionMethodInfo          ,
#endif
    timelineGetDirection                    ,


-- ** getDuration #method:getDuration#

#if defined(ENABLE_OVERLOADING)
    TimelineGetDurationMethodInfo           ,
#endif
    timelineGetDuration                     ,


-- ** getDurationHint #method:getDurationHint#

#if defined(ENABLE_OVERLOADING)
    TimelineGetDurationHintMethodInfo       ,
#endif
    timelineGetDurationHint                 ,


-- ** getElapsedTime #method:getElapsedTime#

#if defined(ENABLE_OVERLOADING)
    TimelineGetElapsedTimeMethodInfo        ,
#endif
    timelineGetElapsedTime                  ,


-- ** getLoop #method:getLoop#

#if defined(ENABLE_OVERLOADING)
    TimelineGetLoopMethodInfo               ,
#endif
    timelineGetLoop                         ,


-- ** getProgress #method:getProgress#

#if defined(ENABLE_OVERLOADING)
    TimelineGetProgressMethodInfo           ,
#endif
    timelineGetProgress                     ,


-- ** getProgressMode #method:getProgressMode#

#if defined(ENABLE_OVERLOADING)
    TimelineGetProgressModeMethodInfo       ,
#endif
    timelineGetProgressMode                 ,


-- ** getRepeatCount #method:getRepeatCount#

#if defined(ENABLE_OVERLOADING)
    TimelineGetRepeatCountMethodInfo        ,
#endif
    timelineGetRepeatCount                  ,


-- ** getStepProgress #method:getStepProgress#

#if defined(ENABLE_OVERLOADING)
    TimelineGetStepProgressMethodInfo       ,
#endif
    timelineGetStepProgress                 ,


-- ** hasMarker #method:hasMarker#

#if defined(ENABLE_OVERLOADING)
    TimelineHasMarkerMethodInfo             ,
#endif
    timelineHasMarker                       ,


-- ** isPlaying #method:isPlaying#

#if defined(ENABLE_OVERLOADING)
    TimelineIsPlayingMethodInfo             ,
#endif
    timelineIsPlaying                       ,


-- ** listMarkers #method:listMarkers#

#if defined(ENABLE_OVERLOADING)
    TimelineListMarkersMethodInfo           ,
#endif
    timelineListMarkers                     ,


-- ** new #method:new#

    timelineNew                             ,


-- ** pause #method:pause#

#if defined(ENABLE_OVERLOADING)
    TimelinePauseMethodInfo                 ,
#endif
    timelinePause                           ,


-- ** removeMarker #method:removeMarker#

#if defined(ENABLE_OVERLOADING)
    TimelineRemoveMarkerMethodInfo          ,
#endif
    timelineRemoveMarker                    ,


-- ** rewind #method:rewind#

#if defined(ENABLE_OVERLOADING)
    TimelineRewindMethodInfo                ,
#endif
    timelineRewind                          ,


-- ** setAutoReverse #method:setAutoReverse#

#if defined(ENABLE_OVERLOADING)
    TimelineSetAutoReverseMethodInfo        ,
#endif
    timelineSetAutoReverse                  ,


-- ** setCubicBezierProgress #method:setCubicBezierProgress#

#if defined(ENABLE_OVERLOADING)
    TimelineSetCubicBezierProgressMethodInfo,
#endif
    timelineSetCubicBezierProgress          ,


-- ** setDelay #method:setDelay#

#if defined(ENABLE_OVERLOADING)
    TimelineSetDelayMethodInfo              ,
#endif
    timelineSetDelay                        ,


-- ** setDirection #method:setDirection#

#if defined(ENABLE_OVERLOADING)
    TimelineSetDirectionMethodInfo          ,
#endif
    timelineSetDirection                    ,


-- ** setDuration #method:setDuration#

#if defined(ENABLE_OVERLOADING)
    TimelineSetDurationMethodInfo           ,
#endif
    timelineSetDuration                     ,


-- ** setLoop #method:setLoop#

#if defined(ENABLE_OVERLOADING)
    TimelineSetLoopMethodInfo               ,
#endif
    timelineSetLoop                         ,


-- ** setProgressFunc #method:setProgressFunc#

#if defined(ENABLE_OVERLOADING)
    TimelineSetProgressFuncMethodInfo       ,
#endif
    timelineSetProgressFunc                 ,


-- ** setProgressMode #method:setProgressMode#

#if defined(ENABLE_OVERLOADING)
    TimelineSetProgressModeMethodInfo       ,
#endif
    timelineSetProgressMode                 ,


-- ** setRepeatCount #method:setRepeatCount#

#if defined(ENABLE_OVERLOADING)
    TimelineSetRepeatCountMethodInfo        ,
#endif
    timelineSetRepeatCount                  ,


-- ** setStepProgress #method:setStepProgress#

#if defined(ENABLE_OVERLOADING)
    TimelineSetStepProgressMethodInfo       ,
#endif
    timelineSetStepProgress                 ,


-- ** skip #method:skip#

#if defined(ENABLE_OVERLOADING)
    TimelineSkipMethodInfo                  ,
#endif
    timelineSkip                            ,


-- ** start #method:start#

#if defined(ENABLE_OVERLOADING)
    TimelineStartMethodInfo                 ,
#endif
    timelineStart                           ,


-- ** stop #method:stop#

#if defined(ENABLE_OVERLOADING)
    TimelineStopMethodInfo                  ,
#endif
    timelineStop                            ,




 -- * Properties


-- ** autoReverse #attr:autoReverse#
-- | If the direction of the timeline should be automatically reversed
-- when reaching the end.
-- 
-- /Since: 1.6/

#if defined(ENABLE_OVERLOADING)
    TimelineAutoReversePropertyInfo         ,
#endif
    constructTimelineAutoReverse            ,
    getTimelineAutoReverse                  ,
    setTimelineAutoReverse                  ,
#if defined(ENABLE_OVERLOADING)
    timelineAutoReverse                     ,
#endif


-- ** delay #attr:delay#
-- | A delay, in milliseconds, that should be observed by the
-- timeline before actually starting.
-- 
-- /Since: 0.4/

#if defined(ENABLE_OVERLOADING)
    TimelineDelayPropertyInfo               ,
#endif
    constructTimelineDelay                  ,
    getTimelineDelay                        ,
    setTimelineDelay                        ,
#if defined(ENABLE_OVERLOADING)
    timelineDelay                           ,
#endif


-- ** direction #attr:direction#
-- | The direction of the timeline, either 'GI.Clutter.Enums.TimelineDirectionForward' or
-- 'GI.Clutter.Enums.TimelineDirectionBackward'.
-- 
-- /Since: 0.6/

#if defined(ENABLE_OVERLOADING)
    TimelineDirectionPropertyInfo           ,
#endif
    constructTimelineDirection              ,
    getTimelineDirection                    ,
    setTimelineDirection                    ,
#if defined(ENABLE_OVERLOADING)
    timelineDirection                       ,
#endif


-- ** duration #attr:duration#
-- | Duration of the timeline in milliseconds, depending on the
-- ClutterTimeline:fps value.
-- 
-- /Since: 0.6/

#if defined(ENABLE_OVERLOADING)
    TimelineDurationPropertyInfo            ,
#endif
    constructTimelineDuration               ,
    getTimelineDuration                     ,
    setTimelineDuration                     ,
#if defined(ENABLE_OVERLOADING)
    timelineDuration                        ,
#endif


-- ** loop #attr:loop#
-- | Whether the timeline should automatically rewind and restart.
-- 
-- As a side effect, setting this property to 'P.True' will set the
-- [Timeline:repeatCount]("GI.Clutter.Objects.Timeline#g:attr:repeatCount") property to -1, while setting this
-- property to 'P.False' will set the [Timeline:repeatCount]("GI.Clutter.Objects.Timeline#g:attr:repeatCount")
-- property to 0.

#if defined(ENABLE_OVERLOADING)
    TimelineLoopPropertyInfo                ,
#endif
    constructTimelineLoop                   ,
    getTimelineLoop                         ,
    setTimelineLoop                         ,
#if defined(ENABLE_OVERLOADING)
    timelineLoop                            ,
#endif


-- ** progressMode #attr:progressMode#
-- | Controls the way a t'GI.Clutter.Objects.Timeline.Timeline' computes the normalized progress.
-- 
-- /Since: 1.10/

#if defined(ENABLE_OVERLOADING)
    TimelineProgressModePropertyInfo        ,
#endif
    constructTimelineProgressMode           ,
    getTimelineProgressMode                 ,
    setTimelineProgressMode                 ,
#if defined(ENABLE_OVERLOADING)
    timelineProgressMode                    ,
#endif


-- ** repeatCount #attr:repeatCount#
-- | Defines how many times the timeline should repeat.
-- 
-- If the repeat count is 0, the timeline does not repeat.
-- 
-- If the repeat count is set to -1, the timeline will repeat until it is
-- stopped.
-- 
-- /Since: 1.10/

#if defined(ENABLE_OVERLOADING)
    TimelineRepeatCountPropertyInfo         ,
#endif
    constructTimelineRepeatCount            ,
    getTimelineRepeatCount                  ,
    setTimelineRepeatCount                  ,
#if defined(ENABLE_OVERLOADING)
    timelineRepeatCount                     ,
#endif




 -- * Signals


-- ** completed #signal:completed#

    TimelineCompletedCallback               ,
#if defined(ENABLE_OVERLOADING)
    TimelineCompletedSignalInfo             ,
#endif
    afterTimelineCompleted                  ,
    onTimelineCompleted                     ,


-- ** markerReached #signal:markerReached#

    TimelineMarkerReachedCallback           ,
#if defined(ENABLE_OVERLOADING)
    TimelineMarkerReachedSignalInfo         ,
#endif
    afterTimelineMarkerReached              ,
    onTimelineMarkerReached                 ,


-- ** newFrame #signal:newFrame#

    TimelineNewFrameCallback                ,
#if defined(ENABLE_OVERLOADING)
    TimelineNewFrameSignalInfo              ,
#endif
    afterTimelineNewFrame                   ,
    onTimelineNewFrame                      ,


-- ** paused #signal:paused#

    TimelinePausedCallback                  ,
#if defined(ENABLE_OVERLOADING)
    TimelinePausedSignalInfo                ,
#endif
    afterTimelinePaused                     ,
    onTimelinePaused                        ,


-- ** started #signal:started#

    TimelineStartedCallback                 ,
#if defined(ENABLE_OVERLOADING)
    TimelineStartedSignalInfo               ,
#endif
    afterTimelineStarted                    ,
    onTimelineStarted                       ,


-- ** stopped #signal:stopped#

    TimelineStoppedCallback                 ,
#if defined(ENABLE_OVERLOADING)
    TimelineStoppedSignalInfo               ,
#endif
    afterTimelineStopped                    ,
    onTimelineStopped                       ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.Clutter.Callbacks as Clutter.Callbacks
import {-# SOURCE #-} qualified GI.Clutter.Enums as Clutter.Enums
import {-# SOURCE #-} qualified GI.Clutter.Interfaces.Scriptable as Clutter.Scriptable
import {-# SOURCE #-} qualified GI.Clutter.Structs.Point as Clutter.Point
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "clutter_timeline_get_type"
    c_clutter_timeline_get_type :: IO B.Types.GType

instance B.Types.TypedObject Timeline where
    glibType :: IO GType
glibType = IO GType
c_clutter_timeline_get_type

instance B.Types.GObject Timeline

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveTimelineMethod (t :: Symbol) (o :: *) :: * where
    ResolveTimelineMethod "addMarker" o = TimelineAddMarkerMethodInfo
    ResolveTimelineMethod "addMarkerAtTime" o = TimelineAddMarkerAtTimeMethodInfo
    ResolveTimelineMethod "advance" o = TimelineAdvanceMethodInfo
    ResolveTimelineMethod "advanceToMarker" o = TimelineAdvanceToMarkerMethodInfo
    ResolveTimelineMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveTimelineMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveTimelineMethod "clone" o = TimelineCloneMethodInfo
    ResolveTimelineMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveTimelineMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveTimelineMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveTimelineMethod "hasMarker" o = TimelineHasMarkerMethodInfo
    ResolveTimelineMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveTimelineMethod "isPlaying" o = TimelineIsPlayingMethodInfo
    ResolveTimelineMethod "listMarkers" o = TimelineListMarkersMethodInfo
    ResolveTimelineMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveTimelineMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveTimelineMethod "parseCustomNode" o = Clutter.Scriptable.ScriptableParseCustomNodeMethodInfo
    ResolveTimelineMethod "pause" o = TimelinePauseMethodInfo
    ResolveTimelineMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveTimelineMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveTimelineMethod "removeMarker" o = TimelineRemoveMarkerMethodInfo
    ResolveTimelineMethod "rewind" o = TimelineRewindMethodInfo
    ResolveTimelineMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveTimelineMethod "skip" o = TimelineSkipMethodInfo
    ResolveTimelineMethod "start" o = TimelineStartMethodInfo
    ResolveTimelineMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveTimelineMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveTimelineMethod "stop" o = TimelineStopMethodInfo
    ResolveTimelineMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveTimelineMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveTimelineMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveTimelineMethod "getAutoReverse" o = TimelineGetAutoReverseMethodInfo
    ResolveTimelineMethod "getCubicBezierProgress" o = TimelineGetCubicBezierProgressMethodInfo
    ResolveTimelineMethod "getCurrentRepeat" o = TimelineGetCurrentRepeatMethodInfo
    ResolveTimelineMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveTimelineMethod "getDelay" o = TimelineGetDelayMethodInfo
    ResolveTimelineMethod "getDelta" o = TimelineGetDeltaMethodInfo
    ResolveTimelineMethod "getDirection" o = TimelineGetDirectionMethodInfo
    ResolveTimelineMethod "getDuration" o = TimelineGetDurationMethodInfo
    ResolveTimelineMethod "getDurationHint" o = TimelineGetDurationHintMethodInfo
    ResolveTimelineMethod "getElapsedTime" o = TimelineGetElapsedTimeMethodInfo
    ResolveTimelineMethod "getId" o = Clutter.Scriptable.ScriptableGetIdMethodInfo
    ResolveTimelineMethod "getLoop" o = TimelineGetLoopMethodInfo
    ResolveTimelineMethod "getProgress" o = TimelineGetProgressMethodInfo
    ResolveTimelineMethod "getProgressMode" o = TimelineGetProgressModeMethodInfo
    ResolveTimelineMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveTimelineMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveTimelineMethod "getRepeatCount" o = TimelineGetRepeatCountMethodInfo
    ResolveTimelineMethod "getStepProgress" o = TimelineGetStepProgressMethodInfo
    ResolveTimelineMethod "setAutoReverse" o = TimelineSetAutoReverseMethodInfo
    ResolveTimelineMethod "setCubicBezierProgress" o = TimelineSetCubicBezierProgressMethodInfo
    ResolveTimelineMethod "setCustomProperty" o = Clutter.Scriptable.ScriptableSetCustomPropertyMethodInfo
    ResolveTimelineMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveTimelineMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveTimelineMethod "setDelay" o = TimelineSetDelayMethodInfo
    ResolveTimelineMethod "setDirection" o = TimelineSetDirectionMethodInfo
    ResolveTimelineMethod "setDuration" o = TimelineSetDurationMethodInfo
    ResolveTimelineMethod "setId" o = Clutter.Scriptable.ScriptableSetIdMethodInfo
    ResolveTimelineMethod "setLoop" o = TimelineSetLoopMethodInfo
    ResolveTimelineMethod "setProgressFunc" o = TimelineSetProgressFuncMethodInfo
    ResolveTimelineMethod "setProgressMode" o = TimelineSetProgressModeMethodInfo
    ResolveTimelineMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveTimelineMethod "setRepeatCount" o = TimelineSetRepeatCountMethodInfo
    ResolveTimelineMethod "setStepProgress" o = TimelineSetStepProgressMethodInfo
    ResolveTimelineMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal Timeline::completed
-- | The [Timeline::completed]("GI.Clutter.Objects.Timeline#g:signal:completed") signal is emitted when the timeline\'s
-- elapsed time reaches the value of the [Timeline:duration]("GI.Clutter.Objects.Timeline#g:attr:duration")
-- property.
-- 
-- This signal will be emitted even if the t'GI.Clutter.Objects.Timeline.Timeline' is set to be
-- repeating.
-- 
-- If you want to get notification on whether the t'GI.Clutter.Objects.Timeline.Timeline' has
-- been stopped or has finished its run, including its eventual repeats,
-- you should use the [Timeline::stopped]("GI.Clutter.Objects.Timeline#g:signal:stopped") signal instead.
type TimelineCompletedCallback =
    IO ()

type C_TimelineCompletedCallback =
    Ptr Timeline ->                         -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_TimelineCompletedCallback :: 
    GObject a => (a -> TimelineCompletedCallback) ->
    C_TimelineCompletedCallback
wrap_TimelineCompletedCallback :: forall a. GObject a => (a -> IO ()) -> C_TimelineCompletedCallback
wrap_TimelineCompletedCallback a -> IO ()
gi'cb Ptr Timeline
gi'selfPtr Ptr ()
_ = do
    Ptr Timeline -> (Timeline -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Timeline
gi'selfPtr ((Timeline -> IO ()) -> IO ()) -> (Timeline -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Timeline
gi'self -> a -> IO ()
gi'cb (Timeline -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Timeline
gi'self) 


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

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


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

#endif

-- signal Timeline::marker-reached
-- | The [markerReached](#g:signal:markerReached) signal is emitted each time a timeline
-- reaches a marker set with
-- 'GI.Clutter.Objects.Timeline.timelineAddMarkerAtTime'. This signal is detailed
-- with the name of the marker as well, so it is possible to connect
-- a callback to the [markerReached](#g:signal:markerReached) signal for a specific marker
-- with:
-- 
-- \<informalexample>\<programlisting>
--   clutter_timeline_add_marker_at_time (timeline, \"foo\", 500);
--   clutter_timeline_add_marker_at_time (timeline, \"bar\", 750);
-- 
--   g_signal_connect (timeline, \"marker-reached\",
--                     G_CALLBACK (each_marker_reached), NULL);
--   g_signal_connect (timeline, \"marker-reached[foo](#g:signal:foo)\",
--                     G_CALLBACK (foo_marker_reached), NULL);
--   g_signal_connect (timeline, \"marker-reached[bar](#g:signal:bar)\",
--                     G_CALLBACK (bar_marker_reached), NULL);
-- \<\/programlisting>\<\/informalexample>
-- 
-- In the example, the first callback will be invoked for both
-- the \"foo\" and \"bar\" marker, while the second and third callbacks
-- will be invoked for the \"foo\" or \"bar\" markers, respectively.
-- 
-- /Since: 0.8/
type TimelineMarkerReachedCallback =
    T.Text
    -- ^ /@markerName@/: the name of the marker reached
    -> Int32
    -- ^ /@msecs@/: the elapsed time
    -> IO ()

type C_TimelineMarkerReachedCallback =
    Ptr Timeline ->                         -- object
    CString ->
    Int32 ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_TimelineMarkerReachedCallback :: 
    GObject a => (a -> TimelineMarkerReachedCallback) ->
    C_TimelineMarkerReachedCallback
wrap_TimelineMarkerReachedCallback :: forall a.
GObject a =>
(a -> TimelineMarkerReachedCallback)
-> C_TimelineMarkerReachedCallback
wrap_TimelineMarkerReachedCallback a -> TimelineMarkerReachedCallback
gi'cb Ptr Timeline
gi'selfPtr CString
markerName Int32
msecs Ptr ()
_ = do
    Text
markerName' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
markerName
    Ptr Timeline -> (Timeline -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Timeline
gi'selfPtr ((Timeline -> IO ()) -> IO ()) -> (Timeline -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Timeline
gi'self -> a -> TimelineMarkerReachedCallback
gi'cb (Timeline -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Timeline
gi'self)  Text
markerName' Int32
msecs


-- | Connect a signal handler for the [markerReached](#signal:markerReached) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' timeline #markerReached callback
-- @
-- 
-- This signal admits a optional parameter @detail@.
-- If it's not @Nothing@, we will connect to “@marker-reached::detail@” instead.
-- 
onTimelineMarkerReached :: (IsTimeline a, MonadIO m) => a -> P.Maybe T.Text -> ((?self :: a) => TimelineMarkerReachedCallback) -> m SignalHandlerId
onTimelineMarkerReached :: forall a (m :: * -> *).
(IsTimeline a, MonadIO m) =>
a
-> Maybe Text
-> ((?self::a) => TimelineMarkerReachedCallback)
-> m SignalHandlerId
onTimelineMarkerReached a
obj Maybe Text
detail (?self::a) => TimelineMarkerReachedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> TimelineMarkerReachedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => TimelineMarkerReachedCallback
TimelineMarkerReachedCallback
cb
    let wrapped' :: C_TimelineMarkerReachedCallback
wrapped' = (a -> TimelineMarkerReachedCallback)
-> C_TimelineMarkerReachedCallback
forall a.
GObject a =>
(a -> TimelineMarkerReachedCallback)
-> C_TimelineMarkerReachedCallback
wrap_TimelineMarkerReachedCallback a -> TimelineMarkerReachedCallback
wrapped
    FunPtr C_TimelineMarkerReachedCallback
wrapped'' <- C_TimelineMarkerReachedCallback
-> IO (FunPtr C_TimelineMarkerReachedCallback)
mk_TimelineMarkerReachedCallback C_TimelineMarkerReachedCallback
wrapped'
    a
-> Text
-> FunPtr C_TimelineMarkerReachedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"marker-reached" FunPtr C_TimelineMarkerReachedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
detail

-- | Connect a signal handler for the [markerReached](#signal:markerReached) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' timeline #markerReached callback
-- @
-- 
-- This signal admits a optional parameter @detail@.
-- If it's not @Nothing@, we will connect to “@marker-reached::detail@” instead.
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterTimelineMarkerReached :: (IsTimeline a, MonadIO m) => a -> P.Maybe T.Text -> ((?self :: a) => TimelineMarkerReachedCallback) -> m SignalHandlerId
afterTimelineMarkerReached :: forall a (m :: * -> *).
(IsTimeline a, MonadIO m) =>
a
-> Maybe Text
-> ((?self::a) => TimelineMarkerReachedCallback)
-> m SignalHandlerId
afterTimelineMarkerReached a
obj Maybe Text
detail (?self::a) => TimelineMarkerReachedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> TimelineMarkerReachedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => TimelineMarkerReachedCallback
TimelineMarkerReachedCallback
cb
    let wrapped' :: C_TimelineMarkerReachedCallback
wrapped' = (a -> TimelineMarkerReachedCallback)
-> C_TimelineMarkerReachedCallback
forall a.
GObject a =>
(a -> TimelineMarkerReachedCallback)
-> C_TimelineMarkerReachedCallback
wrap_TimelineMarkerReachedCallback a -> TimelineMarkerReachedCallback
wrapped
    FunPtr C_TimelineMarkerReachedCallback
wrapped'' <- C_TimelineMarkerReachedCallback
-> IO (FunPtr C_TimelineMarkerReachedCallback)
mk_TimelineMarkerReachedCallback C_TimelineMarkerReachedCallback
wrapped'
    a
-> Text
-> FunPtr C_TimelineMarkerReachedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"marker-reached" FunPtr C_TimelineMarkerReachedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
detail


#if defined(ENABLE_OVERLOADING)
data TimelineMarkerReachedSignalInfo
instance SignalInfo TimelineMarkerReachedSignalInfo where
    type HaskellCallbackType TimelineMarkerReachedSignalInfo = TimelineMarkerReachedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TimelineMarkerReachedCallback cb
        cb'' <- mk_TimelineMarkerReachedCallback cb'
        connectSignalFunPtr obj "marker-reached" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Timeline::marker-reached"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Timeline.html#g:signal:markerReached"})

#endif

-- signal Timeline::new-frame
-- | The [newFrame](#g:signal:newFrame) signal is emitted for each timeline running
-- timeline before a new frame is drawn to give animations a chance
-- to update the scene.
type TimelineNewFrameCallback =
    Int32
    -- ^ /@msecs@/: the elapsed time between 0 and duration
    -> IO ()

type C_TimelineNewFrameCallback =
    Ptr Timeline ->                         -- object
    Int32 ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_TimelineNewFrameCallback :: 
    GObject a => (a -> TimelineNewFrameCallback) ->
    C_TimelineNewFrameCallback
wrap_TimelineNewFrameCallback :: forall a.
GObject a =>
(a -> TimelineNewFrameCallback) -> C_TimelineNewFrameCallback
wrap_TimelineNewFrameCallback a -> TimelineNewFrameCallback
gi'cb Ptr Timeline
gi'selfPtr Int32
msecs Ptr ()
_ = do
    Ptr Timeline -> (Timeline -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Timeline
gi'selfPtr ((Timeline -> IO ()) -> IO ()) -> (Timeline -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Timeline
gi'self -> a -> TimelineNewFrameCallback
gi'cb (Timeline -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Timeline
gi'self)  Int32
msecs


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

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


#if defined(ENABLE_OVERLOADING)
data TimelineNewFrameSignalInfo
instance SignalInfo TimelineNewFrameSignalInfo where
    type HaskellCallbackType TimelineNewFrameSignalInfo = TimelineNewFrameCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TimelineNewFrameCallback cb
        cb'' <- mk_TimelineNewFrameCallback cb'
        connectSignalFunPtr obj "new-frame" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Timeline::new-frame"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Timeline.html#g:signal:newFrame"})

#endif

-- signal Timeline::paused
-- | The [paused](#g:signal:paused) signal is emitted when 'GI.Clutter.Objects.Timeline.timelinePause' is invoked.
type TimelinePausedCallback =
    IO ()

type C_TimelinePausedCallback =
    Ptr Timeline ->                         -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_TimelinePausedCallback :: 
    GObject a => (a -> TimelinePausedCallback) ->
    C_TimelinePausedCallback
wrap_TimelinePausedCallback :: forall a. GObject a => (a -> IO ()) -> C_TimelineCompletedCallback
wrap_TimelinePausedCallback a -> IO ()
gi'cb Ptr Timeline
gi'selfPtr Ptr ()
_ = do
    Ptr Timeline -> (Timeline -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Timeline
gi'selfPtr ((Timeline -> IO ()) -> IO ()) -> (Timeline -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Timeline
gi'self -> a -> IO ()
gi'cb (Timeline -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Timeline
gi'self) 


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

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


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

#endif

-- signal Timeline::started
-- | The [started](#g:signal:started) signal is emitted when the timeline starts its run.
-- This might be as soon as 'GI.Clutter.Objects.Timeline.timelineStart' is invoked or
-- after the delay set in the ClutterTimeline:delay property has
-- expired.
type TimelineStartedCallback =
    IO ()

type C_TimelineStartedCallback =
    Ptr Timeline ->                         -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_TimelineStartedCallback :: 
    GObject a => (a -> TimelineStartedCallback) ->
    C_TimelineStartedCallback
wrap_TimelineStartedCallback :: forall a. GObject a => (a -> IO ()) -> C_TimelineCompletedCallback
wrap_TimelineStartedCallback a -> IO ()
gi'cb Ptr Timeline
gi'selfPtr Ptr ()
_ = do
    Ptr Timeline -> (Timeline -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Timeline
gi'selfPtr ((Timeline -> IO ()) -> IO ()) -> (Timeline -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Timeline
gi'self -> a -> IO ()
gi'cb (Timeline -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Timeline
gi'self) 


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

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


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

#endif

-- signal Timeline::stopped
-- | The [Timeline::stopped]("GI.Clutter.Objects.Timeline#g:signal:stopped") signal is emitted when the timeline
-- has been stopped, either because 'GI.Clutter.Objects.Timeline.timelineStop' has been
-- called, or because it has been exhausted.
-- 
-- This is different from the [Timeline::completed]("GI.Clutter.Objects.Timeline#g:signal:completed") signal,
-- which gets emitted after every repeat finishes.
-- 
-- If the t'GI.Clutter.Objects.Timeline.Timeline' has is marked as infinitely repeating,
-- this signal will never be emitted.
-- 
-- /Since: 1.12/
type TimelineStoppedCallback =
    Bool
    -- ^ /@isFinished@/: 'P.True' if the signal was emitted at the end of the
    --   timeline.
    -> IO ()

type C_TimelineStoppedCallback =
    Ptr Timeline ->                         -- object
    CInt ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_TimelineStoppedCallback :: 
    GObject a => (a -> TimelineStoppedCallback) ->
    C_TimelineStoppedCallback
wrap_TimelineStoppedCallback :: forall a.
GObject a =>
(a -> TimelineStoppedCallback) -> C_TimelineStoppedCallback
wrap_TimelineStoppedCallback a -> TimelineStoppedCallback
gi'cb Ptr Timeline
gi'selfPtr CInt
isFinished Ptr ()
_ = do
    let isFinished' :: Bool
isFinished' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
isFinished
    Ptr Timeline -> (Timeline -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Timeline
gi'selfPtr ((Timeline -> IO ()) -> IO ()) -> (Timeline -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Timeline
gi'self -> a -> TimelineStoppedCallback
gi'cb (Timeline -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Timeline
gi'self)  Bool
isFinished'


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

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


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

#endif

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

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

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

-- | Construct a `GValueConstruct` with valid value for the “@auto-reverse@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTimelineAutoReverse :: (IsTimeline o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructTimelineAutoReverse :: forall o (m :: * -> *).
(IsTimeline o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructTimelineAutoReverse Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"auto-reverse" Bool
val

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

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

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

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

-- | Construct a `GValueConstruct` with valid value for the “@delay@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTimelineDelay :: (IsTimeline o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructTimelineDelay :: forall o (m :: * -> *).
(IsTimeline o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructTimelineDelay Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"delay" Word32
val

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

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

-- | Get the value of the “@direction@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' timeline #direction
-- @
getTimelineDirection :: (MonadIO m, IsTimeline o) => o -> m Clutter.Enums.TimelineDirection
getTimelineDirection :: forall (m :: * -> *) o.
(MonadIO m, IsTimeline o) =>
o -> m TimelineDirection
getTimelineDirection o
obj = IO TimelineDirection -> m TimelineDirection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO TimelineDirection -> m TimelineDirection)
-> IO TimelineDirection -> m TimelineDirection
forall a b. (a -> b) -> a -> b
$ o -> String -> IO TimelineDirection
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"direction"

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

-- | Construct a `GValueConstruct` with valid value for the “@direction@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTimelineDirection :: (IsTimeline o, MIO.MonadIO m) => Clutter.Enums.TimelineDirection -> m (GValueConstruct o)
constructTimelineDirection :: forall o (m :: * -> *).
(IsTimeline o, MonadIO m) =>
TimelineDirection -> m (GValueConstruct o)
constructTimelineDirection TimelineDirection
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> TimelineDirection -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"direction" TimelineDirection
val

#if defined(ENABLE_OVERLOADING)
data TimelineDirectionPropertyInfo
instance AttrInfo TimelineDirectionPropertyInfo where
    type AttrAllowedOps TimelineDirectionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TimelineDirectionPropertyInfo = IsTimeline
    type AttrSetTypeConstraint TimelineDirectionPropertyInfo = (~) Clutter.Enums.TimelineDirection
    type AttrTransferTypeConstraint TimelineDirectionPropertyInfo = (~) Clutter.Enums.TimelineDirection
    type AttrTransferType TimelineDirectionPropertyInfo = Clutter.Enums.TimelineDirection
    type AttrGetType TimelineDirectionPropertyInfo = Clutter.Enums.TimelineDirection
    type AttrLabel TimelineDirectionPropertyInfo = "direction"
    type AttrOrigin TimelineDirectionPropertyInfo = Timeline
    attrGet = getTimelineDirection
    attrSet = setTimelineDirection
    attrTransfer _ v = do
        return v
    attrConstruct = constructTimelineDirection
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Timeline.direction"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Timeline.html#g:attr:direction"
        })
#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' timeline #duration
-- @
getTimelineDuration :: (MonadIO m, IsTimeline o) => o -> m Word32
getTimelineDuration :: forall (m :: * -> *) o. (MonadIO m, IsTimeline o) => o -> m Word32
getTimelineDuration o
obj = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"duration"

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

-- | Construct a `GValueConstruct` with valid value for the “@duration@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTimelineDuration :: (IsTimeline o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructTimelineDuration :: forall o (m :: * -> *).
(IsTimeline o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructTimelineDuration Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"duration" Word32
val

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

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

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

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

-- | Construct a `GValueConstruct` with valid value for the “@loop@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTimelineLoop :: (IsTimeline o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructTimelineLoop :: forall o (m :: * -> *).
(IsTimeline o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructTimelineLoop Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"loop" Bool
val

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

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

-- | Get the value of the “@progress-mode@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' timeline #progressMode
-- @
getTimelineProgressMode :: (MonadIO m, IsTimeline o) => o -> m Clutter.Enums.AnimationMode
getTimelineProgressMode :: forall (m :: * -> *) o.
(MonadIO m, IsTimeline o) =>
o -> m AnimationMode
getTimelineProgressMode o
obj = IO AnimationMode -> m AnimationMode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO AnimationMode -> m AnimationMode)
-> IO AnimationMode -> m AnimationMode
forall a b. (a -> b) -> a -> b
$ o -> String -> IO AnimationMode
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"progress-mode"

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

-- | Construct a `GValueConstruct` with valid value for the “@progress-mode@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTimelineProgressMode :: (IsTimeline o, MIO.MonadIO m) => Clutter.Enums.AnimationMode -> m (GValueConstruct o)
constructTimelineProgressMode :: forall o (m :: * -> *).
(IsTimeline o, MonadIO m) =>
AnimationMode -> m (GValueConstruct o)
constructTimelineProgressMode AnimationMode
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> AnimationMode -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"progress-mode" AnimationMode
val

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

-- VVV Prop "repeat-count"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

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

-- | Construct a `GValueConstruct` with valid value for the “@repeat-count@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTimelineRepeatCount :: (IsTimeline o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructTimelineRepeatCount :: forall o (m :: * -> *).
(IsTimeline o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructTimelineRepeatCount Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"repeat-count" Int32
val

#if defined(ENABLE_OVERLOADING)
data TimelineRepeatCountPropertyInfo
instance AttrInfo TimelineRepeatCountPropertyInfo where
    type AttrAllowedOps TimelineRepeatCountPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TimelineRepeatCountPropertyInfo = IsTimeline
    type AttrSetTypeConstraint TimelineRepeatCountPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint TimelineRepeatCountPropertyInfo = (~) Int32
    type AttrTransferType TimelineRepeatCountPropertyInfo = Int32
    type AttrGetType TimelineRepeatCountPropertyInfo = Int32
    type AttrLabel TimelineRepeatCountPropertyInfo = "repeat-count"
    type AttrOrigin TimelineRepeatCountPropertyInfo = Timeline
    attrGet = getTimelineRepeatCount
    attrSet = setTimelineRepeatCount
    attrTransfer _ v = do
        return v
    attrConstruct = constructTimelineRepeatCount
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Timeline.repeatCount"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Timeline.html#g:attr:repeatCount"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Timeline
type instance O.AttributeList Timeline = TimelineAttributeList
type TimelineAttributeList = ('[ '("autoReverse", TimelineAutoReversePropertyInfo), '("delay", TimelineDelayPropertyInfo), '("direction", TimelineDirectionPropertyInfo), '("duration", TimelineDurationPropertyInfo), '("loop", TimelineLoopPropertyInfo), '("progressMode", TimelineProgressModePropertyInfo), '("repeatCount", TimelineRepeatCountPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
timelineAutoReverse :: AttrLabelProxy "autoReverse"
timelineAutoReverse = AttrLabelProxy

timelineDelay :: AttrLabelProxy "delay"
timelineDelay = AttrLabelProxy

timelineDirection :: AttrLabelProxy "direction"
timelineDirection = AttrLabelProxy

timelineDuration :: AttrLabelProxy "duration"
timelineDuration = AttrLabelProxy

timelineLoop :: AttrLabelProxy "loop"
timelineLoop = AttrLabelProxy

timelineProgressMode :: AttrLabelProxy "progressMode"
timelineProgressMode = AttrLabelProxy

timelineRepeatCount :: AttrLabelProxy "repeatCount"
timelineRepeatCount = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Timeline = TimelineSignalList
type TimelineSignalList = ('[ '("completed", TimelineCompletedSignalInfo), '("markerReached", TimelineMarkerReachedSignalInfo), '("newFrame", TimelineNewFrameSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("paused", TimelinePausedSignalInfo), '("started", TimelineStartedSignalInfo), '("stopped", TimelineStoppedSignalInfo)] :: [(Symbol, *)])

#endif

-- method Timeline::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "msecs"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Duration of the timeline in milliseconds"
--                 , 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_timeline_new" clutter_timeline_new :: 
    Word32 ->                               -- msecs : TBasicType TUInt
    IO (Ptr Timeline)

-- | Creates a new t'GI.Clutter.Objects.Timeline.Timeline' with a duration of /@msecs@/.
-- 
-- /Since: 0.6/
timelineNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@msecs@/: Duration of the timeline in milliseconds
    -> m Timeline
    -- ^ __Returns:__ the newly created t'GI.Clutter.Objects.Timeline.Timeline' instance. Use
    --   'GI.GObject.Objects.Object.objectUnref' when done using it
timelineNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word32 -> m Timeline
timelineNew Word32
msecs = IO Timeline -> m Timeline
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Timeline -> m Timeline) -> IO Timeline -> m Timeline
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
result <- Word32 -> IO (Ptr Timeline)
clutter_timeline_new Word32
msecs
    Text -> Ptr Timeline -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"timelineNew" 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
wrapObject ManagedPtr Timeline -> Timeline
Timeline) Ptr Timeline
result
    Timeline -> IO Timeline
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Timeline
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Timeline::add_marker
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "marker_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the unique name for this marker"
--                 , 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 value of the position of the martke"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_add_marker" clutter_timeline_add_marker :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    CString ->                              -- marker_name : TBasicType TUTF8
    CDouble ->                              -- progress : TBasicType TDouble
    IO ()

-- | Adds a named marker that will be hit when the timeline has reached
-- the specified /@progress@/.
-- 
-- Markers are unique string identifiers for a given position on the
-- timeline. Once /@timeline@/ reaches the given /@progress@/ of its duration,
-- if will emit a [markerReached](#g:signal:markerReached) signal for each marker attached to
-- that particular point.
-- 
-- A marker can be removed with 'GI.Clutter.Objects.Timeline.timelineRemoveMarker'. The
-- timeline can be advanced to a marker using
-- 'GI.Clutter.Objects.Timeline.timelineAdvanceToMarker'.
-- 
-- See also: 'GI.Clutter.Objects.Timeline.timelineAddMarkerAtTime'
-- 
-- /Since: 1.14/
timelineAddMarker ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> T.Text
    -- ^ /@markerName@/: the unique name for this marker
    -> Double
    -- ^ /@progress@/: the normalized value of the position of the martke
    -> m ()
timelineAddMarker :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> Text -> Double -> m ()
timelineAddMarker a
timeline Text
markerName Double
progress = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    CString
markerName' <- Text -> IO CString
textToCString Text
markerName
    let progress' :: CDouble
progress' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
progress
    Ptr Timeline -> CString -> CDouble -> IO ()
clutter_timeline_add_marker Ptr Timeline
timeline' CString
markerName' CDouble
progress'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
markerName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TimelineAddMarkerMethodInfo
instance (signature ~ (T.Text -> Double -> m ()), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineAddMarkerMethodInfo a signature where
    overloadedMethod = timelineAddMarker

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


#endif

-- method Timeline::add_marker_at_time
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "marker_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the unique name for this marker"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "msecs"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "position of the marker in milliseconds"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_add_marker_at_time" clutter_timeline_add_marker_at_time :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    CString ->                              -- marker_name : TBasicType TUTF8
    Word32 ->                               -- msecs : TBasicType TUInt
    IO ()

-- | Adds a named marker that will be hit when the timeline has been
-- running for /@msecs@/ milliseconds.
-- 
-- Markers are unique string identifiers for a given position on the
-- timeline. Once /@timeline@/ reaches the given /@msecs@/, it will emit
-- a [markerReached](#g:signal:markerReached) signal for each marker attached to that position.
-- 
-- A marker can be removed with 'GI.Clutter.Objects.Timeline.timelineRemoveMarker'. The
-- timeline can be advanced to a marker using
-- 'GI.Clutter.Objects.Timeline.timelineAdvanceToMarker'.
-- 
-- See also: 'GI.Clutter.Objects.Timeline.timelineAddMarker'
-- 
-- /Since: 0.8/
timelineAddMarkerAtTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> T.Text
    -- ^ /@markerName@/: the unique name for this marker
    -> Word32
    -- ^ /@msecs@/: position of the marker in milliseconds
    -> m ()
timelineAddMarkerAtTime :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> Text -> Word32 -> m ()
timelineAddMarkerAtTime a
timeline Text
markerName Word32
msecs = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    CString
markerName' <- Text -> IO CString
textToCString Text
markerName
    Ptr Timeline -> CString -> Word32 -> IO ()
clutter_timeline_add_marker_at_time Ptr Timeline
timeline' CString
markerName' Word32
msecs
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
markerName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TimelineAddMarkerAtTimeMethodInfo
instance (signature ~ (T.Text -> Word32 -> m ()), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineAddMarkerAtTimeMethodInfo a signature where
    overloadedMethod = timelineAddMarkerAtTime

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


#endif

-- method Timeline::advance
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "msecs"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Time to advance to" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Advance timeline to the requested point. The point is given as a
-- time in milliseconds since the timeline started.
-- 
-- The /@timeline@/ will not emit the [Timeline::newFrame]("GI.Clutter.Objects.Timeline#g:signal:newFrame")
-- signal for the given time. The first [newFrame](#g:signal:newFrame) signal after the call to
-- 'GI.Clutter.Objects.Timeline.timelineAdvance' will be emit the skipped markers.
timelineAdvance ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: A t'GI.Clutter.Objects.Timeline.Timeline'
    -> Word32
    -- ^ /@msecs@/: Time to advance to
    -> m ()
timelineAdvance :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> Word32 -> m ()
timelineAdvance a
timeline Word32
msecs = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    Ptr Timeline -> Word32 -> IO ()
clutter_timeline_advance Ptr Timeline
timeline' Word32
msecs
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TimelineAdvanceMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineAdvanceMethodInfo a signature where
    overloadedMethod = timelineAdvance

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


#endif

-- method Timeline::advance_to_marker
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "marker_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the marker"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_advance_to_marker" clutter_timeline_advance_to_marker :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    CString ->                              -- marker_name : TBasicType TUTF8
    IO ()

-- | Advances /@timeline@/ to the time of the given /@markerName@/.
-- 
-- Like 'GI.Clutter.Objects.Timeline.timelineAdvance', this function will not
-- emit the [Timeline::newFrame]("GI.Clutter.Objects.Timeline#g:signal:newFrame") for the time where /@markerName@/
-- is set, nor it will emit [Timeline::markerReached]("GI.Clutter.Objects.Timeline#g:signal:markerReached") for
-- /@markerName@/.
-- 
-- /Since: 0.8/
timelineAdvanceToMarker ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> T.Text
    -- ^ /@markerName@/: the name of the marker
    -> m ()
timelineAdvanceToMarker :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> Text -> m ()
timelineAdvanceToMarker a
timeline Text
markerName = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    CString
markerName' <- Text -> IO CString
textToCString Text
markerName
    Ptr Timeline -> CString -> IO ()
clutter_timeline_advance_to_marker Ptr Timeline
timeline' CString
markerName'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
markerName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method Timeline::clone
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "timeline"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Timeline" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#ClutterTimeline to duplicate."
--                 , 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_timeline_clone" clutter_timeline_clone :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    IO (Ptr Timeline)

{-# DEPRECATED timelineClone ["(Since version 1.10)","Use 'GI.Clutter.Objects.Timeline.timelineNew' or @/g_object_new()/@","  instead"] #-}
-- | Create a new t'GI.Clutter.Objects.Timeline.Timeline' instance which has property values
-- matching that of supplied timeline. The cloned timeline will not
-- be started and will not be positioned to the current position of
-- the original /@timeline@/: you will have to start it with
-- 'GI.Clutter.Objects.Timeline.timelineStart'.
-- 
-- The only cloned properties are:
-- 
--  - [Timeline:duration]("GI.Clutter.Objects.Timeline#g:attr:duration")
--  - [Timeline:loop]("GI.Clutter.Objects.Timeline#g:attr:loop")
--  - [Timeline:delay]("GI.Clutter.Objects.Timeline#g:attr:delay")
--  - [Timeline:direction]("GI.Clutter.Objects.Timeline#g:attr:direction")
-- 
-- /Since: 0.4/
timelineClone ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: t'GI.Clutter.Objects.Timeline.Timeline' to duplicate.
    -> m Timeline
    -- ^ __Returns:__ a new t'GI.Clutter.Objects.Timeline.Timeline', cloned
    --   from /@timeline@/
timelineClone :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> m Timeline
timelineClone a
timeline = IO Timeline -> m Timeline
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Timeline -> m Timeline) -> IO Timeline -> m Timeline
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    Ptr Timeline
result <- Ptr Timeline -> IO (Ptr Timeline)
clutter_timeline_clone Ptr Timeline
timeline'
    Text -> Ptr Timeline -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"timelineClone" 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
wrapObject ManagedPtr Timeline -> Timeline
Timeline) Ptr Timeline
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    Timeline -> IO Timeline
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Timeline
result'

#if defined(ENABLE_OVERLOADING)
data TimelineCloneMethodInfo
instance (signature ~ (m Timeline), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineCloneMethodInfo a signature where
    overloadedMethod = timelineClone

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


#endif

-- method Timeline::get_auto_reverse
-- method type : OrdinaryMethod
-- Args: [ 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: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_get_auto_reverse" clutter_timeline_get_auto_reverse :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    IO CInt

-- | Retrieves the value set by 'GI.Clutter.Objects.Timeline.timelineSetAutoReverse'.
-- 
-- /Since: 1.6/
timelineGetAutoReverse ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the timeline should automatically reverse, and
    --   'P.False' otherwise
timelineGetAutoReverse :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> m Bool
timelineGetAutoReverse a
timeline = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    CInt
result <- Ptr Timeline -> IO CInt
clutter_timeline_get_auto_reverse Ptr Timeline
timeline'
    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
timeline
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TimelineGetAutoReverseMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineGetAutoReverseMethodInfo a signature where
    overloadedMethod = timelineGetAutoReverse

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


#endif

-- method Timeline::get_cubic_bezier_progress
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "c_1"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Point" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the first control\n  point of the cubic bezier, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "c_2"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Point" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the second control\n  point of the cubic bezier, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_get_cubic_bezier_progress" clutter_timeline_get_cubic_bezier_progress :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    Ptr Clutter.Point.Point ->              -- c_1 : TInterface (Name {namespace = "Clutter", name = "Point"})
    Ptr Clutter.Point.Point ->              -- c_2 : TInterface (Name {namespace = "Clutter", name = "Point"})
    IO CInt

-- | Retrieves the control points for the cubic bezier progress mode.
-- 
-- /Since: 1.12/
timelineGetCubicBezierProgress ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> m ((Bool, Clutter.Point.Point, Clutter.Point.Point))
    -- ^ __Returns:__ 'P.True' if the /@timeline@/ is using a cubic bezier progress
    --   more, and 'P.False' otherwise
timelineGetCubicBezierProgress :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> m (Bool, Point, Point)
timelineGetCubicBezierProgress a
timeline = IO (Bool, Point, Point) -> m (Bool, Point, Point)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Point, Point) -> m (Bool, Point, Point))
-> IO (Bool, Point, Point) -> m (Bool, Point, Point)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    Ptr Point
c1 <- Int -> IO (Ptr Point)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
8 :: IO (Ptr Clutter.Point.Point)
    Ptr Point
c2 <- Int -> IO (Ptr Point)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
8 :: IO (Ptr Clutter.Point.Point)
    CInt
result <- Ptr Timeline -> Ptr Point -> Ptr Point -> IO CInt
clutter_timeline_get_cubic_bezier_progress Ptr Timeline
timeline' Ptr Point
c1 Ptr Point
c2
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Point
c1' <- ((ManagedPtr Point -> Point) -> Ptr Point -> IO Point
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Point -> Point
Clutter.Point.Point) Ptr Point
c1
    Point
c2' <- ((ManagedPtr Point -> Point) -> Ptr Point -> IO Point
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Point -> Point
Clutter.Point.Point) Ptr Point
c2
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    (Bool, Point, Point) -> IO (Bool, Point, Point)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Point
c1', Point
c2')

#if defined(ENABLE_OVERLOADING)
data TimelineGetCubicBezierProgressMethodInfo
instance (signature ~ (m ((Bool, Clutter.Point.Point, Clutter.Point.Point))), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineGetCubicBezierProgressMethodInfo a signature where
    overloadedMethod = timelineGetCubicBezierProgress

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


#endif

-- method Timeline::get_current_repeat
-- method type : OrdinaryMethod
-- Args: [ 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: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_get_current_repeat" clutter_timeline_get_current_repeat :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    IO Int32

-- | Retrieves the current repeat for a timeline.
-- 
-- Repeats start at 0.
-- 
-- /Since: 1.10/
timelineGetCurrentRepeat ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> m Int32
    -- ^ __Returns:__ the current repeat
timelineGetCurrentRepeat :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> m Int32
timelineGetCurrentRepeat a
timeline = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    Int32
result <- Ptr Timeline -> IO Int32
clutter_timeline_get_current_repeat Ptr Timeline
timeline'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TimelineGetCurrentRepeatMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineGetCurrentRepeatMethodInfo a signature where
    overloadedMethod = timelineGetCurrentRepeat

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


#endif

-- method Timeline::get_delay
-- method type : OrdinaryMethod
-- Args: [ 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: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_get_delay" clutter_timeline_get_delay :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    IO Word32

-- | Retrieves the delay set using 'GI.Clutter.Objects.Timeline.timelineSetDelay'.
-- 
-- /Since: 0.4/
timelineGetDelay ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> m Word32
    -- ^ __Returns:__ the delay in milliseconds.
timelineGetDelay :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> m Word32
timelineGetDelay a
timeline = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    Word32
result <- Ptr Timeline -> IO Word32
clutter_timeline_get_delay Ptr Timeline
timeline'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data TimelineGetDelayMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineGetDelayMethodInfo a signature where
    overloadedMethod = timelineGetDelay

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


#endif

-- method Timeline::get_delta
-- method type : OrdinaryMethod
-- Args: [ 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: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_get_delta" clutter_timeline_get_delta :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    IO Word32

-- | Retrieves the amount of time elapsed since the last
-- ClutterTimeline[newFrame](#g:signal:newFrame) signal.
-- 
-- This function is only useful inside handlers for the [newFrame](#g:signal:newFrame)
-- signal, and its behaviour is undefined if the timeline is not
-- playing.
-- 
-- /Since: 0.6/
timelineGetDelta ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> m Word32
    -- ^ __Returns:__ the amount of time in milliseconds elapsed since the
    -- last frame
timelineGetDelta :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> m Word32
timelineGetDelta a
timeline = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    Word32
result <- Ptr Timeline -> IO Word32
clutter_timeline_get_delta Ptr Timeline
timeline'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data TimelineGetDeltaMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineGetDeltaMethodInfo a signature where
    overloadedMethod = timelineGetDelta

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


#endif

-- method Timeline::get_direction
-- method type : OrdinaryMethod
-- Args: [ 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: Just
--               (TInterface
--                  Name { namespace = "Clutter" , name = "TimelineDirection" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_get_direction" clutter_timeline_get_direction :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    IO CUInt

-- | Retrieves the direction of the timeline set with
-- 'GI.Clutter.Objects.Timeline.timelineSetDirection'.
-- 
-- /Since: 0.6/
timelineGetDirection ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> m Clutter.Enums.TimelineDirection
    -- ^ __Returns:__ the direction of the timeline
timelineGetDirection :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> m TimelineDirection
timelineGetDirection a
timeline = IO TimelineDirection -> m TimelineDirection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TimelineDirection -> m TimelineDirection)
-> IO TimelineDirection -> m TimelineDirection
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    CUInt
result <- Ptr Timeline -> IO CUInt
clutter_timeline_get_direction Ptr Timeline
timeline'
    let result' :: TimelineDirection
result' = (Int -> TimelineDirection
forall a. Enum a => Int -> a
toEnum (Int -> TimelineDirection)
-> (CUInt -> Int) -> CUInt -> TimelineDirection
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
timeline
    TimelineDirection -> IO TimelineDirection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TimelineDirection
result'

#if defined(ENABLE_OVERLOADING)
data TimelineGetDirectionMethodInfo
instance (signature ~ (m Clutter.Enums.TimelineDirection), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineGetDirectionMethodInfo a signature where
    overloadedMethod = timelineGetDirection

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


#endif

-- method Timeline::get_duration
-- method type : OrdinaryMethod
-- Args: [ 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: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_get_duration" clutter_timeline_get_duration :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    IO Word32

-- | Retrieves the duration of a t'GI.Clutter.Objects.Timeline.Timeline' in milliseconds.
-- See 'GI.Clutter.Objects.Timeline.timelineSetDuration'.
-- 
-- /Since: 0.6/
timelineGetDuration ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> m Word32
    -- ^ __Returns:__ the duration of the timeline, in milliseconds.
timelineGetDuration :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> m Word32
timelineGetDuration a
timeline = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    Word32
result <- Ptr Timeline -> IO Word32
clutter_timeline_get_duration Ptr Timeline
timeline'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data TimelineGetDurationMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineGetDurationMethodInfo a signature where
    overloadedMethod = timelineGetDuration

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


#endif

-- method Timeline::get_duration_hint
-- method type : OrdinaryMethod
-- Args: [ 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: Just (TBasicType TInt64)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_get_duration_hint" clutter_timeline_get_duration_hint :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    IO Int64

-- | Retrieves the full duration of the /@timeline@/, taking into account the
-- current value of the [Timeline:repeatCount]("GI.Clutter.Objects.Timeline#g:attr:repeatCount") property.
-- 
-- If the [Timeline:repeatCount]("GI.Clutter.Objects.Timeline#g:attr:repeatCount") property is set to -1, this function
-- will return 'GI.GLib.Constants.MAXINT64'.
-- 
-- The returned value is to be considered a hint, and it\'s only valid
-- as long as the /@timeline@/ hasn\'t been changed.
-- 
-- /Since: 1.10/
timelineGetDurationHint ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> m Int64
    -- ^ __Returns:__ the full duration of the t'GI.Clutter.Objects.Timeline.Timeline'
timelineGetDurationHint :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> m Int64
timelineGetDurationHint a
timeline = IO Int64 -> m Int64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    Int64
result <- Ptr Timeline -> IO Int64
clutter_timeline_get_duration_hint Ptr Timeline
timeline'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    Int64 -> IO Int64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result

#if defined(ENABLE_OVERLOADING)
data TimelineGetDurationHintMethodInfo
instance (signature ~ (m Int64), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineGetDurationHintMethodInfo a signature where
    overloadedMethod = timelineGetDurationHint

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


#endif

-- method Timeline::get_elapsed_time
-- method type : OrdinaryMethod
-- Args: [ 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: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_get_elapsed_time" clutter_timeline_get_elapsed_time :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    IO Word32

-- | Request the current time position of the timeline.
timelineGetElapsedTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: A t'GI.Clutter.Objects.Timeline.Timeline'
    -> m Word32
    -- ^ __Returns:__ current elapsed time in milliseconds.
timelineGetElapsedTime :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> m Word32
timelineGetElapsedTime a
timeline = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    Word32
result <- Ptr Timeline -> IO Word32
clutter_timeline_get_elapsed_time Ptr Timeline
timeline'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data TimelineGetElapsedTimeMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineGetElapsedTimeMethodInfo a signature where
    overloadedMethod = timelineGetElapsedTime

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


#endif

-- method Timeline::get_loop
-- method type : OrdinaryMethod
-- Args: [ 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: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_get_loop" clutter_timeline_get_loop :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    IO CInt

{-# DEPRECATED timelineGetLoop ["(Since version 1.10)","Use 'GI.Clutter.Objects.Timeline.timelineGetRepeatCount' instead."] #-}
-- | Gets whether /@timeline@/ is looping
timelineGetLoop ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the timeline is looping
timelineGetLoop :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> m Bool
timelineGetLoop a
timeline = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    CInt
result <- Ptr Timeline -> IO CInt
clutter_timeline_get_loop Ptr Timeline
timeline'
    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
timeline
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TimelineGetLoopMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineGetLoopMethodInfo a signature where
    overloadedMethod = timelineGetLoop

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


#endif

-- method Timeline::get_progress
-- method type : OrdinaryMethod
-- Args: [ 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: Just (TBasicType TDouble)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_get_progress" clutter_timeline_get_progress :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    IO CDouble

-- | The position of the timeline in a normalized [-1, 2] interval.
-- 
-- The return value of this function is determined by the progress
-- mode set using 'GI.Clutter.Objects.Timeline.timelineSetProgressMode', or by the
-- progress function set using 'GI.Clutter.Objects.Timeline.timelineSetProgressFunc'.
-- 
-- /Since: 0.6/
timelineGetProgress ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> m Double
    -- ^ __Returns:__ the normalized current position in the timeline.
timelineGetProgress :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> m Double
timelineGetProgress a
timeline = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    CDouble
result <- Ptr Timeline -> IO CDouble
clutter_timeline_get_progress Ptr Timeline
timeline'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data TimelineGetProgressMethodInfo
instance (signature ~ (m Double), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineGetProgressMethodInfo a signature where
    overloadedMethod = timelineGetProgress

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


#endif

-- method Timeline::get_progress_mode
-- method type : OrdinaryMethod
-- Args: [ 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: Just
--               (TInterface
--                  Name { namespace = "Clutter" , name = "AnimationMode" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_get_progress_mode" clutter_timeline_get_progress_mode :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    IO CUInt

-- | Retrieves the progress mode set using 'GI.Clutter.Objects.Timeline.timelineSetProgressMode'
-- or 'GI.Clutter.Objects.Timeline.timelineSetProgressFunc'.
-- 
-- /Since: 1.10/
timelineGetProgressMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> m Clutter.Enums.AnimationMode
    -- ^ __Returns:__ a t'GI.Clutter.Enums.AnimationMode'
timelineGetProgressMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> m AnimationMode
timelineGetProgressMode a
timeline = IO AnimationMode -> m AnimationMode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnimationMode -> m AnimationMode)
-> IO AnimationMode -> m AnimationMode
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    CUInt
result <- Ptr Timeline -> IO CUInt
clutter_timeline_get_progress_mode Ptr Timeline
timeline'
    let result' :: AnimationMode
result' = (Int -> AnimationMode
forall a. Enum a => Int -> a
toEnum (Int -> AnimationMode) -> (CUInt -> Int) -> CUInt -> AnimationMode
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
timeline
    AnimationMode -> IO AnimationMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AnimationMode
result'

#if defined(ENABLE_OVERLOADING)
data TimelineGetProgressModeMethodInfo
instance (signature ~ (m Clutter.Enums.AnimationMode), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineGetProgressModeMethodInfo a signature where
    overloadedMethod = timelineGetProgressMode

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


#endif

-- method Timeline::get_repeat_count
-- method type : OrdinaryMethod
-- Args: [ 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: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_get_repeat_count" clutter_timeline_get_repeat_count :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    IO Int32

-- | Retrieves the number set using 'GI.Clutter.Objects.Timeline.timelineSetRepeatCount'.
-- 
-- /Since: 1.10/
timelineGetRepeatCount ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> m Int32
    -- ^ __Returns:__ the number of repeats
timelineGetRepeatCount :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> m Int32
timelineGetRepeatCount a
timeline = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    Int32
result <- Ptr Timeline -> IO Int32
clutter_timeline_get_repeat_count Ptr Timeline
timeline'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TimelineGetRepeatCountMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineGetRepeatCountMethodInfo a signature where
    overloadedMethod = timelineGetRepeatCount

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


#endif

-- method Timeline::get_step_progress
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "n_steps"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the number of steps, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "step_mode"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "StepMode" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the value change policy,\n  or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_get_step_progress" clutter_timeline_get_step_progress :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    Ptr Int32 ->                            -- n_steps : TBasicType TInt
    Ptr CUInt ->                            -- step_mode : TInterface (Name {namespace = "Clutter", name = "StepMode"})
    IO CInt

-- | Retrieves the parameters of the step progress mode used by /@timeline@/.
-- 
-- /Since: 1.12/
timelineGetStepProgress ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> m ((Bool, Int32, Clutter.Enums.StepMode))
    -- ^ __Returns:__ 'P.True' if the /@timeline@/ is using a step progress
    --   mode, and 'P.False' otherwise
timelineGetStepProgress :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> m (Bool, Int32, StepMode)
timelineGetStepProgress a
timeline = IO (Bool, Int32, StepMode) -> m (Bool, Int32, StepMode)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int32, StepMode) -> m (Bool, Int32, StepMode))
-> IO (Bool, Int32, StepMode) -> m (Bool, Int32, StepMode)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    Ptr Int32
nSteps <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr CUInt
stepMode <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    CInt
result <- Ptr Timeline -> Ptr Int32 -> Ptr CUInt -> IO CInt
clutter_timeline_get_step_progress Ptr Timeline
timeline' Ptr Int32
nSteps Ptr CUInt
stepMode
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int32
nSteps' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
nSteps
    CUInt
stepMode' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
stepMode
    let stepMode'' :: StepMode
stepMode'' = (Int -> StepMode
forall a. Enum a => Int -> a
toEnum (Int -> StepMode) -> (CUInt -> Int) -> CUInt -> StepMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
stepMode'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
nSteps
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
stepMode
    (Bool, Int32, StepMode) -> IO (Bool, Int32, StepMode)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int32
nSteps', StepMode
stepMode'')

#if defined(ENABLE_OVERLOADING)
data TimelineGetStepProgressMethodInfo
instance (signature ~ (m ((Bool, Int32, Clutter.Enums.StepMode))), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineGetStepProgressMethodInfo a signature where
    overloadedMethod = timelineGetStepProgress

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


#endif

-- method Timeline::has_marker
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "marker_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the marker"
--                 , 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_timeline_has_marker" clutter_timeline_has_marker :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    CString ->                              -- marker_name : TBasicType TUTF8
    IO CInt

-- | Checks whether /@timeline@/ has a marker set with the given name.
-- 
-- /Since: 0.8/
timelineHasMarker ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> T.Text
    -- ^ /@markerName@/: the name of the marker
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the marker was found
timelineHasMarker :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> Text -> m Bool
timelineHasMarker a
timeline Text
markerName = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    CString
markerName' <- Text -> IO CString
textToCString Text
markerName
    CInt
result <- Ptr Timeline -> CString -> IO CInt
clutter_timeline_has_marker Ptr Timeline
timeline' CString
markerName'
    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
timeline
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
markerName'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

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


#endif

-- method Timeline::is_playing
-- method type : OrdinaryMethod
-- Args: [ 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: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_is_playing" clutter_timeline_is_playing :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    IO CInt

-- | Queries state of a t'GI.Clutter.Objects.Timeline.Timeline'.
timelineIsPlaying ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: A t'GI.Clutter.Objects.Timeline.Timeline'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if timeline is currently playing
timelineIsPlaying :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> m Bool
timelineIsPlaying a
timeline = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    CInt
result <- Ptr Timeline -> IO CInt
clutter_timeline_is_playing Ptr Timeline
timeline'
    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
timeline
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TimelineIsPlayingMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineIsPlayingMethodInfo a signature where
    overloadedMethod = timelineIsPlaying

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


#endif

-- method Timeline::list_markers
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "msecs"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the time to check, or -1"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_markers"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of markers returned"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) 2 (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_list_markers" clutter_timeline_list_markers :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    Int32 ->                                -- msecs : TBasicType TInt
    Ptr Word64 ->                           -- n_markers : TBasicType TUInt64
    IO (Ptr CString)

-- | Retrieves the list of markers at time /@msecs@/. If /@msecs@/ is a
-- negative integer, all the markers attached to /@timeline@/ will be
-- returned.
-- 
-- /Since: 0.8/
timelineListMarkers ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> Int32
    -- ^ /@msecs@/: the time to check, or -1
    -> m (([T.Text], Word64))
    -- ^ __Returns:__ 
    --   a newly allocated, 'P.Nothing' terminated string array containing the names
    --   of the markers. Use 'GI.GLib.Functions.strfreev' when done.
timelineListMarkers :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> Int32 -> m ([Text], Word64)
timelineListMarkers a
timeline Int32
msecs = IO ([Text], Word64) -> m ([Text], Word64)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([Text], Word64) -> m ([Text], Word64))
-> IO ([Text], Word64) -> m ([Text], Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    Ptr Word64
nMarkers <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr CString
result <- Ptr Timeline -> Int32 -> Ptr Word64 -> IO (Ptr CString)
clutter_timeline_list_markers Ptr Timeline
timeline' Int32
msecs Ptr Word64
nMarkers
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"timelineListMarkers" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    Word64
nMarkers' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
nMarkers
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
nMarkers
    ([Text], Word64) -> IO ([Text], Word64)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text]
result', Word64
nMarkers')

#if defined(ENABLE_OVERLOADING)
data TimelineListMarkersMethodInfo
instance (signature ~ (Int32 -> m (([T.Text], Word64))), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineListMarkersMethodInfo a signature where
    overloadedMethod = timelineListMarkers

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


#endif

-- method Timeline::pause
-- method type : OrdinaryMethod
-- Args: [ 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_timeline_pause" clutter_timeline_pause :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    IO ()

-- | Pauses the t'GI.Clutter.Objects.Timeline.Timeline' on current frame
timelinePause ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: A t'GI.Clutter.Objects.Timeline.Timeline'
    -> m ()
timelinePause :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> m ()
timelinePause a
timeline = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    Ptr Timeline -> IO ()
clutter_timeline_pause Ptr Timeline
timeline'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TimelinePauseMethodInfo
instance (signature ~ (m ()), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelinePauseMethodInfo a signature where
    overloadedMethod = timelinePause

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


#endif

-- method Timeline::remove_marker
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "marker_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the marker to remove"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_remove_marker" clutter_timeline_remove_marker :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    CString ->                              -- marker_name : TBasicType TUTF8
    IO ()

-- | Removes /@markerName@/, if found, from /@timeline@/.
-- 
-- /Since: 0.8/
timelineRemoveMarker ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> T.Text
    -- ^ /@markerName@/: the name of the marker to remove
    -> m ()
timelineRemoveMarker :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> Text -> m ()
timelineRemoveMarker a
timeline Text
markerName = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    CString
markerName' <- Text -> IO CString
textToCString Text
markerName
    Ptr Timeline -> CString -> IO ()
clutter_timeline_remove_marker Ptr Timeline
timeline' CString
markerName'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
markerName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method Timeline::rewind
-- method type : OrdinaryMethod
-- Args: [ 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_timeline_rewind" clutter_timeline_rewind :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    IO ()

-- | Rewinds t'GI.Clutter.Objects.Timeline.Timeline' to the first frame if its direction is
-- 'GI.Clutter.Enums.TimelineDirectionForward' and the last frame if it is
-- 'GI.Clutter.Enums.TimelineDirectionBackward'.
timelineRewind ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: A t'GI.Clutter.Objects.Timeline.Timeline'
    -> m ()
timelineRewind :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> m ()
timelineRewind a
timeline = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    Ptr Timeline -> IO ()
clutter_timeline_rewind Ptr Timeline
timeline'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TimelineRewindMethodInfo
instance (signature ~ (m ()), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineRewindMethodInfo a signature where
    overloadedMethod = timelineRewind

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


#endif

-- method Timeline::set_auto_reverse
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "reverse"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "%TRUE if the @timeline should reverse the direction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_set_auto_reverse" clutter_timeline_set_auto_reverse :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    CInt ->                                 -- reverse : TBasicType TBoolean
    IO ()

-- | Sets whether /@timeline@/ should reverse the direction after the
-- emission of the [Timeline::completed]("GI.Clutter.Objects.Timeline#g:signal:completed") signal.
-- 
-- Setting the [Timeline:autoReverse]("GI.Clutter.Objects.Timeline#g:attr:autoReverse") property to 'P.True' is the
-- equivalent of connecting a callback to the [Timeline::completed]("GI.Clutter.Objects.Timeline#g:signal:completed")
-- signal and changing the direction of the timeline from that callback;
-- for instance, this code:
-- 
-- >
-- >static void
-- >reverse_timeline (ClutterTimeline *timeline)
-- >{
-- >  ClutterTimelineDirection dir = clutter_timeline_get_direction (timeline);
-- >
-- >  if (dir == CLUTTER_TIMELINE_FORWARD)
-- >    dir = CLUTTER_TIMELINE_BACKWARD;
-- >  else
-- >    dir = CLUTTER_TIMELINE_FORWARD;
-- >
-- >  clutter_timeline_set_direction (timeline, dir);
-- >}
-- >...
-- >  timeline = clutter_timeline_new (1000);
-- >  clutter_timeline_set_repeat_count (timeline, -1);
-- >  g_signal_connect (timeline, "completed",
-- >                    G_CALLBACK (reverse_timeline),
-- >                    NULL);
-- 
-- 
-- can be effectively replaced by:
-- 
-- >
-- >  timeline = clutter_timeline_new (1000);
-- >  clutter_timeline_set_repeat_count (timeline, -1);
-- >  clutter_timeline_set_auto_reverse (timeline);
-- 
-- 
-- /Since: 1.6/
timelineSetAutoReverse ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> Bool
    -- ^ /@reverse@/: 'P.True' if the /@timeline@/ should reverse the direction
    -> m ()
timelineSetAutoReverse :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> Bool -> m ()
timelineSetAutoReverse a
timeline Bool
reverse = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    let reverse' :: CInt
reverse' = (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
reverse
    Ptr Timeline -> CInt -> IO ()
clutter_timeline_set_auto_reverse Ptr Timeline
timeline' CInt
reverse'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TimelineSetAutoReverseMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineSetAutoReverseMethodInfo a signature where
    overloadedMethod = timelineSetAutoReverse

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


#endif

-- method Timeline::set_cubic_bezier_progress
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "c_1"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Point" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the first control point for the cubic bezier"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "c_2"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Point" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the second control point for the cubic bezier"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_set_cubic_bezier_progress" clutter_timeline_set_cubic_bezier_progress :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    Ptr Clutter.Point.Point ->              -- c_1 : TInterface (Name {namespace = "Clutter", name = "Point"})
    Ptr Clutter.Point.Point ->              -- c_2 : TInterface (Name {namespace = "Clutter", name = "Point"})
    IO ()

-- | Sets the [Timeline:progressMode]("GI.Clutter.Objects.Timeline#g:attr:progressMode") of /@timeline@/
-- to 'GI.Clutter.Enums.AnimationModeCubicBezier', and sets the two control
-- points for the cubic bezier.
-- 
-- The cubic bezier curve is between (0, 0) and (1, 1). The X coordinate
-- of the two control points must be in the [ 0, 1 ] range, while the
-- Y coordinate of the two control points can exceed this range.
-- 
-- /Since: 1.12/
timelineSetCubicBezierProgress ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> Clutter.Point.Point
    -- ^ /@c1@/: the first control point for the cubic bezier
    -> Clutter.Point.Point
    -- ^ /@c2@/: the second control point for the cubic bezier
    -> m ()
timelineSetCubicBezierProgress :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> Point -> Point -> m ()
timelineSetCubicBezierProgress a
timeline Point
c1 Point
c2 = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    Ptr Point
c1' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
c1
    Ptr Point
c2' <- Point -> IO (Ptr Point)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Point
c2
    Ptr Timeline -> Ptr Point -> Ptr Point -> IO ()
clutter_timeline_set_cubic_bezier_progress Ptr Timeline
timeline' Ptr Point
c1' Ptr Point
c2'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
c1
    Point -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Point
c2
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TimelineSetCubicBezierProgressMethodInfo
instance (signature ~ (Clutter.Point.Point -> Clutter.Point.Point -> m ()), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineSetCubicBezierProgressMethodInfo a signature where
    overloadedMethod = timelineSetCubicBezierProgress

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


#endif

-- method Timeline::set_delay
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "msecs"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "delay in milliseconds"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets the delay, in milliseconds, before /@timeline@/ should start.
-- 
-- /Since: 0.4/
timelineSetDelay ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> Word32
    -- ^ /@msecs@/: delay in milliseconds
    -> m ()
timelineSetDelay :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> Word32 -> m ()
timelineSetDelay a
timeline Word32
msecs = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    Ptr Timeline -> Word32 -> IO ()
clutter_timeline_set_delay Ptr Timeline
timeline' Word32
msecs
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TimelineSetDelayMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineSetDelayMethodInfo a signature where
    overloadedMethod = timelineSetDelay

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


#endif

-- method Timeline::set_direction
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "direction"
--           , argType =
--               TInterface
--                 Name { namespace = "Clutter" , name = "TimelineDirection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the direction of the timeline"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_set_direction" clutter_timeline_set_direction :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    CUInt ->                                -- direction : TInterface (Name {namespace = "Clutter", name = "TimelineDirection"})
    IO ()

-- | Sets the direction of /@timeline@/, either 'GI.Clutter.Enums.TimelineDirectionForward' or
-- 'GI.Clutter.Enums.TimelineDirectionBackward'.
-- 
-- /Since: 0.6/
timelineSetDirection ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> Clutter.Enums.TimelineDirection
    -- ^ /@direction@/: the direction of the timeline
    -> m ()
timelineSetDirection :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> TimelineDirection -> m ()
timelineSetDirection a
timeline TimelineDirection
direction = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    let direction' :: CUInt
direction' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (TimelineDirection -> Int) -> TimelineDirection -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimelineDirection -> Int
forall a. Enum a => a -> Int
fromEnum) TimelineDirection
direction
    Ptr Timeline -> CUInt -> IO ()
clutter_timeline_set_direction Ptr Timeline
timeline' CUInt
direction'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TimelineSetDirectionMethodInfo
instance (signature ~ (Clutter.Enums.TimelineDirection -> m ()), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineSetDirectionMethodInfo a signature where
    overloadedMethod = timelineSetDirection

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


#endif

-- method Timeline::set_duration
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "msecs"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "duration of the timeline in milliseconds"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets the duration of the timeline, in milliseconds. The speed
-- of the timeline depends on the ClutterTimeline:fps setting.
-- 
-- /Since: 0.6/
timelineSetDuration ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> Word32
    -- ^ /@msecs@/: duration of the timeline in milliseconds
    -> m ()
timelineSetDuration :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> Word32 -> m ()
timelineSetDuration a
timeline Word32
msecs = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    Ptr Timeline -> Word32 -> IO ()
clutter_timeline_set_duration Ptr Timeline
timeline' Word32
msecs
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TimelineSetDurationMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineSetDurationMethodInfo a signature where
    overloadedMethod = timelineSetDuration

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


#endif

-- method Timeline::set_loop
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "loop"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE for enable looping"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

{-# DEPRECATED timelineSetLoop ["(Since version 1.10)","Use 'GI.Clutter.Objects.Timeline.timelineSetRepeatCount' instead."] #-}
-- | Sets whether /@timeline@/ should loop.
-- 
-- This function is equivalent to calling 'GI.Clutter.Objects.Timeline.timelineSetRepeatCount'
-- with -1 if /@loop@/ is 'P.True', and with 0 if /@loop@/ is 'P.False'.
timelineSetLoop ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> Bool
    -- ^ /@loop@/: 'P.True' for enable looping
    -> m ()
timelineSetLoop :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> Bool -> m ()
timelineSetLoop a
timeline Bool
loop = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    let loop' :: CInt
loop' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
loop
    Ptr Timeline -> CInt -> IO ()
clutter_timeline_set_loop Ptr Timeline
timeline' CInt
loop'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TimelineSetLoopMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineSetLoopMethodInfo a signature where
    overloadedMethod = timelineSetLoop

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


#endif

-- method Timeline::set_progress_func
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface
--                 Name { namespace = "Clutter" , name = "TimelineProgressFunc" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a progress function, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to @func"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a function to be called when the progress function is removed\n   or the timeline is disposed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_set_progress_func" clutter_timeline_set_progress_func :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    FunPtr Clutter.Callbacks.C_TimelineProgressFunc -> -- func : TInterface (Name {namespace = "Clutter", name = "TimelineProgressFunc"})
    Ptr () ->                               -- data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Sets a custom progress function for /@timeline@/. The progress function will
-- be called by 'GI.Clutter.Objects.Timeline.timelineGetProgress' and will be used to compute
-- the progress value based on the elapsed time and the total duration of the
-- timeline.
-- 
-- If /@func@/ is not 'P.Nothing', the [Timeline:progressMode]("GI.Clutter.Objects.Timeline#g:attr:progressMode") property will
-- be set to 'GI.Clutter.Enums.AnimationModeCustomMode'.
-- 
-- If /@func@/ is 'P.Nothing', any previously set progress function will be unset, and
-- the [Timeline:progressMode]("GI.Clutter.Objects.Timeline#g:attr:progressMode") property will be set to 'GI.Clutter.Enums.AnimationModeLinear'.
-- 
-- /Since: 1.10/
timelineSetProgressFunc ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> Maybe (Clutter.Callbacks.TimelineProgressFunc)
    -- ^ /@func@/: a progress function, or 'P.Nothing'
    -> m ()
timelineSetProgressFunc :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> Maybe TimelineProgressFunc -> m ()
timelineSetProgressFunc a
timeline Maybe TimelineProgressFunc
func = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    FunPtr C_TimelineProgressFunc
maybeFunc <- case Maybe TimelineProgressFunc
func of
        Maybe TimelineProgressFunc
Nothing -> FunPtr C_TimelineProgressFunc -> IO (FunPtr C_TimelineProgressFunc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_TimelineProgressFunc
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just TimelineProgressFunc
jFunc -> do
            FunPtr C_TimelineProgressFunc
jFunc' <- C_TimelineProgressFunc -> IO (FunPtr C_TimelineProgressFunc)
Clutter.Callbacks.mk_TimelineProgressFunc (Maybe (Ptr (FunPtr C_TimelineProgressFunc))
-> TimelineProgressFunc_WithClosures -> C_TimelineProgressFunc
Clutter.Callbacks.wrap_TimelineProgressFunc Maybe (Ptr (FunPtr C_TimelineProgressFunc))
forall a. Maybe a
Nothing (TimelineProgressFunc -> TimelineProgressFunc_WithClosures
Clutter.Callbacks.drop_closures_TimelineProgressFunc TimelineProgressFunc
jFunc))
            FunPtr C_TimelineProgressFunc -> IO (FunPtr C_TimelineProgressFunc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_TimelineProgressFunc
jFunc'
    let data_ :: Ptr ()
data_ = FunPtr C_TimelineProgressFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_TimelineProgressFunc
maybeFunc
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr Timeline
-> FunPtr C_TimelineProgressFunc
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
clutter_timeline_set_progress_func Ptr Timeline
timeline' FunPtr C_TimelineProgressFunc
maybeFunc Ptr ()
data_ FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
notify
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TimelineSetProgressFuncMethodInfo
instance (signature ~ (Maybe (Clutter.Callbacks.TimelineProgressFunc) -> m ()), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineSetProgressFuncMethodInfo a signature where
    overloadedMethod = timelineSetProgressFunc

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


#endif

-- method Timeline::set_progress_mode
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "AnimationMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the progress mode, as a #ClutterAnimationMode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_set_progress_mode" clutter_timeline_set_progress_mode :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    CUInt ->                                -- mode : TInterface (Name {namespace = "Clutter", name = "AnimationMode"})
    IO ()

-- | Sets the progress function using a value from the t'GI.Clutter.Enums.AnimationMode'
-- enumeration. The /@mode@/ cannot be 'GI.Clutter.Enums.AnimationModeCustomMode' or bigger than
-- 'GI.Clutter.Enums.AnimationModeAnimationLast'.
-- 
-- /Since: 1.10/
timelineSetProgressMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> Clutter.Enums.AnimationMode
    -- ^ /@mode@/: the progress mode, as a t'GI.Clutter.Enums.AnimationMode'
    -> m ()
timelineSetProgressMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> AnimationMode -> m ()
timelineSetProgressMode a
timeline AnimationMode
mode = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (AnimationMode -> Int) -> AnimationMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnimationMode -> Int
forall a. Enum a => a -> Int
fromEnum) AnimationMode
mode
    Ptr Timeline -> CUInt -> IO ()
clutter_timeline_set_progress_mode Ptr Timeline
timeline' CUInt
mode'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TimelineSetProgressModeMethodInfo
instance (signature ~ (Clutter.Enums.AnimationMode -> m ()), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineSetProgressModeMethodInfo a signature where
    overloadedMethod = timelineSetProgressMode

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


#endif

-- method Timeline::set_repeat_count
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "count"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the number of times the timeline should repeat"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_set_repeat_count" clutter_timeline_set_repeat_count :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    Int32 ->                                -- count : TBasicType TInt
    IO ()

-- | Sets the number of times the /@timeline@/ should repeat.
-- 
-- If /@count@/ is 0, the timeline never repeats.
-- 
-- If /@count@/ is -1, the timeline will always repeat until
-- it\'s stopped.
-- 
-- /Since: 1.10/
timelineSetRepeatCount ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> Int32
    -- ^ /@count@/: the number of times the timeline should repeat
    -> m ()
timelineSetRepeatCount :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> Int32 -> m ()
timelineSetRepeatCount a
timeline Int32
count = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    Ptr Timeline -> TimelineNewFrameCallback
clutter_timeline_set_repeat_count Ptr Timeline
timeline' Int32
count
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TimelineSetRepeatCountMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineSetRepeatCountMethodInfo a signature where
    overloadedMethod = timelineSetRepeatCount

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


#endif

-- method Timeline::set_step_progress
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "n_steps"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of steps"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "step_mode"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "StepMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "whether the change should happen at the start\n  or at the end of the step"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_timeline_set_step_progress" clutter_timeline_set_step_progress :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    Int32 ->                                -- n_steps : TBasicType TInt
    CUInt ->                                -- step_mode : TInterface (Name {namespace = "Clutter", name = "StepMode"})
    IO ()

-- | Sets the [Timeline:progressMode]("GI.Clutter.Objects.Timeline#g:attr:progressMode") of the /@timeline@/ to 'GI.Clutter.Enums.AnimationModeSteps'
-- and provides the parameters of the step function.
-- 
-- /Since: 1.12/
timelineSetStepProgress ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> Int32
    -- ^ /@nSteps@/: the number of steps
    -> Clutter.Enums.StepMode
    -- ^ /@stepMode@/: whether the change should happen at the start
    --   or at the end of the step
    -> m ()
timelineSetStepProgress :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> Int32 -> StepMode -> m ()
timelineSetStepProgress a
timeline Int32
nSteps StepMode
stepMode = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    let stepMode' :: CUInt
stepMode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (StepMode -> Int) -> StepMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StepMode -> Int
forall a. Enum a => a -> Int
fromEnum) StepMode
stepMode
    Ptr Timeline -> Int32 -> CUInt -> IO ()
clutter_timeline_set_step_progress Ptr Timeline
timeline' Int32
nSteps CUInt
stepMode'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TimelineSetStepProgressMethodInfo
instance (signature ~ (Int32 -> Clutter.Enums.StepMode -> m ()), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineSetStepProgressMethodInfo a signature where
    overloadedMethod = timelineSetStepProgress

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


#endif

-- method Timeline::skip
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "msecs"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Amount of time to skip"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Advance timeline by the requested time in milliseconds
timelineSkip ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: A t'GI.Clutter.Objects.Timeline.Timeline'
    -> Word32
    -- ^ /@msecs@/: Amount of time to skip
    -> m ()
timelineSkip :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> Word32 -> m ()
timelineSkip a
timeline Word32
msecs = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    Ptr Timeline -> Word32 -> IO ()
clutter_timeline_skip Ptr Timeline
timeline' Word32
msecs
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TimelineSkipMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineSkipMethodInfo a signature where
    overloadedMethod = timelineSkip

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


#endif

-- method Timeline::start
-- method type : OrdinaryMethod
-- Args: [ 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_timeline_start" clutter_timeline_start :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    IO ()

-- | Starts the t'GI.Clutter.Objects.Timeline.Timeline' playing.
timelineStart ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: A t'GI.Clutter.Objects.Timeline.Timeline'
    -> m ()
timelineStart :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> m ()
timelineStart a
timeline = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    Ptr Timeline -> IO ()
clutter_timeline_start Ptr Timeline
timeline'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TimelineStartMethodInfo
instance (signature ~ (m ()), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineStartMethodInfo a signature where
    overloadedMethod = timelineStart

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


#endif

-- method Timeline::stop
-- method type : OrdinaryMethod
-- Args: [ 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_timeline_stop" clutter_timeline_stop :: 
    Ptr Timeline ->                         -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    IO ()

-- | Stops the t'GI.Clutter.Objects.Timeline.Timeline' and moves to frame 0
timelineStop ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimeline a) =>
    a
    -- ^ /@timeline@/: A t'GI.Clutter.Objects.Timeline.Timeline'
    -> m ()
timelineStop :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
a -> m ()
timelineStop a
timeline = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    Ptr Timeline -> IO ()
clutter_timeline_stop Ptr Timeline
timeline'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TimelineStopMethodInfo
instance (signature ~ (m ()), MonadIO m, IsTimeline a) => O.OverloadedMethod TimelineStopMethodInfo a signature where
    overloadedMethod = timelineStop

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


#endif