{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.GES.Objects.BaseEffect.BaseEffect' is some operation that applies an effect to the data
-- it receives.
-- 
-- == Time Effects
-- 
-- Some operations will change the timing of the stream data they receive
-- in some way. In particular, the t'GI.Gst.Objects.Element.Element' that they wrap could alter
-- the times of the segment they receive in a @/GST_EVENT_SEGMENT/@ event,
-- or the times of a seek they receive in a @/GST_EVENT_SEEK/@ event. Such
-- operations would be considered time effects since they translate the
-- times they receive on their source to different times at their sink,
-- and vis versa. This introduces two sets of time coordinates for the
-- event: (internal) sink coordinates and (internal) source coordinates,
-- where segment times are translated from the sink coordinates to the
-- source coordinates, and seek times are translated from the source
-- coordinates to the sink coordinates.
-- 
-- If you use such an effect in GES, you will need to inform GES of the
-- properties that control the timing with
-- 'GI.GES.Objects.BaseEffect.baseEffectRegisterTimeProperty', and the effect\'s timing
-- behaviour using 'GI.GES.Objects.BaseEffect.baseEffectSetTimeTranslationFuncs'.
-- 
-- Note that a time effect should not have its
-- [TrackElement:hasInternalSource]("GI.GES.Objects.TrackElement#g:attr:hasInternalSource") set to 'P.True'.
-- 
-- In addition, note that GES only *fully* supports time effects whose
-- mapping from the source to sink coordinates (those applied to seeks)
-- obeys:
-- 
-- + Maps the time @0@ to @0@. So initial time-shifting effects are
--   excluded.
-- + Is monotonically increasing. So reversing effects, and effects that
--   jump backwards in the stream are excluded.
-- + Can handle a reasonable @/GstClockTime/@, relative to the project. So
--   this would exclude a time effect with an extremely large speed-up
--   that would cause the converted @/GstClockTime/@ seeks to overflow.
-- + Is \'continuously reversible\'. This essentially means that for every
--   time in the sink coordinates, we can, to \'good enough\' accuracy,
--   calculate the corresponding time in the source coordinates. Moreover,
--   this should correspond to how segment times are translated from
--   sink to source.
-- + Only depends on the registered time properties, rather than the
--   state of the t'GI.Gst.Objects.Element.Element' or the data it receives. This would exclude,
--   say, an effect that would speedup if there is more red in the image
--   it receives.
-- 
-- Note that a constant-rate-change effect that is not extremely fast or
-- slow would satisfy these conditions. For such effects, you may wish to
-- use 'GI.GES.Structs.EffectClass.effectClassRegisterRateProperty'.

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

module GI.GES.Objects.BaseEffect
    ( 

-- * Exported types
    BaseEffect(..)                          ,
    IsBaseEffect                            ,
    toBaseEffect                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addChildProperty]("GI.GES.Objects.TimelineElement#g:method:addChildProperty"), [addChildrenProps]("GI.GES.Objects.TrackElement#g:method:addChildrenProps"), [addMetasFromString]("GI.GES.Interfaces.MetaContainer#g:method:addMetasFromString"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [checkMetaRegistered]("GI.GES.Interfaces.MetaContainer#g:method:checkMetaRegistered"), [clampControlSource]("GI.GES.Objects.TrackElement#g:method:clampControlSource"), [copy]("GI.GES.Objects.TimelineElement#g:method:copy"), [edit]("GI.GES.Objects.TrackElement#g:method:edit"), [editFull]("GI.GES.Objects.TimelineElement#g:method:editFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [foreach]("GI.GES.Interfaces.MetaContainer#g:method:foreach"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasInternalSource]("GI.GES.Objects.TrackElement#g:method:hasInternalSource"), [isActive]("GI.GES.Objects.TrackElement#g:method:isActive"), [isCore]("GI.GES.Objects.TrackElement#g:method:isCore"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isTimeEffect]("GI.GES.Objects.BaseEffect#g:method:isTimeEffect"), [listChildrenProperties]("GI.GES.Objects.TrackElement#g:method:listChildrenProperties"), [lookupChild]("GI.GES.Objects.TrackElement#g:method:lookupChild"), [metasToString]("GI.GES.Interfaces.MetaContainer#g:method:metasToString"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [paste]("GI.GES.Objects.TimelineElement#g:method:paste"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [registerMeta]("GI.GES.Interfaces.MetaContainer#g:method:registerMeta"), [registerMetaBoolean]("GI.GES.Interfaces.MetaContainer#g:method:registerMetaBoolean"), [registerMetaDate]("GI.GES.Interfaces.MetaContainer#g:method:registerMetaDate"), [registerMetaDateTime]("GI.GES.Interfaces.MetaContainer#g:method:registerMetaDateTime"), [registerMetaDouble]("GI.GES.Interfaces.MetaContainer#g:method:registerMetaDouble"), [registerMetaFloat]("GI.GES.Interfaces.MetaContainer#g:method:registerMetaFloat"), [registerMetaInt]("GI.GES.Interfaces.MetaContainer#g:method:registerMetaInt"), [registerMetaInt64]("GI.GES.Interfaces.MetaContainer#g:method:registerMetaInt64"), [registerMetaString]("GI.GES.Interfaces.MetaContainer#g:method:registerMetaString"), [registerMetaUint]("GI.GES.Interfaces.MetaContainer#g:method:registerMetaUint"), [registerMetaUint64]("GI.GES.Interfaces.MetaContainer#g:method:registerMetaUint64"), [registerStaticMeta]("GI.GES.Interfaces.MetaContainer#g:method:registerStaticMeta"), [registerTimeProperty]("GI.GES.Objects.BaseEffect#g:method:registerTimeProperty"), [removeChildProperty]("GI.GES.Objects.TimelineElement#g:method:removeChildProperty"), [removeControlBinding]("GI.GES.Objects.TrackElement#g:method:removeControlBinding"), [ripple]("GI.GES.Objects.TimelineElement#g:method:ripple"), [rippleEnd]("GI.GES.Objects.TimelineElement#g:method:rippleEnd"), [rollEnd]("GI.GES.Objects.TimelineElement#g:method:rollEnd"), [rollStart]("GI.GES.Objects.TimelineElement#g:method:rollStart"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [trim]("GI.GES.Objects.TimelineElement#g:method:trim"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAllControlBindings]("GI.GES.Objects.TrackElement#g:method:getAllControlBindings"), [getAsset]("GI.GES.Interfaces.Extractable#g:method:getAsset"), [getAutoClampControlSources]("GI.GES.Objects.TrackElement#g:method:getAutoClampControlSources"), [getBoolean]("GI.GES.Interfaces.MetaContainer#g:method:getBoolean"), [getChildProperty]("GI.GES.Objects.TimelineElement#g:method:getChildProperty"), [getChildPropertyByPspec]("GI.GES.Objects.TimelineElement#g:method:getChildPropertyByPspec"), [getControlBinding]("GI.GES.Objects.TrackElement#g:method:getControlBinding"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDate]("GI.GES.Interfaces.MetaContainer#g:method:getDate"), [getDateTime]("GI.GES.Interfaces.MetaContainer#g:method:getDateTime"), [getDouble]("GI.GES.Interfaces.MetaContainer#g:method:getDouble"), [getDuration]("GI.GES.Objects.TimelineElement#g:method:getDuration"), [getElement]("GI.GES.Objects.TrackElement#g:method:getElement"), [getFloat]("GI.GES.Interfaces.MetaContainer#g:method:getFloat"), [getGnlobject]("GI.GES.Objects.TrackElement#g:method:getGnlobject"), [getId]("GI.GES.Interfaces.Extractable#g:method:getId"), [getInpoint]("GI.GES.Objects.TimelineElement#g:method:getInpoint"), [getInt]("GI.GES.Interfaces.MetaContainer#g:method:getInt"), [getInt64]("GI.GES.Interfaces.MetaContainer#g:method:getInt64"), [getLayerPriority]("GI.GES.Objects.TimelineElement#g:method:getLayerPriority"), [getMarkerList]("GI.GES.Interfaces.MetaContainer#g:method:getMarkerList"), [getMaxDuration]("GI.GES.Objects.TimelineElement#g:method:getMaxDuration"), [getMeta]("GI.GES.Interfaces.MetaContainer#g:method:getMeta"), [getName]("GI.GES.Objects.TimelineElement#g:method:getName"), [getNaturalFramerate]("GI.GES.Objects.TimelineElement#g:method:getNaturalFramerate"), [getNleobject]("GI.GES.Objects.TrackElement#g:method:getNleobject"), [getParent]("GI.GES.Objects.TimelineElement#g:method:getParent"), [getPriority]("GI.GES.Objects.TimelineElement#g:method:getPriority"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getStart]("GI.GES.Objects.TimelineElement#g:method:getStart"), [getString]("GI.GES.Interfaces.MetaContainer#g:method:getString"), [getTimeline]("GI.GES.Objects.TimelineElement#g:method:getTimeline"), [getToplevelParent]("GI.GES.Objects.TimelineElement#g:method:getToplevelParent"), [getTrack]("GI.GES.Objects.TrackElement#g:method:getTrack"), [getTrackType]("GI.GES.Objects.TrackElement#g:method:getTrackType"), [getTrackTypes]("GI.GES.Objects.TimelineElement#g:method:getTrackTypes"), [getUint]("GI.GES.Interfaces.MetaContainer#g:method:getUint"), [getUint64]("GI.GES.Interfaces.MetaContainer#g:method:getUint64").
-- 
-- ==== Setters
-- [setActive]("GI.GES.Objects.TrackElement#g:method:setActive"), [setAsset]("GI.GES.Interfaces.Extractable#g:method:setAsset"), [setAutoClampControlSources]("GI.GES.Objects.TrackElement#g:method:setAutoClampControlSources"), [setBoolean]("GI.GES.Interfaces.MetaContainer#g:method:setBoolean"), [setChildProperty]("GI.GES.Objects.TimelineElement#g:method:setChildProperty"), [setChildPropertyByPspec]("GI.GES.Objects.TimelineElement#g:method:setChildPropertyByPspec"), [setChildPropertyFull]("GI.GES.Objects.TimelineElement#g:method:setChildPropertyFull"), [setControlSource]("GI.GES.Objects.TrackElement#g:method:setControlSource"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDate]("GI.GES.Interfaces.MetaContainer#g:method:setDate"), [setDateTime]("GI.GES.Interfaces.MetaContainer#g:method:setDateTime"), [setDouble]("GI.GES.Interfaces.MetaContainer#g:method:setDouble"), [setDuration]("GI.GES.Objects.TimelineElement#g:method:setDuration"), [setFloat]("GI.GES.Interfaces.MetaContainer#g:method:setFloat"), [setHasInternalSource]("GI.GES.Objects.TrackElement#g:method:setHasInternalSource"), [setInpoint]("GI.GES.Objects.TimelineElement#g:method:setInpoint"), [setInt]("GI.GES.Interfaces.MetaContainer#g:method:setInt"), [setInt64]("GI.GES.Interfaces.MetaContainer#g:method:setInt64"), [setMarkerList]("GI.GES.Interfaces.MetaContainer#g:method:setMarkerList"), [setMaxDuration]("GI.GES.Objects.TimelineElement#g:method:setMaxDuration"), [setMeta]("GI.GES.Interfaces.MetaContainer#g:method:setMeta"), [setName]("GI.GES.Objects.TimelineElement#g:method:setName"), [setParent]("GI.GES.Objects.TimelineElement#g:method:setParent"), [setPriority]("GI.GES.Objects.TimelineElement#g:method:setPriority"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setStart]("GI.GES.Objects.TimelineElement#g:method:setStart"), [setString]("GI.GES.Interfaces.MetaContainer#g:method:setString"), [setTimeTranslationFuncs]("GI.GES.Objects.BaseEffect#g:method:setTimeTranslationFuncs"), [setTimeline]("GI.GES.Objects.TimelineElement#g:method:setTimeline"), [setTrackType]("GI.GES.Objects.TrackElement#g:method:setTrackType"), [setUint]("GI.GES.Interfaces.MetaContainer#g:method:setUint"), [setUint64]("GI.GES.Interfaces.MetaContainer#g:method:setUint64").

#if defined(ENABLE_OVERLOADING)
    ResolveBaseEffectMethod                 ,
#endif

-- ** isTimeEffect #method:isTimeEffect#

#if defined(ENABLE_OVERLOADING)
    BaseEffectIsTimeEffectMethodInfo        ,
#endif
    baseEffectIsTimeEffect                  ,


-- ** registerTimeProperty #method:registerTimeProperty#

#if defined(ENABLE_OVERLOADING)
    BaseEffectRegisterTimePropertyMethodInfo,
#endif
    baseEffectRegisterTimeProperty          ,


-- ** setTimeTranslationFuncs #method:setTimeTranslationFuncs#

#if defined(ENABLE_OVERLOADING)
    BaseEffectSetTimeTranslationFuncsMethodInfo,
#endif
    baseEffectSetTimeTranslationFuncs       ,




    ) where

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

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

import qualified GI.GES.Callbacks as GES.Callbacks
import {-# SOURCE #-} qualified GI.GES.Interfaces.Extractable as GES.Extractable
import {-# SOURCE #-} qualified GI.GES.Interfaces.MetaContainer as GES.MetaContainer
import {-# SOURCE #-} qualified GI.GES.Objects.Operation as GES.Operation
import {-# SOURCE #-} qualified GI.GES.Objects.TimelineElement as GES.TimelineElement
import {-# SOURCE #-} qualified GI.GES.Objects.TrackElement as GES.TrackElement
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "ges_base_effect_get_type"
    c_ges_base_effect_get_type :: IO B.Types.GType

instance B.Types.TypedObject BaseEffect where
    glibType :: IO GType
glibType = IO GType
c_ges_base_effect_get_type

instance B.Types.GObject BaseEffect

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

instance O.HasParentTypes BaseEffect
type instance O.ParentTypes BaseEffect = '[GES.Operation.Operation, GES.TrackElement.TrackElement, GES.TimelineElement.TimelineElement, GObject.Object.Object, GES.Extractable.Extractable, GES.MetaContainer.MetaContainer]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveBaseEffectMethod (t :: Symbol) (o :: *) :: * where
    ResolveBaseEffectMethod "addChildProperty" o = GES.TimelineElement.TimelineElementAddChildPropertyMethodInfo
    ResolveBaseEffectMethod "addChildrenProps" o = GES.TrackElement.TrackElementAddChildrenPropsMethodInfo
    ResolveBaseEffectMethod "addMetasFromString" o = GES.MetaContainer.MetaContainerAddMetasFromStringMethodInfo
    ResolveBaseEffectMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveBaseEffectMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveBaseEffectMethod "checkMetaRegistered" o = GES.MetaContainer.MetaContainerCheckMetaRegisteredMethodInfo
    ResolveBaseEffectMethod "clampControlSource" o = GES.TrackElement.TrackElementClampControlSourceMethodInfo
    ResolveBaseEffectMethod "copy" o = GES.TimelineElement.TimelineElementCopyMethodInfo
    ResolveBaseEffectMethod "edit" o = GES.TrackElement.TrackElementEditMethodInfo
    ResolveBaseEffectMethod "editFull" o = GES.TimelineElement.TimelineElementEditFullMethodInfo
    ResolveBaseEffectMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveBaseEffectMethod "foreach" o = GES.MetaContainer.MetaContainerForeachMethodInfo
    ResolveBaseEffectMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveBaseEffectMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveBaseEffectMethod "hasInternalSource" o = GES.TrackElement.TrackElementHasInternalSourceMethodInfo
    ResolveBaseEffectMethod "isActive" o = GES.TrackElement.TrackElementIsActiveMethodInfo
    ResolveBaseEffectMethod "isCore" o = GES.TrackElement.TrackElementIsCoreMethodInfo
    ResolveBaseEffectMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveBaseEffectMethod "isTimeEffect" o = BaseEffectIsTimeEffectMethodInfo
    ResolveBaseEffectMethod "listChildrenProperties" o = GES.TrackElement.TrackElementListChildrenPropertiesMethodInfo
    ResolveBaseEffectMethod "lookupChild" o = GES.TrackElement.TrackElementLookupChildMethodInfo
    ResolveBaseEffectMethod "metasToString" o = GES.MetaContainer.MetaContainerMetasToStringMethodInfo
    ResolveBaseEffectMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveBaseEffectMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveBaseEffectMethod "paste" o = GES.TimelineElement.TimelineElementPasteMethodInfo
    ResolveBaseEffectMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveBaseEffectMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveBaseEffectMethod "registerMeta" o = GES.MetaContainer.MetaContainerRegisterMetaMethodInfo
    ResolveBaseEffectMethod "registerMetaBoolean" o = GES.MetaContainer.MetaContainerRegisterMetaBooleanMethodInfo
    ResolveBaseEffectMethod "registerMetaDate" o = GES.MetaContainer.MetaContainerRegisterMetaDateMethodInfo
    ResolveBaseEffectMethod "registerMetaDateTime" o = GES.MetaContainer.MetaContainerRegisterMetaDateTimeMethodInfo
    ResolveBaseEffectMethod "registerMetaDouble" o = GES.MetaContainer.MetaContainerRegisterMetaDoubleMethodInfo
    ResolveBaseEffectMethod "registerMetaFloat" o = GES.MetaContainer.MetaContainerRegisterMetaFloatMethodInfo
    ResolveBaseEffectMethod "registerMetaInt" o = GES.MetaContainer.MetaContainerRegisterMetaIntMethodInfo
    ResolveBaseEffectMethod "registerMetaInt64" o = GES.MetaContainer.MetaContainerRegisterMetaInt64MethodInfo
    ResolveBaseEffectMethod "registerMetaString" o = GES.MetaContainer.MetaContainerRegisterMetaStringMethodInfo
    ResolveBaseEffectMethod "registerMetaUint" o = GES.MetaContainer.MetaContainerRegisterMetaUintMethodInfo
    ResolveBaseEffectMethod "registerMetaUint64" o = GES.MetaContainer.MetaContainerRegisterMetaUint64MethodInfo
    ResolveBaseEffectMethod "registerStaticMeta" o = GES.MetaContainer.MetaContainerRegisterStaticMetaMethodInfo
    ResolveBaseEffectMethod "registerTimeProperty" o = BaseEffectRegisterTimePropertyMethodInfo
    ResolveBaseEffectMethod "removeChildProperty" o = GES.TimelineElement.TimelineElementRemoveChildPropertyMethodInfo
    ResolveBaseEffectMethod "removeControlBinding" o = GES.TrackElement.TrackElementRemoveControlBindingMethodInfo
    ResolveBaseEffectMethod "ripple" o = GES.TimelineElement.TimelineElementRippleMethodInfo
    ResolveBaseEffectMethod "rippleEnd" o = GES.TimelineElement.TimelineElementRippleEndMethodInfo
    ResolveBaseEffectMethod "rollEnd" o = GES.TimelineElement.TimelineElementRollEndMethodInfo
    ResolveBaseEffectMethod "rollStart" o = GES.TimelineElement.TimelineElementRollStartMethodInfo
    ResolveBaseEffectMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveBaseEffectMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveBaseEffectMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveBaseEffectMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveBaseEffectMethod "trim" o = GES.TimelineElement.TimelineElementTrimMethodInfo
    ResolveBaseEffectMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveBaseEffectMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveBaseEffectMethod "getAllControlBindings" o = GES.TrackElement.TrackElementGetAllControlBindingsMethodInfo
    ResolveBaseEffectMethod "getAsset" o = GES.Extractable.ExtractableGetAssetMethodInfo
    ResolveBaseEffectMethod "getAutoClampControlSources" o = GES.TrackElement.TrackElementGetAutoClampControlSourcesMethodInfo
    ResolveBaseEffectMethod "getBoolean" o = GES.MetaContainer.MetaContainerGetBooleanMethodInfo
    ResolveBaseEffectMethod "getChildProperty" o = GES.TimelineElement.TimelineElementGetChildPropertyMethodInfo
    ResolveBaseEffectMethod "getChildPropertyByPspec" o = GES.TimelineElement.TimelineElementGetChildPropertyByPspecMethodInfo
    ResolveBaseEffectMethod "getControlBinding" o = GES.TrackElement.TrackElementGetControlBindingMethodInfo
    ResolveBaseEffectMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveBaseEffectMethod "getDate" o = GES.MetaContainer.MetaContainerGetDateMethodInfo
    ResolveBaseEffectMethod "getDateTime" o = GES.MetaContainer.MetaContainerGetDateTimeMethodInfo
    ResolveBaseEffectMethod "getDouble" o = GES.MetaContainer.MetaContainerGetDoubleMethodInfo
    ResolveBaseEffectMethod "getDuration" o = GES.TimelineElement.TimelineElementGetDurationMethodInfo
    ResolveBaseEffectMethod "getElement" o = GES.TrackElement.TrackElementGetElementMethodInfo
    ResolveBaseEffectMethod "getFloat" o = GES.MetaContainer.MetaContainerGetFloatMethodInfo
    ResolveBaseEffectMethod "getGnlobject" o = GES.TrackElement.TrackElementGetGnlobjectMethodInfo
    ResolveBaseEffectMethod "getId" o = GES.Extractable.ExtractableGetIdMethodInfo
    ResolveBaseEffectMethod "getInpoint" o = GES.TimelineElement.TimelineElementGetInpointMethodInfo
    ResolveBaseEffectMethod "getInt" o = GES.MetaContainer.MetaContainerGetIntMethodInfo
    ResolveBaseEffectMethod "getInt64" o = GES.MetaContainer.MetaContainerGetInt64MethodInfo
    ResolveBaseEffectMethod "getLayerPriority" o = GES.TimelineElement.TimelineElementGetLayerPriorityMethodInfo
    ResolveBaseEffectMethod "getMarkerList" o = GES.MetaContainer.MetaContainerGetMarkerListMethodInfo
    ResolveBaseEffectMethod "getMaxDuration" o = GES.TimelineElement.TimelineElementGetMaxDurationMethodInfo
    ResolveBaseEffectMethod "getMeta" o = GES.MetaContainer.MetaContainerGetMetaMethodInfo
    ResolveBaseEffectMethod "getName" o = GES.TimelineElement.TimelineElementGetNameMethodInfo
    ResolveBaseEffectMethod "getNaturalFramerate" o = GES.TimelineElement.TimelineElementGetNaturalFramerateMethodInfo
    ResolveBaseEffectMethod "getNleobject" o = GES.TrackElement.TrackElementGetNleobjectMethodInfo
    ResolveBaseEffectMethod "getParent" o = GES.TimelineElement.TimelineElementGetParentMethodInfo
    ResolveBaseEffectMethod "getPriority" o = GES.TimelineElement.TimelineElementGetPriorityMethodInfo
    ResolveBaseEffectMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveBaseEffectMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveBaseEffectMethod "getStart" o = GES.TimelineElement.TimelineElementGetStartMethodInfo
    ResolveBaseEffectMethod "getString" o = GES.MetaContainer.MetaContainerGetStringMethodInfo
    ResolveBaseEffectMethod "getTimeline" o = GES.TimelineElement.TimelineElementGetTimelineMethodInfo
    ResolveBaseEffectMethod "getToplevelParent" o = GES.TimelineElement.TimelineElementGetToplevelParentMethodInfo
    ResolveBaseEffectMethod "getTrack" o = GES.TrackElement.TrackElementGetTrackMethodInfo
    ResolveBaseEffectMethod "getTrackType" o = GES.TrackElement.TrackElementGetTrackTypeMethodInfo
    ResolveBaseEffectMethod "getTrackTypes" o = GES.TimelineElement.TimelineElementGetTrackTypesMethodInfo
    ResolveBaseEffectMethod "getUint" o = GES.MetaContainer.MetaContainerGetUintMethodInfo
    ResolveBaseEffectMethod "getUint64" o = GES.MetaContainer.MetaContainerGetUint64MethodInfo
    ResolveBaseEffectMethod "setActive" o = GES.TrackElement.TrackElementSetActiveMethodInfo
    ResolveBaseEffectMethod "setAsset" o = GES.Extractable.ExtractableSetAssetMethodInfo
    ResolveBaseEffectMethod "setAutoClampControlSources" o = GES.TrackElement.TrackElementSetAutoClampControlSourcesMethodInfo
    ResolveBaseEffectMethod "setBoolean" o = GES.MetaContainer.MetaContainerSetBooleanMethodInfo
    ResolveBaseEffectMethod "setChildProperty" o = GES.TimelineElement.TimelineElementSetChildPropertyMethodInfo
    ResolveBaseEffectMethod "setChildPropertyByPspec" o = GES.TimelineElement.TimelineElementSetChildPropertyByPspecMethodInfo
    ResolveBaseEffectMethod "setChildPropertyFull" o = GES.TimelineElement.TimelineElementSetChildPropertyFullMethodInfo
    ResolveBaseEffectMethod "setControlSource" o = GES.TrackElement.TrackElementSetControlSourceMethodInfo
    ResolveBaseEffectMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveBaseEffectMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveBaseEffectMethod "setDate" o = GES.MetaContainer.MetaContainerSetDateMethodInfo
    ResolveBaseEffectMethod "setDateTime" o = GES.MetaContainer.MetaContainerSetDateTimeMethodInfo
    ResolveBaseEffectMethod "setDouble" o = GES.MetaContainer.MetaContainerSetDoubleMethodInfo
    ResolveBaseEffectMethod "setDuration" o = GES.TimelineElement.TimelineElementSetDurationMethodInfo
    ResolveBaseEffectMethod "setFloat" o = GES.MetaContainer.MetaContainerSetFloatMethodInfo
    ResolveBaseEffectMethod "setHasInternalSource" o = GES.TrackElement.TrackElementSetHasInternalSourceMethodInfo
    ResolveBaseEffectMethod "setInpoint" o = GES.TimelineElement.TimelineElementSetInpointMethodInfo
    ResolveBaseEffectMethod "setInt" o = GES.MetaContainer.MetaContainerSetIntMethodInfo
    ResolveBaseEffectMethod "setInt64" o = GES.MetaContainer.MetaContainerSetInt64MethodInfo
    ResolveBaseEffectMethod "setMarkerList" o = GES.MetaContainer.MetaContainerSetMarkerListMethodInfo
    ResolveBaseEffectMethod "setMaxDuration" o = GES.TimelineElement.TimelineElementSetMaxDurationMethodInfo
    ResolveBaseEffectMethod "setMeta" o = GES.MetaContainer.MetaContainerSetMetaMethodInfo
    ResolveBaseEffectMethod "setName" o = GES.TimelineElement.TimelineElementSetNameMethodInfo
    ResolveBaseEffectMethod "setParent" o = GES.TimelineElement.TimelineElementSetParentMethodInfo
    ResolveBaseEffectMethod "setPriority" o = GES.TimelineElement.TimelineElementSetPriorityMethodInfo
    ResolveBaseEffectMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveBaseEffectMethod "setStart" o = GES.TimelineElement.TimelineElementSetStartMethodInfo
    ResolveBaseEffectMethod "setString" o = GES.MetaContainer.MetaContainerSetStringMethodInfo
    ResolveBaseEffectMethod "setTimeTranslationFuncs" o = BaseEffectSetTimeTranslationFuncsMethodInfo
    ResolveBaseEffectMethod "setTimeline" o = GES.TimelineElement.TimelineElementSetTimelineMethodInfo
    ResolveBaseEffectMethod "setTrackType" o = GES.TrackElement.TrackElementSetTrackTypeMethodInfo
    ResolveBaseEffectMethod "setUint" o = GES.MetaContainer.MetaContainerSetUintMethodInfo
    ResolveBaseEffectMethod "setUint64" o = GES.MetaContainer.MetaContainerSetUint64MethodInfo
    ResolveBaseEffectMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList BaseEffect
type instance O.AttributeList BaseEffect = BaseEffectAttributeList
type BaseEffectAttributeList = ('[ '("active", GES.TrackElement.TrackElementActivePropertyInfo), '("autoClampControlSources", GES.TrackElement.TrackElementAutoClampControlSourcesPropertyInfo), '("duration", GES.TimelineElement.TimelineElementDurationPropertyInfo), '("hasInternalSource", GES.TrackElement.TrackElementHasInternalSourcePropertyInfo), '("inPoint", GES.TimelineElement.TimelineElementInPointPropertyInfo), '("maxDuration", GES.TimelineElement.TimelineElementMaxDurationPropertyInfo), '("name", GES.TimelineElement.TimelineElementNamePropertyInfo), '("parent", GES.TimelineElement.TimelineElementParentPropertyInfo), '("priority", GES.TimelineElement.TimelineElementPriorityPropertyInfo), '("serialize", GES.TimelineElement.TimelineElementSerializePropertyInfo), '("start", GES.TimelineElement.TimelineElementStartPropertyInfo), '("timeline", GES.TimelineElement.TimelineElementTimelinePropertyInfo), '("track", GES.TrackElement.TrackElementTrackPropertyInfo), '("trackType", GES.TrackElement.TrackElementTrackTypePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList BaseEffect = BaseEffectSignalList
type BaseEffectSignalList = ('[ '("childPropertyAdded", GES.TimelineElement.TimelineElementChildPropertyAddedSignalInfo), '("childPropertyRemoved", GES.TimelineElement.TimelineElementChildPropertyRemovedSignalInfo), '("controlBindingAdded", GES.TrackElement.TrackElementControlBindingAddedSignalInfo), '("controlBindingRemoved", GES.TrackElement.TrackElementControlBindingRemovedSignalInfo), '("deepNotify", GES.TimelineElement.TimelineElementDeepNotifySignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("notifyMeta", GES.MetaContainer.MetaContainerNotifyMetaSignalInfo)] :: [(Symbol, *)])

#endif

-- method BaseEffect::is_time_effect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "effect"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "BaseEffect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESBaseEffect" , 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 "ges_base_effect_is_time_effect" ges_base_effect_is_time_effect :: 
    Ptr BaseEffect ->                       -- effect : TInterface (Name {namespace = "GES", name = "BaseEffect"})
    IO CInt

-- | Get whether the effect is considered a time effect or not. An effect
-- with registered time properties or set translation functions is
-- considered a time effect.
-- 
-- /Since: 1.18/
baseEffectIsTimeEffect ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseEffect a) =>
    a
    -- ^ /@effect@/: A t'GI.GES.Objects.BaseEffect.BaseEffect'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@effect@/ is considered a time effect.
baseEffectIsTimeEffect :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBaseEffect a) =>
a -> m Bool
baseEffectIsTimeEffect a
effect = 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 BaseEffect
effect' <- a -> IO (Ptr BaseEffect)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
effect
    CInt
result <- Ptr BaseEffect -> IO CInt
ges_base_effect_is_time_effect Ptr BaseEffect
effect'
    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
effect
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BaseEffectIsTimeEffectMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsBaseEffect a) => O.OverloadedMethod BaseEffectIsTimeEffectMethodInfo a signature where
    overloadedMethod = baseEffectIsTimeEffect

instance O.OverloadedMethodInfo BaseEffectIsTimeEffectMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.BaseEffect.baseEffectIsTimeEffect",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.2/docs/GI-GES-Objects-BaseEffect.html#v:baseEffectIsTimeEffect"
        })


#endif

-- method BaseEffect::register_time_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "effect"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "BaseEffect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESBaseEffect" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child_property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The name of the child property to register as\na time property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "ges_base_effect_register_time_property" ges_base_effect_register_time_property :: 
    Ptr BaseEffect ->                       -- effect : TInterface (Name {namespace = "GES", name = "BaseEffect"})
    CString ->                              -- child_property_name : TBasicType TUTF8
    IO CInt

-- | Register a child property of the effect as a property that, when set,
-- can change the timing of its input data. The child property should be
-- specified as in 'GI.GES.Objects.TimelineElement.timelineElementLookupChild'.
-- 
-- You should also set the corresponding time translation using
-- 'GI.GES.Objects.BaseEffect.baseEffectSetTimeTranslationFuncs'.
-- 
-- Note that /@effect@/ must not be part of a clip, nor can it have
-- [TrackElement:hasInternalSource]("GI.GES.Objects.TrackElement#g:attr:hasInternalSource") set to 'P.True'.
-- 
-- /Since: 1.18/
baseEffectRegisterTimeProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseEffect a) =>
    a
    -- ^ /@effect@/: A t'GI.GES.Objects.BaseEffect.BaseEffect'
    -> T.Text
    -- ^ /@childPropertyName@/: The name of the child property to register as
    -- a time property
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the child property was found and newly registered.
baseEffectRegisterTimeProperty :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBaseEffect a) =>
a -> Text -> m Bool
baseEffectRegisterTimeProperty a
effect Text
childPropertyName = 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 BaseEffect
effect' <- a -> IO (Ptr BaseEffect)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
effect
    CString
childPropertyName' <- Text -> IO CString
textToCString Text
childPropertyName
    CInt
result <- Ptr BaseEffect -> CString -> IO CInt
ges_base_effect_register_time_property Ptr BaseEffect
effect' CString
childPropertyName'
    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
effect
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
childPropertyName'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

instance O.OverloadedMethodInfo BaseEffectRegisterTimePropertyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.BaseEffect.baseEffectRegisterTimeProperty",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.2/docs/GI-GES-Objects-BaseEffect.html#v:baseEffectRegisterTimeProperty"
        })


