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

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

module GI.Clutter.Objects.Score
    ( 

-- * Exported types
    Score(..)                               ,
    IsScore                                 ,
    toScore                                 ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [append]("GI.Clutter.Objects.Score#g:method:append"), [appendAtMarker]("GI.Clutter.Objects.Score#g:method:appendAtMarker"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isPlaying]("GI.Clutter.Objects.Score#g:method:isPlaying"), [listTimelines]("GI.Clutter.Objects.Score#g:method:listTimelines"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [pause]("GI.Clutter.Objects.Score#g:method:pause"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [remove]("GI.Clutter.Objects.Score#g:method:remove"), [removeAll]("GI.Clutter.Objects.Score#g:method:removeAll"), [rewind]("GI.Clutter.Objects.Score#g:method:rewind"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [start]("GI.Clutter.Objects.Score#g:method:start"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [stop]("GI.Clutter.Objects.Score#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
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getLoop]("GI.Clutter.Objects.Score#g:method:getLoop"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getTimeline]("GI.Clutter.Objects.Score#g:method:getTimeline").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setLoop]("GI.Clutter.Objects.Score#g:method:setLoop"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveScoreMethod                      ,
#endif

-- ** append #method:append#

#if defined(ENABLE_OVERLOADING)
    ScoreAppendMethodInfo                   ,
#endif
    scoreAppend                             ,


-- ** appendAtMarker #method:appendAtMarker#

#if defined(ENABLE_OVERLOADING)
    ScoreAppendAtMarkerMethodInfo           ,
#endif
    scoreAppendAtMarker                     ,


-- ** getLoop #method:getLoop#

#if defined(ENABLE_OVERLOADING)
    ScoreGetLoopMethodInfo                  ,
#endif
    scoreGetLoop                            ,


-- ** getTimeline #method:getTimeline#

#if defined(ENABLE_OVERLOADING)
    ScoreGetTimelineMethodInfo              ,
#endif
    scoreGetTimeline                        ,


-- ** isPlaying #method:isPlaying#

#if defined(ENABLE_OVERLOADING)
    ScoreIsPlayingMethodInfo                ,
#endif
    scoreIsPlaying                          ,


-- ** listTimelines #method:listTimelines#

#if defined(ENABLE_OVERLOADING)
    ScoreListTimelinesMethodInfo            ,
#endif
    scoreListTimelines                      ,


-- ** new #method:new#

    scoreNew                                ,


-- ** pause #method:pause#

#if defined(ENABLE_OVERLOADING)
    ScorePauseMethodInfo                    ,
#endif
    scorePause                              ,


-- ** remove #method:remove#

#if defined(ENABLE_OVERLOADING)
    ScoreRemoveMethodInfo                   ,
#endif
    scoreRemove                             ,


-- ** removeAll #method:removeAll#

#if defined(ENABLE_OVERLOADING)
    ScoreRemoveAllMethodInfo                ,
#endif
    scoreRemoveAll                          ,


-- ** rewind #method:rewind#

#if defined(ENABLE_OVERLOADING)
    ScoreRewindMethodInfo                   ,
#endif
    scoreRewind                             ,


-- ** setLoop #method:setLoop#

#if defined(ENABLE_OVERLOADING)
    ScoreSetLoopMethodInfo                  ,
#endif
    scoreSetLoop                            ,


-- ** start #method:start#

#if defined(ENABLE_OVERLOADING)
    ScoreStartMethodInfo                    ,
#endif
    scoreStart                              ,


-- ** stop #method:stop#

#if defined(ENABLE_OVERLOADING)
    ScoreStopMethodInfo                     ,
#endif
    scoreStop                               ,




 -- * Properties


-- ** loop #attr:loop#
-- | Whether the t'GI.Clutter.Objects.Score.Score' should restart once finished.
-- 
-- /Since: 0.6/

#if defined(ENABLE_OVERLOADING)
    ScoreLoopPropertyInfo                   ,
#endif
    constructScoreLoop                      ,
    getScoreLoop                            ,
#if defined(ENABLE_OVERLOADING)
    scoreLoop                               ,
#endif
    setScoreLoop                            ,




 -- * Signals


-- ** completed #signal:completed#

    ScoreCompletedCallback                  ,
#if defined(ENABLE_OVERLOADING)
    ScoreCompletedSignalInfo                ,
#endif
    afterScoreCompleted                     ,
    onScoreCompleted                        ,


-- ** paused #signal:paused#

    ScorePausedCallback                     ,
#if defined(ENABLE_OVERLOADING)
    ScorePausedSignalInfo                   ,
#endif
    afterScorePaused                        ,
    onScorePaused                           ,


-- ** started #signal:started#

    ScoreStartedCallback                    ,
#if defined(ENABLE_OVERLOADING)
    ScoreStartedSignalInfo                  ,
#endif
    afterScoreStarted                       ,
    onScoreStarted                          ,


-- ** timelineCompleted #signal:timelineCompleted#

    ScoreTimelineCompletedCallback          ,
#if defined(ENABLE_OVERLOADING)
    ScoreTimelineCompletedSignalInfo        ,
#endif
    afterScoreTimelineCompleted             ,
    onScoreTimelineCompleted                ,


-- ** timelineStarted #signal:timelineStarted#

    ScoreTimelineStartedCallback            ,
#if defined(ENABLE_OVERLOADING)
    ScoreTimelineStartedSignalInfo          ,
#endif
    afterScoreTimelineStarted               ,
    onScoreTimelineStarted                  ,




    ) where

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

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

import {-# SOURCE #-} qualified GI.Clutter.Objects.Timeline as Clutter.Timeline
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "clutter_score_get_type"
    c_clutter_score_get_type :: IO B.Types.GType

instance B.Types.TypedObject Score where
    glibType :: IO GType
glibType = IO GType
c_clutter_score_get_type

instance B.Types.GObject Score

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

instance O.HasParentTypes Score
type instance O.ParentTypes Score = '[GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveScoreMethod (t :: Symbol) (o :: *) :: * where
    ResolveScoreMethod "append" o = ScoreAppendMethodInfo
    ResolveScoreMethod "appendAtMarker" o = ScoreAppendAtMarkerMethodInfo
    ResolveScoreMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveScoreMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveScoreMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveScoreMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveScoreMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveScoreMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveScoreMethod "isPlaying" o = ScoreIsPlayingMethodInfo
    ResolveScoreMethod "listTimelines" o = ScoreListTimelinesMethodInfo
    ResolveScoreMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveScoreMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveScoreMethod "pause" o = ScorePauseMethodInfo
    ResolveScoreMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveScoreMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveScoreMethod "remove" o = ScoreRemoveMethodInfo
    ResolveScoreMethod "removeAll" o = ScoreRemoveAllMethodInfo
    ResolveScoreMethod "rewind" o = ScoreRewindMethodInfo
    ResolveScoreMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveScoreMethod "start" o = ScoreStartMethodInfo
    ResolveScoreMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveScoreMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveScoreMethod "stop" o = ScoreStopMethodInfo
    ResolveScoreMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveScoreMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveScoreMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveScoreMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveScoreMethod "getLoop" o = ScoreGetLoopMethodInfo
    ResolveScoreMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveScoreMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveScoreMethod "getTimeline" o = ScoreGetTimelineMethodInfo
    ResolveScoreMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveScoreMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveScoreMethod "setLoop" o = ScoreSetLoopMethodInfo
    ResolveScoreMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveScoreMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal Score::completed
{-# DEPRECATED ScoreCompletedCallback ["(Since version 1.8)"] #-}
-- | The [completed](#g:signal:completed) signal is emitted each time a t'GI.Clutter.Objects.Score.Score' terminates.
-- 
-- /Since: 0.6/
type ScoreCompletedCallback =
    IO ()

type C_ScoreCompletedCallback =
    Ptr Score ->                            -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ScoreCompletedCallback :: 
    GObject a => (a -> ScoreCompletedCallback) ->
    C_ScoreCompletedCallback
wrap_ScoreCompletedCallback :: forall a. GObject a => (a -> IO ()) -> C_ScoreCompletedCallback
wrap_ScoreCompletedCallback a -> IO ()
gi'cb Ptr Score
gi'selfPtr Ptr ()
_ = do
    Ptr Score -> (Score -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Score
gi'selfPtr ((Score -> IO ()) -> IO ()) -> (Score -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Score
gi'self -> a -> IO ()
gi'cb (Score -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Score
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' score #completed callback
-- @
-- 
-- 
onScoreCompleted :: (IsScore a, MonadIO m) => a -> ((?self :: a) => ScoreCompletedCallback) -> m SignalHandlerId
onScoreCompleted :: forall a (m :: * -> *).
(IsScore a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onScoreCompleted 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_ScoreCompletedCallback
wrapped' = (a -> IO ()) -> C_ScoreCompletedCallback
forall a. GObject a => (a -> IO ()) -> C_ScoreCompletedCallback
wrap_ScoreCompletedCallback a -> IO ()
wrapped
    FunPtr C_ScoreCompletedCallback
wrapped'' <- C_ScoreCompletedCallback -> IO (FunPtr C_ScoreCompletedCallback)
mk_ScoreCompletedCallback C_ScoreCompletedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScoreCompletedCallback
-> 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_ScoreCompletedCallback
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' score #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.
-- 
afterScoreCompleted :: (IsScore a, MonadIO m) => a -> ((?self :: a) => ScoreCompletedCallback) -> m SignalHandlerId
afterScoreCompleted :: forall a (m :: * -> *).
(IsScore a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterScoreCompleted 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_ScoreCompletedCallback
wrapped' = (a -> IO ()) -> C_ScoreCompletedCallback
forall a. GObject a => (a -> IO ()) -> C_ScoreCompletedCallback
wrap_ScoreCompletedCallback a -> IO ()
wrapped
    FunPtr C_ScoreCompletedCallback
wrapped'' <- C_ScoreCompletedCallback -> IO (FunPtr C_ScoreCompletedCallback)
mk_ScoreCompletedCallback C_ScoreCompletedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScoreCompletedCallback
-> 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_ScoreCompletedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


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

#endif

-- signal Score::paused
{-# DEPRECATED ScorePausedCallback ["(Since version 1.8)"] #-}
-- | The [paused](#g:signal:paused) signal is emitted each time a t'GI.Clutter.Objects.Score.Score'
-- is paused.
-- 
-- /Since: 0.6/
type ScorePausedCallback =
    IO ()

type C_ScorePausedCallback =
    Ptr Score ->                            -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ScorePausedCallback :: 
    GObject a => (a -> ScorePausedCallback) ->
    C_ScorePausedCallback
wrap_ScorePausedCallback :: forall a. GObject a => (a -> IO ()) -> C_ScoreCompletedCallback
wrap_ScorePausedCallback a -> IO ()
gi'cb Ptr Score
gi'selfPtr Ptr ()
_ = do
    Ptr Score -> (Score -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Score
gi'selfPtr ((Score -> IO ()) -> IO ()) -> (Score -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Score
gi'self -> a -> IO ()
gi'cb (Score -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Score
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' score #paused callback
-- @
-- 
-- 
onScorePaused :: (IsScore a, MonadIO m) => a -> ((?self :: a) => ScorePausedCallback) -> m SignalHandlerId
onScorePaused :: forall a (m :: * -> *).
(IsScore a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onScorePaused 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_ScoreCompletedCallback
wrapped' = (a -> IO ()) -> C_ScoreCompletedCallback
forall a. GObject a => (a -> IO ()) -> C_ScoreCompletedCallback
wrap_ScorePausedCallback a -> IO ()
wrapped
    FunPtr C_ScoreCompletedCallback
wrapped'' <- C_ScoreCompletedCallback -> IO (FunPtr C_ScoreCompletedCallback)
mk_ScorePausedCallback C_ScoreCompletedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScoreCompletedCallback
-> 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_ScoreCompletedCallback
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' score #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.
-- 
afterScorePaused :: (IsScore a, MonadIO m) => a -> ((?self :: a) => ScorePausedCallback) -> m SignalHandlerId
afterScorePaused :: forall a (m :: * -> *).
(IsScore a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterScorePaused 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_ScoreCompletedCallback
wrapped' = (a -> IO ()) -> C_ScoreCompletedCallback
forall a. GObject a => (a -> IO ()) -> C_ScoreCompletedCallback
wrap_ScorePausedCallback a -> IO ()
wrapped
    FunPtr C_ScoreCompletedCallback
wrapped'' <- C_ScoreCompletedCallback -> IO (FunPtr C_ScoreCompletedCallback)
mk_ScorePausedCallback C_ScoreCompletedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScoreCompletedCallback
-> 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_ScoreCompletedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


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

#endif

-- signal Score::started
{-# DEPRECATED ScoreStartedCallback ["(Since version 1.8)"] #-}
-- | The [started](#g:signal:started) signal is emitted each time a t'GI.Clutter.Objects.Score.Score' starts playing.
-- 
-- /Since: 0.6/
type ScoreStartedCallback =
    IO ()

type C_ScoreStartedCallback =
    Ptr Score ->                            -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ScoreStartedCallback :: 
    GObject a => (a -> ScoreStartedCallback) ->
    C_ScoreStartedCallback
wrap_ScoreStartedCallback :: forall a. GObject a => (a -> IO ()) -> C_ScoreCompletedCallback
wrap_ScoreStartedCallback a -> IO ()
gi'cb Ptr Score
gi'selfPtr Ptr ()
_ = do
    Ptr Score -> (Score -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Score
gi'selfPtr ((Score -> IO ()) -> IO ()) -> (Score -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Score
gi'self -> a -> IO ()
gi'cb (Score -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Score
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' score #started callback
-- @
-- 
-- 
onScoreStarted :: (IsScore a, MonadIO m) => a -> ((?self :: a) => ScoreStartedCallback) -> m SignalHandlerId
onScoreStarted :: forall a (m :: * -> *).
(IsScore a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onScoreStarted 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_ScoreCompletedCallback
wrapped' = (a -> IO ()) -> C_ScoreCompletedCallback
forall a. GObject a => (a -> IO ()) -> C_ScoreCompletedCallback
wrap_ScoreStartedCallback a -> IO ()
wrapped
    FunPtr C_ScoreCompletedCallback
wrapped'' <- C_ScoreCompletedCallback -> IO (FunPtr C_ScoreCompletedCallback)
mk_ScoreStartedCallback C_ScoreCompletedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScoreCompletedCallback
-> 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_ScoreCompletedCallback
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' score #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.
-- 
afterScoreStarted :: (IsScore a, MonadIO m) => a -> ((?self :: a) => ScoreStartedCallback) -> m SignalHandlerId
afterScoreStarted :: forall a (m :: * -> *).
(IsScore a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterScoreStarted 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_ScoreCompletedCallback
wrapped' = (a -> IO ()) -> C_ScoreCompletedCallback
forall a. GObject a => (a -> IO ()) -> C_ScoreCompletedCallback
wrap_ScoreStartedCallback a -> IO ()
wrapped
    FunPtr C_ScoreCompletedCallback
wrapped'' <- C_ScoreCompletedCallback -> IO (FunPtr C_ScoreCompletedCallback)
mk_ScoreStartedCallback C_ScoreCompletedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScoreCompletedCallback
-> 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_ScoreCompletedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


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

#endif

-- signal Score::timeline-completed
{-# DEPRECATED ScoreTimelineCompletedCallback ["(Since version 1.8)"] #-}
-- | The [timelineCompleted](#g:signal:timelineCompleted) signal is emitted each time a timeline
-- inside a t'GI.Clutter.Objects.Score.Score' terminates.
-- 
-- /Since: 0.6/
type ScoreTimelineCompletedCallback =
    Clutter.Timeline.Timeline
    -- ^ /@timeline@/: the completed timeline
    -> IO ()

type C_ScoreTimelineCompletedCallback =
    Ptr Score ->                            -- object
    Ptr Clutter.Timeline.Timeline ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ScoreTimelineCompletedCallback :: 
    GObject a => (a -> ScoreTimelineCompletedCallback) ->
    C_ScoreTimelineCompletedCallback
wrap_ScoreTimelineCompletedCallback :: forall a.
GObject a =>
(a -> ScoreTimelineCompletedCallback)
-> C_ScoreTimelineCompletedCallback
wrap_ScoreTimelineCompletedCallback a -> ScoreTimelineCompletedCallback
gi'cb Ptr Score
gi'selfPtr Ptr Timeline
timeline Ptr ()
_ = do
    Timeline
timeline' <- ((ManagedPtr Timeline -> Timeline) -> Ptr Timeline -> IO Timeline
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Timeline -> Timeline
Clutter.Timeline.Timeline) Ptr Timeline
timeline
    Ptr Score -> (Score -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Score
gi'selfPtr ((Score -> IO ()) -> IO ()) -> (Score -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Score
gi'self -> a -> ScoreTimelineCompletedCallback
gi'cb (Score -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Score
gi'self)  Timeline
timeline'


-- | Connect a signal handler for the [timelineCompleted](#signal:timelineCompleted) 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' score #timelineCompleted callback
-- @
-- 
-- 
onScoreTimelineCompleted :: (IsScore a, MonadIO m) => a -> ((?self :: a) => ScoreTimelineCompletedCallback) -> m SignalHandlerId
onScoreTimelineCompleted :: forall a (m :: * -> *).
(IsScore a, MonadIO m) =>
a
-> ((?self::a) => ScoreTimelineCompletedCallback)
-> m SignalHandlerId
onScoreTimelineCompleted a
obj (?self::a) => ScoreTimelineCompletedCallback
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 -> ScoreTimelineCompletedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ScoreTimelineCompletedCallback
ScoreTimelineCompletedCallback
cb
    let wrapped' :: C_ScoreTimelineCompletedCallback
wrapped' = (a -> ScoreTimelineCompletedCallback)
-> C_ScoreTimelineCompletedCallback
forall a.
GObject a =>
(a -> ScoreTimelineCompletedCallback)
-> C_ScoreTimelineCompletedCallback
wrap_ScoreTimelineCompletedCallback a -> ScoreTimelineCompletedCallback
wrapped
    FunPtr C_ScoreTimelineCompletedCallback
wrapped'' <- C_ScoreTimelineCompletedCallback
-> IO (FunPtr C_ScoreTimelineCompletedCallback)
mk_ScoreTimelineCompletedCallback C_ScoreTimelineCompletedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScoreTimelineCompletedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"timeline-completed" FunPtr C_ScoreTimelineCompletedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [timelineCompleted](#signal:timelineCompleted) 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' score #timelineCompleted 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.
-- 
afterScoreTimelineCompleted :: (IsScore a, MonadIO m) => a -> ((?self :: a) => ScoreTimelineCompletedCallback) -> m SignalHandlerId
afterScoreTimelineCompleted :: forall a (m :: * -> *).
(IsScore a, MonadIO m) =>
a
-> ((?self::a) => ScoreTimelineCompletedCallback)
-> m SignalHandlerId
afterScoreTimelineCompleted a
obj (?self::a) => ScoreTimelineCompletedCallback
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 -> ScoreTimelineCompletedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ScoreTimelineCompletedCallback
ScoreTimelineCompletedCallback
cb
    let wrapped' :: C_ScoreTimelineCompletedCallback
wrapped' = (a -> ScoreTimelineCompletedCallback)
-> C_ScoreTimelineCompletedCallback
forall a.
GObject a =>
(a -> ScoreTimelineCompletedCallback)
-> C_ScoreTimelineCompletedCallback
wrap_ScoreTimelineCompletedCallback a -> ScoreTimelineCompletedCallback
wrapped
    FunPtr C_ScoreTimelineCompletedCallback
wrapped'' <- C_ScoreTimelineCompletedCallback
-> IO (FunPtr C_ScoreTimelineCompletedCallback)
mk_ScoreTimelineCompletedCallback C_ScoreTimelineCompletedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScoreTimelineCompletedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"timeline-completed" FunPtr C_ScoreTimelineCompletedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


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

#endif

-- signal Score::timeline-started
{-# DEPRECATED ScoreTimelineStartedCallback ["(Since version 1.8)"] #-}
-- | The [timelineStarted](#g:signal:timelineStarted) signal is emitted each time a new timeline
-- inside a t'GI.Clutter.Objects.Score.Score' starts playing.
-- 
-- /Since: 0.6/
type ScoreTimelineStartedCallback =
    Clutter.Timeline.Timeline
    -- ^ /@timeline@/: the current timeline
    -> IO ()

type C_ScoreTimelineStartedCallback =
    Ptr Score ->                            -- object
    Ptr Clutter.Timeline.Timeline ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ScoreTimelineStartedCallback :: 
    GObject a => (a -> ScoreTimelineStartedCallback) ->
    C_ScoreTimelineStartedCallback
wrap_ScoreTimelineStartedCallback :: forall a.
GObject a =>
(a -> ScoreTimelineCompletedCallback)
-> C_ScoreTimelineCompletedCallback
wrap_ScoreTimelineStartedCallback a -> ScoreTimelineCompletedCallback
gi'cb Ptr Score
gi'selfPtr Ptr Timeline
timeline Ptr ()
_ = do
    Timeline
timeline' <- ((ManagedPtr Timeline -> Timeline) -> Ptr Timeline -> IO Timeline
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Timeline -> Timeline
Clutter.Timeline.Timeline) Ptr Timeline
timeline
    Ptr Score -> (Score -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Score
gi'selfPtr ((Score -> IO ()) -> IO ()) -> (Score -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Score
gi'self -> a -> ScoreTimelineCompletedCallback
gi'cb (Score -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Score
gi'self)  Timeline
timeline'


-- | Connect a signal handler for the [timelineStarted](#signal:timelineStarted) 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' score #timelineStarted callback
-- @
-- 
-- 
onScoreTimelineStarted :: (IsScore a, MonadIO m) => a -> ((?self :: a) => ScoreTimelineStartedCallback) -> m SignalHandlerId
onScoreTimelineStarted :: forall a (m :: * -> *).
(IsScore a, MonadIO m) =>
a
-> ((?self::a) => ScoreTimelineCompletedCallback)
-> m SignalHandlerId
onScoreTimelineStarted a
obj (?self::a) => ScoreTimelineCompletedCallback
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 -> ScoreTimelineCompletedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ScoreTimelineCompletedCallback
ScoreTimelineCompletedCallback
cb
    let wrapped' :: C_ScoreTimelineCompletedCallback
wrapped' = (a -> ScoreTimelineCompletedCallback)
-> C_ScoreTimelineCompletedCallback
forall a.
GObject a =>
(a -> ScoreTimelineCompletedCallback)
-> C_ScoreTimelineCompletedCallback
wrap_ScoreTimelineStartedCallback a -> ScoreTimelineCompletedCallback
wrapped
    FunPtr C_ScoreTimelineCompletedCallback
wrapped'' <- C_ScoreTimelineCompletedCallback
-> IO (FunPtr C_ScoreTimelineCompletedCallback)
mk_ScoreTimelineStartedCallback C_ScoreTimelineCompletedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScoreTimelineCompletedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"timeline-started" FunPtr C_ScoreTimelineCompletedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [timelineStarted](#signal:timelineStarted) 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' score #timelineStarted 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.
-- 
afterScoreTimelineStarted :: (IsScore a, MonadIO m) => a -> ((?self :: a) => ScoreTimelineStartedCallback) -> m SignalHandlerId
afterScoreTimelineStarted :: forall a (m :: * -> *).
(IsScore a, MonadIO m) =>
a
-> ((?self::a) => ScoreTimelineCompletedCallback)
-> m SignalHandlerId
afterScoreTimelineStarted a
obj (?self::a) => ScoreTimelineCompletedCallback
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 -> ScoreTimelineCompletedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ScoreTimelineCompletedCallback
ScoreTimelineCompletedCallback
cb
    let wrapped' :: C_ScoreTimelineCompletedCallback
wrapped' = (a -> ScoreTimelineCompletedCallback)
-> C_ScoreTimelineCompletedCallback
forall a.
GObject a =>
(a -> ScoreTimelineCompletedCallback)
-> C_ScoreTimelineCompletedCallback
wrap_ScoreTimelineStartedCallback a -> ScoreTimelineCompletedCallback
wrapped
    FunPtr C_ScoreTimelineCompletedCallback
wrapped'' <- C_ScoreTimelineCompletedCallback
-> IO (FunPtr C_ScoreTimelineCompletedCallback)
mk_ScoreTimelineStartedCallback C_ScoreTimelineCompletedCallback
wrapped'
    a
-> Text
-> FunPtr C_ScoreTimelineCompletedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"timeline-started" FunPtr C_ScoreTimelineCompletedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


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

#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' score #loop
-- @
getScoreLoop :: (MonadIO m, IsScore o) => o -> m Bool
getScoreLoop :: forall (m :: * -> *) o. (MonadIO m, IsScore o) => o -> m Bool
getScoreLoop 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' score [ #loop 'Data.GI.Base.Attributes.:=' value ]
-- @
setScoreLoop :: (MonadIO m, IsScore o) => o -> Bool -> m ()
setScoreLoop :: forall (m :: * -> *) o. (MonadIO m, IsScore o) => o -> Bool -> m ()
setScoreLoop o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"loop" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@loop@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructScoreLoop :: (IsScore o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructScoreLoop :: forall o (m :: * -> *).
(IsScore o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructScoreLoop 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 ScoreLoopPropertyInfo
instance AttrInfo ScoreLoopPropertyInfo where
    type AttrAllowedOps ScoreLoopPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ScoreLoopPropertyInfo = IsScore
    type AttrSetTypeConstraint ScoreLoopPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ScoreLoopPropertyInfo = (~) Bool
    type AttrTransferType ScoreLoopPropertyInfo = Bool
    type AttrGetType ScoreLoopPropertyInfo = Bool
    type AttrLabel ScoreLoopPropertyInfo = "loop"
    type AttrOrigin ScoreLoopPropertyInfo = Score
    attrGet = getScoreLoop
    attrSet = setScoreLoop
    attrTransfer _ v = do
        return v
    attrConstruct = constructScoreLoop
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Score.loop"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Score.html#g:attr:loop"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Score
type instance O.AttributeList Score = ScoreAttributeList
type ScoreAttributeList = ('[ '("loop", ScoreLoopPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
scoreLoop :: AttrLabelProxy "loop"
scoreLoop = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Score = ScoreSignalList
type ScoreSignalList = ('[ '("completed", ScoreCompletedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("paused", ScorePausedSignalInfo), '("started", ScoreStartedSignalInfo), '("timelineCompleted", ScoreTimelineCompletedSignalInfo), '("timelineStarted", ScoreTimelineStartedSignalInfo)] :: [(Symbol, *)])

#endif

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

foreign import ccall "clutter_score_new" clutter_score_new :: 
    IO (Ptr Score)

{-# DEPRECATED scoreNew ["(Since version 1.8)"] #-}
-- | Creates a new t'GI.Clutter.Objects.Score.Score'. A t'GI.Clutter.Objects.Score.Score' is an object that can
-- hold multiple t'GI.Clutter.Objects.Timeline.Timeline's in a sequential order.
-- 
-- /Since: 0.6/
scoreNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Score
    -- ^ __Returns:__ the newly created t'GI.Clutter.Objects.Score.Score'. Use 'GI.GObject.Objects.Object.objectUnref'
    --   when done.
scoreNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Score
scoreNew  = IO Score -> m Score
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Score -> m Score) -> IO Score -> m Score
forall a b. (a -> b) -> a -> b
$ do
    Ptr Score
result <- IO (Ptr Score)
clutter_score_new
    Text -> Ptr Score -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"scoreNew" Ptr Score
result
    Score
result' <- ((ManagedPtr Score -> Score) -> Ptr Score -> IO Score
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Score -> Score
Score) Ptr Score
result
    Score -> IO Score
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Score
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Score::append
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "score"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Score" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScore" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Timeline" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterTimeline in the score, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeline"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Timeline" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterTimeline" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TULong)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_score_append" clutter_score_append :: 
    Ptr Score ->                            -- score : TInterface (Name {namespace = "Clutter", name = "Score"})
    Ptr Clutter.Timeline.Timeline ->        -- parent : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    Ptr Clutter.Timeline.Timeline ->        -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    IO CULong

{-# DEPRECATED scoreAppend ["(Since version 1.8)"] #-}
-- | Appends a timeline to another one existing in the score; the newly
-- appended timeline will be started when /@parent@/ is complete.
-- 
-- If /@parent@/ is 'P.Nothing', the new t'GI.Clutter.Objects.Timeline.Timeline' will be started when
-- 'GI.Clutter.Objects.Score.scoreStart' is called.
-- 
-- t'GI.Clutter.Objects.Score.Score' will take a reference on /@timeline@/.
-- 
-- /Since: 0.6/
scoreAppend ::
    (B.CallStack.HasCallStack, MonadIO m, IsScore a, Clutter.Timeline.IsTimeline b, Clutter.Timeline.IsTimeline c) =>
    a
    -- ^ /@score@/: a t'GI.Clutter.Objects.Score.Score'
    -> Maybe (b)
    -- ^ /@parent@/: a t'GI.Clutter.Objects.Timeline.Timeline' in the score, or 'P.Nothing'
    -> c
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> m CULong
    -- ^ __Returns:__ the id of the t'GI.Clutter.Objects.Timeline.Timeline' inside the score, or
    --   0 on failure. The returned id can be used with 'GI.Clutter.Objects.Score.scoreRemove'
    --   or 'GI.Clutter.Objects.Score.scoreGetTimeline'.
scoreAppend :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsScore a, IsTimeline b, IsTimeline c) =>
a -> Maybe b -> c -> m SignalHandlerId
scoreAppend a
score Maybe b
parent c
timeline = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    Ptr Score
score' <- a -> IO (Ptr Score)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
score
    Ptr Timeline
maybeParent <- case Maybe b
parent of
        Maybe b
Nothing -> Ptr Timeline -> IO (Ptr Timeline)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Timeline
forall a. Ptr a
nullPtr
        Just b
jParent -> do
            Ptr Timeline
jParent' <- b -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            Ptr Timeline -> IO (Ptr Timeline)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Timeline
jParent'
    Ptr Timeline
timeline' <- c -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
timeline
    SignalHandlerId
result <- Ptr Score -> Ptr Timeline -> Ptr Timeline -> IO SignalHandlerId
clutter_score_append Ptr Score
score' Ptr Timeline
maybeParent Ptr Timeline
timeline'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
score
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
parent b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
timeline
    SignalHandlerId -> IO SignalHandlerId
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SignalHandlerId
result

#if defined(ENABLE_OVERLOADING)
data ScoreAppendMethodInfo
instance (signature ~ (Maybe (b) -> c -> m CULong), MonadIO m, IsScore a, Clutter.Timeline.IsTimeline b, Clutter.Timeline.IsTimeline c) => O.OverloadedMethod ScoreAppendMethodInfo a signature where
    overloadedMethod = scoreAppend

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


#endif

-- method Score::append_at_marker
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "score"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Score" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScore" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Timeline" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent #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 use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeline"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Timeline" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #ClutterTimeline to append"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TULong)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_score_append_at_marker" clutter_score_append_at_marker :: 
    Ptr Score ->                            -- score : TInterface (Name {namespace = "Clutter", name = "Score"})
    Ptr Clutter.Timeline.Timeline ->        -- parent : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    CString ->                              -- marker_name : TBasicType TUTF8
    Ptr Clutter.Timeline.Timeline ->        -- timeline : TInterface (Name {namespace = "Clutter", name = "Timeline"})
    IO CULong

{-# DEPRECATED scoreAppendAtMarker ["(Since version 1.8)"] #-}
-- | Appends /@timeline@/ at the given /@markerName@/ on the /@parent@/
-- t'GI.Clutter.Objects.Timeline.Timeline'.
-- 
-- If you want to append /@timeline@/ at the end of /@parent@/, use
-- 'GI.Clutter.Objects.Score.scoreAppend'.
-- 
-- The t'GI.Clutter.Objects.Score.Score' will take a reference on /@timeline@/.
-- 
-- /Since: 0.8/
scoreAppendAtMarker ::
    (B.CallStack.HasCallStack, MonadIO m, IsScore a, Clutter.Timeline.IsTimeline b, Clutter.Timeline.IsTimeline c) =>
    a
    -- ^ /@score@/: a t'GI.Clutter.Objects.Score.Score'
    -> b
    -- ^ /@parent@/: the parent t'GI.Clutter.Objects.Timeline.Timeline'
    -> T.Text
    -- ^ /@markerName@/: the name of the marker to use
    -> c
    -- ^ /@timeline@/: the t'GI.Clutter.Objects.Timeline.Timeline' to append
    -> m CULong
    -- ^ __Returns:__ the id of the t'GI.Clutter.Objects.Timeline.Timeline' inside the score, or
    --   0 on failure. The returned id can be used with 'GI.Clutter.Objects.Score.scoreRemove'
    --   or 'GI.Clutter.Objects.Score.scoreGetTimeline'.
scoreAppendAtMarker :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsScore a, IsTimeline b, IsTimeline c) =>
a -> b -> Text -> c -> m SignalHandlerId
scoreAppendAtMarker a
score b
parent Text
markerName c
timeline = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    Ptr Score
score' <- a -> IO (Ptr Score)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
score
    Ptr Timeline
parent' <- b -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
parent
    CString
markerName' <- Text -> IO CString
textToCString Text
markerName
    Ptr Timeline
timeline' <- c -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
timeline
    SignalHandlerId
result <- Ptr Score
-> Ptr Timeline -> CString -> Ptr Timeline -> IO SignalHandlerId
clutter_score_append_at_marker Ptr Score
score' Ptr Timeline
parent' CString
markerName' Ptr Timeline
timeline'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
score
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
parent
    c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
timeline
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
markerName'
    SignalHandlerId -> IO SignalHandlerId
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SignalHandlerId
result

#if defined(ENABLE_OVERLOADING)
data ScoreAppendAtMarkerMethodInfo
instance (signature ~ (b -> T.Text -> c -> m CULong), MonadIO m, IsScore a, Clutter.Timeline.IsTimeline b, Clutter.Timeline.IsTimeline c) => O.OverloadedMethod ScoreAppendAtMarkerMethodInfo a signature where
    overloadedMethod = scoreAppendAtMarker

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


#endif

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

{-# DEPRECATED scoreGetLoop ["(Since version 1.8)"] #-}
-- | Gets whether /@score@/ is looping
-- 
-- /Since: 0.6/
scoreGetLoop ::
    (B.CallStack.HasCallStack, MonadIO m, IsScore a) =>
    a
    -- ^ /@score@/: a t'GI.Clutter.Objects.Score.Score'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the score is looping
scoreGetLoop :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScore a) =>
a -> m Bool
scoreGetLoop a
score = 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 Score
score' <- a -> IO (Ptr Score)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
score
    CInt
result <- Ptr Score -> IO CInt
clutter_score_get_loop Ptr Score
score'
    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
score
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ScoreGetLoopMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsScore a) => O.OverloadedMethod ScoreGetLoopMethodInfo a signature where
    overloadedMethod = scoreGetLoop

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


#endif

-- method Score::get_timeline
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "score"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Score" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScore" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id_"
--           , argType = TBasicType TULong
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the id of the timeline"
--                 , 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_score_get_timeline" clutter_score_get_timeline :: 
    Ptr Score ->                            -- score : TInterface (Name {namespace = "Clutter", name = "Score"})
    CULong ->                               -- id_ : TBasicType TULong
    IO (Ptr Clutter.Timeline.Timeline)

{-# DEPRECATED scoreGetTimeline ["(Since version 1.8)"] #-}
-- | Retrieves the t'GI.Clutter.Objects.Timeline.Timeline' for /@id_@/ inside /@score@/.
-- 
-- /Since: 0.6/
scoreGetTimeline ::
    (B.CallStack.HasCallStack, MonadIO m, IsScore a) =>
    a
    -- ^ /@score@/: a t'GI.Clutter.Objects.Score.Score'
    -> CULong
    -- ^ /@id_@/: the id of the timeline
    -> m Clutter.Timeline.Timeline
    -- ^ __Returns:__ the requested timeline, or 'P.Nothing'. This
    --   function does not increase the reference count on the returned
    --   t'GI.Clutter.Objects.Timeline.Timeline'
scoreGetTimeline :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScore a) =>
a -> SignalHandlerId -> m Timeline
scoreGetTimeline a
score SignalHandlerId
id_ = 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 Score
score' <- a -> IO (Ptr Score)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
score
    Ptr Timeline
result <- Ptr Score -> SignalHandlerId -> IO (Ptr Timeline)
clutter_score_get_timeline Ptr Score
score' SignalHandlerId
id_
    Text -> Ptr Timeline -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"scoreGetTimeline" Ptr Timeline
result
    Timeline
result' <- ((ManagedPtr Timeline -> Timeline) -> Ptr Timeline -> IO Timeline
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Timeline -> Timeline
Clutter.Timeline.Timeline) Ptr Timeline
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
score
    Timeline -> IO Timeline
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Timeline
result'

#if defined(ENABLE_OVERLOADING)
data ScoreGetTimelineMethodInfo
instance (signature ~ (CULong -> m Clutter.Timeline.Timeline), MonadIO m, IsScore a) => O.OverloadedMethod ScoreGetTimelineMethodInfo a signature where
    overloadedMethod = scoreGetTimeline

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


#endif

-- method Score::is_playing
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "score"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Score" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #ClutterScore" , 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_score_is_playing" clutter_score_is_playing :: 
    Ptr Score ->                            -- score : TInterface (Name {namespace = "Clutter", name = "Score"})
    IO CInt

{-# DEPRECATED scoreIsPlaying ["(Since version 1.8)"] #-}
-- | Query state of a t'GI.Clutter.Objects.Score.Score' instance.
-- 
-- /Since: 0.6/
scoreIsPlaying ::
    (B.CallStack.HasCallStack, MonadIO m, IsScore a) =>
    a
    -- ^ /@score@/: A t'GI.Clutter.Objects.Score.Score'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if score is currently playing
scoreIsPlaying :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScore a) =>
a -> m Bool
scoreIsPlaying a
score = 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 Score
score' <- a -> IO (Ptr Score)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
score
    CInt
result <- Ptr Score -> IO CInt
clutter_score_is_playing Ptr Score
score'
    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
score
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ScoreIsPlayingMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsScore a) => O.OverloadedMethod ScoreIsPlayingMethodInfo a signature where
    overloadedMethod = scoreIsPlaying

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


#endif

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

foreign import ccall "clutter_score_list_timelines" clutter_score_list_timelines :: 
    Ptr Score ->                            -- score : TInterface (Name {namespace = "Clutter", name = "Score"})
    IO (Ptr (GSList (Ptr Clutter.Timeline.Timeline)))

{-# DEPRECATED scoreListTimelines ["(Since version 1.8)"] #-}
-- | Retrieves a list of all the @/ClutterTimelines/@ managed by /@score@/.
-- 
-- /Since: 0.6/
scoreListTimelines ::
    (B.CallStack.HasCallStack, MonadIO m, IsScore a) =>
    a
    -- ^ /@score@/: a t'GI.Clutter.Objects.Score.Score'
    -> m [Clutter.Timeline.Timeline]
    -- ^ __Returns:__ a
    --   t'GI.GLib.Structs.SList.SList' containing all the timelines in the score. This function does
    --   not increase the reference count of the returned timelines. Use
    --   @/g_slist_free()/@ on the returned list to deallocate its resources.
scoreListTimelines :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScore a) =>
a -> m [Timeline]
scoreListTimelines a
score = 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 Score
score' <- a -> IO (Ptr Score)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
score
    Ptr (GSList (Ptr Timeline))
result <- Ptr Score -> IO (Ptr (GSList (Ptr Timeline)))
clutter_score_list_timelines Ptr Score
score'
    [Ptr Timeline]
result' <- Ptr (GSList (Ptr Timeline)) -> IO [Ptr Timeline]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList (Ptr Timeline))
result
    [Timeline]
result'' <- (Ptr Timeline -> IO Timeline) -> [Ptr Timeline] -> IO [Timeline]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr Timeline -> Timeline) -> Ptr Timeline -> IO Timeline
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Timeline -> Timeline
Clutter.Timeline.Timeline) [Ptr Timeline]
result'
    Ptr (GSList (Ptr Timeline)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr Timeline))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
score
    [Timeline] -> IO [Timeline]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Timeline]
result''

#if defined(ENABLE_OVERLOADING)
data ScoreListTimelinesMethodInfo
instance (signature ~ (m [Clutter.Timeline.Timeline]), MonadIO m, IsScore a) => O.OverloadedMethod ScoreListTimelinesMethodInfo a signature where
    overloadedMethod = scoreListTimelines

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


#endif

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

foreign import ccall "clutter_score_pause" clutter_score_pause :: 
    Ptr Score ->                            -- score : TInterface (Name {namespace = "Clutter", name = "Score"})
    IO ()

{-# DEPRECATED scorePause ["(Since version 1.8)"] #-}
-- | Pauses a playing score /@score@/.
-- 
-- /Since: 0.6/
scorePause ::
    (B.CallStack.HasCallStack, MonadIO m, IsScore a) =>
    a
    -- ^ /@score@/: a t'GI.Clutter.Objects.Score.Score'
    -> m ()
scorePause :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScore a) =>
a -> m ()
scorePause a
score = 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 Score
score' <- a -> IO (Ptr Score)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
score
    Ptr Score -> IO ()
clutter_score_pause Ptr Score
score'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
score
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ScorePauseMethodInfo
instance (signature ~ (m ()), MonadIO m, IsScore a) => O.OverloadedMethod ScorePauseMethodInfo a signature where
    overloadedMethod = scorePause

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


#endif

-- method Score::remove
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "score"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Score" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScore" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id_"
--           , argType = TBasicType TULong
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the id of the timeline 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_score_remove" clutter_score_remove :: 
    Ptr Score ->                            -- score : TInterface (Name {namespace = "Clutter", name = "Score"})
    CULong ->                               -- id_ : TBasicType TULong
    IO ()

{-# DEPRECATED scoreRemove ["(Since version 1.8)"] #-}
-- | Removes the t'GI.Clutter.Objects.Timeline.Timeline' with the given id inside /@score@/. If
-- the timeline has other timelines attached to it, those are removed
-- as well.
-- 
-- /Since: 0.6/
scoreRemove ::
    (B.CallStack.HasCallStack, MonadIO m, IsScore a) =>
    a
    -- ^ /@score@/: a t'GI.Clutter.Objects.Score.Score'
    -> CULong
    -- ^ /@id_@/: the id of the timeline to remove
    -> m ()
scoreRemove :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScore a) =>
a -> SignalHandlerId -> m ()
scoreRemove a
score SignalHandlerId
id_ = 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 Score
score' <- a -> IO (Ptr Score)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
score
    Ptr Score -> SignalHandlerId -> IO ()
clutter_score_remove Ptr Score
score' SignalHandlerId
id_
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
score
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ScoreRemoveMethodInfo
instance (signature ~ (CULong -> m ()), MonadIO m, IsScore a) => O.OverloadedMethod ScoreRemoveMethodInfo a signature where
    overloadedMethod = scoreRemove

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


#endif

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

foreign import ccall "clutter_score_remove_all" clutter_score_remove_all :: 
    Ptr Score ->                            -- score : TInterface (Name {namespace = "Clutter", name = "Score"})
    IO ()

{-# DEPRECATED scoreRemoveAll ["(Since version 1.8)"] #-}
-- | Removes all the timelines inside /@score@/.
-- 
-- /Since: 0.6/
scoreRemoveAll ::
    (B.CallStack.HasCallStack, MonadIO m, IsScore a) =>
    a
    -- ^ /@score@/: a t'GI.Clutter.Objects.Score.Score'
    -> m ()
scoreRemoveAll :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScore a) =>
a -> m ()
scoreRemoveAll a
score = 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 Score
score' <- a -> IO (Ptr Score)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
score
    Ptr Score -> IO ()
clutter_score_remove_all Ptr Score
score'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
score
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ScoreRemoveAllMethodInfo
instance (signature ~ (m ()), MonadIO m, IsScore a) => O.OverloadedMethod ScoreRemoveAllMethodInfo a signature where
    overloadedMethod = scoreRemoveAll

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


#endif

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

foreign import ccall "clutter_score_rewind" clutter_score_rewind :: 
    Ptr Score ->                            -- score : TInterface (Name {namespace = "Clutter", name = "Score"})
    IO ()

{-# DEPRECATED scoreRewind ["(Since version 1.8)"] #-}
-- | Rewinds a t'GI.Clutter.Objects.Score.Score' to its initial state.
-- 
-- /Since: 0.6/
scoreRewind ::
    (B.CallStack.HasCallStack, MonadIO m, IsScore a) =>
    a
    -- ^ /@score@/: A t'GI.Clutter.Objects.Score.Score'
    -> m ()
scoreRewind :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScore a) =>
a -> m ()
scoreRewind a
score = 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 Score
score' <- a -> IO (Ptr Score)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
score
    Ptr Score -> IO ()
clutter_score_rewind Ptr Score
score'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
score
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ScoreRewindMethodInfo
instance (signature ~ (m ()), MonadIO m, IsScore a) => O.OverloadedMethod ScoreRewindMethodInfo a signature where
    overloadedMethod = scoreRewind

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


#endif

-- method Score::set_loop
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "score"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Score" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScore" , 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_score_set_loop" clutter_score_set_loop :: 
    Ptr Score ->                            -- score : TInterface (Name {namespace = "Clutter", name = "Score"})
    CInt ->                                 -- loop : TBasicType TBoolean
    IO ()

{-# DEPRECATED scoreSetLoop ["(Since version 1.8)"] #-}
-- | Sets whether /@score@/ should loop. A looping t'GI.Clutter.Objects.Score.Score' will start
-- from its initial state after the [complete](#g:signal:complete) signal has been fired.
-- 
-- /Since: 0.6/
scoreSetLoop ::
    (B.CallStack.HasCallStack, MonadIO m, IsScore a) =>
    a
    -- ^ /@score@/: a t'GI.Clutter.Objects.Score.Score'
    -> Bool
    -- ^ /@loop@/: 'P.True' for enable looping
    -> m ()
scoreSetLoop :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScore a) =>
a -> Bool -> m ()
scoreSetLoop a
score 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 Score
score' <- a -> IO (Ptr Score)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
score
    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 Score -> CInt -> IO ()
clutter_score_set_loop Ptr Score
score' CInt
loop'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
score
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ScoreSetLoopMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsScore a) => O.OverloadedMethod ScoreSetLoopMethodInfo a signature where
    overloadedMethod = scoreSetLoop

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


#endif

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

foreign import ccall "clutter_score_start" clutter_score_start :: 
    Ptr Score ->                            -- score : TInterface (Name {namespace = "Clutter", name = "Score"})
    IO ()

{-# DEPRECATED scoreStart ["(Since version 1.8)"] #-}
-- | Starts the score.
-- 
-- /Since: 0.6/
scoreStart ::
    (B.CallStack.HasCallStack, MonadIO m, IsScore a) =>
    a
    -- ^ /@score@/: A t'GI.Clutter.Objects.Score.Score'
    -> m ()
scoreStart :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScore a) =>
a -> m ()
scoreStart a
score = 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 Score
score' <- a -> IO (Ptr Score)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
score
    Ptr Score -> IO ()
clutter_score_start Ptr Score
score'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
score
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ScoreStartMethodInfo
instance (signature ~ (m ()), MonadIO m, IsScore a) => O.OverloadedMethod ScoreStartMethodInfo a signature where
    overloadedMethod = scoreStart

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


#endif

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

foreign import ccall "clutter_score_stop" clutter_score_stop :: 
    Ptr Score ->                            -- score : TInterface (Name {namespace = "Clutter", name = "Score"})
    IO ()

{-# DEPRECATED scoreStop ["(Since version 1.8)"] #-}
-- | Stops and rewinds a playing t'GI.Clutter.Objects.Score.Score' instance.
-- 
-- /Since: 0.6/
scoreStop ::
    (B.CallStack.HasCallStack, MonadIO m, IsScore a) =>
    a
    -- ^ /@score@/: A t'GI.Clutter.Objects.Score.Score'
    -> m ()
scoreStop :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScore a) =>
a -> m ()
scoreStop a
score = 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 Score
score' <- a -> IO (Ptr Score)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
score
    Ptr Score -> IO ()
clutter_score_stop Ptr Score
score'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
score
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ScoreStopMethodInfo
instance (signature ~ (m ()), MonadIO m, IsScore a) => O.OverloadedMethod ScoreStopMethodInfo a signature where
    overloadedMethod = scoreStop

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


#endif