#endif

-- method BaseEffect::set_time_translation_funcs
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "effect"
--           , argType =
--               TInterface Name { namespace = "GES" , name = "BaseEffect" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GESBaseEffect" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "source_to_sink_func"
--           , argType =
--               TInterface
--                 Name { namespace = "GES" , name = "BaseEffectTimeTranslationFunc" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The function to use\nfor querying how a time is translated from the source coordinates to\nthe sink coordinates of @effect"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sink_to_source_func"
--           , argType =
--               TInterface
--                 Name { namespace = "GES" , name = "BaseEffectTimeTranslationFunc" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The function to use\nfor querying how a time is translated from the sink coordinates to the\nsource coordinates of @effect"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 3
--           , argDestroy = 4
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Data to pass to both @source_to_sink_func and\n@sink_to_source_func"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destroy"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Method to call to destroy\n@user_data, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "ges_base_effect_set_time_translation_funcs" ges_base_effect_set_time_translation_funcs :: 
    Ptr BaseEffect ->                       -- effect : TInterface (Name {namespace = "GES", name = "BaseEffect"})
    FunPtr GES.Callbacks.C_BaseEffectTimeTranslationFunc -> -- source_to_sink_func : TInterface (Name {namespace = "GES", name = "BaseEffectTimeTranslationFunc"})
    FunPtr GES.Callbacks.C_BaseEffectTimeTranslationFunc -> -- sink_to_source_func : TInterface (Name {namespace = "GES", name = "BaseEffectTimeTranslationFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- destroy : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO CInt

-- | Set the time translation query functions for the time effect. If an
-- effect is a time effect, it will have two sets of coordinates: one
-- at its sink and one at its source. The given functions should be able
-- to translate between these two sets of coordinates. More specifically,
-- /@sourceToSinkFunc@/ should *emulate* how the corresponding t'GI.Gst.Objects.Element.Element'
-- would translate the t'GI.Gst.Structs.Segment.Segment' /@time@/ field, and /@sinkToSourceFunc@/
-- should emulate how the corresponding t'GI.Gst.Objects.Element.Element' would translate the
-- seek query /@start@/ and /@stop@/ values, as used in 'GI.Gst.Objects.Element.elementSeek'. As
-- such, /@sinkToSourceFunc@/ should act as an approximate reverse of
-- /@sourceToSinkFunc@/.
-- 
-- Note, these functions will be passed a table of time properties, as
-- registered in 'GI.GES.Objects.BaseEffect.baseEffectRegisterTimeProperty', and their
-- values. The functions should emulate what the translation *would* be
-- *if* the time properties were set to the given values. They should not
-- use the currently set values.
-- 
-- Note that /@effect@/ must not be part of a clip, nor can it have
-- [TrackElement:hasInternalSource]("GI.GES.Objects.TrackElement#g:attr:hasInternalSource") set to 'P.True'.
-- 
-- /Since: 1.18/
baseEffectSetTimeTranslationFuncs ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseEffect a) =>
    a
    -- ^ /@effect@/: A t'GI.GES.Objects.BaseEffect.BaseEffect'
    -> Maybe (GES.Callbacks.BaseEffectTimeTranslationFunc)
    -- ^ /@sourceToSinkFunc@/: The function to use
    -- for querying how a time is translated from the source coordinates to
    -- the sink coordinates of /@effect@/
    -> Maybe (GES.Callbacks.BaseEffectTimeTranslationFunc)
    -- ^ /@sinkToSourceFunc@/: The function to use
    -- for querying how a time is translated from the sink coordinates to the
    -- source coordinates of /@effect@/
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the translation functions were set.
baseEffectSetTimeTranslationFuncs :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBaseEffect a) =>
a
-> Maybe BaseEffectTimeTranslationFunc
-> Maybe BaseEffectTimeTranslationFunc
-> m Bool
baseEffectSetTimeTranslationFuncs a
effect Maybe BaseEffectTimeTranslationFunc
sourceToSinkFunc Maybe BaseEffectTimeTranslationFunc
sinkToSourceFunc = 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 BaseEffect
effect' <- a -> IO (Ptr BaseEffect)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
effect
    FunPtr C_BaseEffectTimeTranslationFunc
maybeSourceToSinkFunc <- case Maybe BaseEffectTimeTranslationFunc
sourceToSinkFunc of
        Maybe BaseEffectTimeTranslationFunc
Nothing -> FunPtr C_BaseEffectTimeTranslationFunc
-> IO (FunPtr C_BaseEffectTimeTranslationFunc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_BaseEffectTimeTranslationFunc
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just BaseEffectTimeTranslationFunc
jSourceToSinkFunc -> do
            FunPtr C_BaseEffectTimeTranslationFunc
jSourceToSinkFunc' <- C_BaseEffectTimeTranslationFunc
-> IO (FunPtr C_BaseEffectTimeTranslationFunc)
GES.Callbacks.mk_BaseEffectTimeTranslationFunc (Maybe (Ptr (FunPtr C_BaseEffectTimeTranslationFunc))
-> BaseEffectTimeTranslationFunc_WithClosures
-> C_BaseEffectTimeTranslationFunc
GES.Callbacks.wrap_BaseEffectTimeTranslationFunc Maybe (Ptr (FunPtr C_BaseEffectTimeTranslationFunc))
forall a. Maybe a
Nothing (BaseEffectTimeTranslationFunc
-> BaseEffectTimeTranslationFunc_WithClosures
GES.Callbacks.drop_closures_BaseEffectTimeTranslationFunc BaseEffectTimeTranslationFunc
jSourceToSinkFunc))
            FunPtr C_BaseEffectTimeTranslationFunc
-> IO (FunPtr C_BaseEffectTimeTranslationFunc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_BaseEffectTimeTranslationFunc
jSourceToSinkFunc'
    FunPtr C_BaseEffectTimeTranslationFunc
maybeSinkToSourceFunc <- case Maybe BaseEffectTimeTranslationFunc
sinkToSourceFunc of
        Maybe BaseEffectTimeTranslationFunc
Nothing -> FunPtr C_BaseEffectTimeTranslationFunc
-> IO (FunPtr C_BaseEffectTimeTranslationFunc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_BaseEffectTimeTranslationFunc
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just BaseEffectTimeTranslationFunc
jSinkToSourceFunc -> do
            FunPtr C_BaseEffectTimeTranslationFunc
jSinkToSourceFunc' <- C_BaseEffectTimeTranslationFunc
-> IO (FunPtr C_BaseEffectTimeTranslationFunc)
GES.Callbacks.mk_BaseEffectTimeTranslationFunc (Maybe (Ptr (FunPtr C_BaseEffectTimeTranslationFunc))
-> BaseEffectTimeTranslationFunc_WithClosures
-> C_BaseEffectTimeTranslationFunc
GES.Callbacks.wrap_BaseEffectTimeTranslationFunc Maybe (Ptr (FunPtr C_BaseEffectTimeTranslationFunc))
forall a. Maybe a
Nothing (BaseEffectTimeTranslationFunc
-> BaseEffectTimeTranslationFunc_WithClosures
GES.Callbacks.drop_closures_BaseEffectTimeTranslationFunc BaseEffectTimeTranslationFunc
jSinkToSourceFunc))
            FunPtr C_BaseEffectTimeTranslationFunc
-> IO (FunPtr C_BaseEffectTimeTranslationFunc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_BaseEffectTimeTranslationFunc
jSinkToSourceFunc'
    let userData :: Ptr ()
userData = FunPtr C_BaseEffectTimeTranslationFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_BaseEffectTimeTranslationFunc
maybeSinkToSourceFunc
    let destroy :: FunPtr (Ptr a -> IO ())
destroy = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    CInt
result <- Ptr BaseEffect
-> FunPtr C_BaseEffectTimeTranslationFunc
-> FunPtr C_BaseEffectTimeTranslationFunc
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO CInt
ges_base_effect_set_time_translation_funcs Ptr BaseEffect
effect' FunPtr C_BaseEffectTimeTranslationFunc
maybeSourceToSinkFunc FunPtr C_BaseEffectTimeTranslationFunc
maybeSinkToSourceFunc Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
destroy
    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
effect
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BaseEffectSetTimeTranslationFuncsMethodInfo
instance (signature ~ (Maybe (GES.Callbacks.BaseEffectTimeTranslationFunc) -> Maybe (GES.Callbacks.BaseEffectTimeTranslationFunc) -> m Bool), MonadIO m, IsBaseEffect a) => O.OverloadedMethod BaseEffectSetTimeTranslationFuncsMethodInfo a signature where
    overloadedMethod = baseEffectSetTimeTranslationFuncs

instance O.OverloadedMethodInfo BaseEffectSetTimeTranslationFuncsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GES.Objects.BaseEffect.baseEffectSetTimeTranslationFuncs",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.2/docs/GI-GES-Objects-BaseEffect.html#v:baseEffectSetTimeTranslationFuncs"
        })


#endif