{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.GES.Objects.AudioTestSource
(
AudioTestSource(..) ,
IsAudioTestSource ,
toAudioTestSource ,
#if defined(ENABLE_OVERLOADING)
ResolveAudioTestSourceMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
AudioTestSourceGetFreqMethodInfo ,
#endif
audioTestSourceGetFreq ,
#if defined(ENABLE_OVERLOADING)
AudioTestSourceGetVolumeMethodInfo ,
#endif
audioTestSourceGetVolume ,
#if defined(ENABLE_OVERLOADING)
AudioTestSourceSetFreqMethodInfo ,
#endif
audioTestSourceSetFreq ,
#if defined(ENABLE_OVERLOADING)
AudioTestSourceSetVolumeMethodInfo ,
#endif
audioTestSourceSetVolume ,
) 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.Kind as DK
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.GES.Interfaces.Extractable as GES.Extractable
import {-# SOURCE #-} qualified GI.GES.Interfaces.MetaContainer as GES.MetaContainer
import {-# SOURCE #-} qualified GI.GES.Objects.AudioSource as GES.AudioSource
import {-# SOURCE #-} qualified GI.GES.Objects.Source as GES.Source
import {-# SOURCE #-} qualified GI.GES.Objects.TimelineElement as GES.TimelineElement
import {-# SOURCE #-} qualified GI.GES.Objects.TrackElement as GES.TrackElement
import qualified GI.GObject.Objects.Object as GObject.Object
newtype AudioTestSource = AudioTestSource (SP.ManagedPtr AudioTestSource)
deriving (AudioTestSource -> AudioTestSource -> Bool
(AudioTestSource -> AudioTestSource -> Bool)
-> (AudioTestSource -> AudioTestSource -> Bool)
-> Eq AudioTestSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AudioTestSource -> AudioTestSource -> Bool
== :: AudioTestSource -> AudioTestSource -> Bool
$c/= :: AudioTestSource -> AudioTestSource -> Bool
/= :: AudioTestSource -> AudioTestSource -> Bool
Eq)
instance SP.ManagedPtrNewtype AudioTestSource where
toManagedPtr :: AudioTestSource -> ManagedPtr AudioTestSource
toManagedPtr (AudioTestSource ManagedPtr AudioTestSource
p) = ManagedPtr AudioTestSource
p
foreign import ccall "ges_audio_test_source_get_type"
c_ges_audio_test_source_get_type :: IO B.Types.GType
instance B.Types.TypedObject AudioTestSource where
glibType :: IO GType
glibType = IO GType
c_ges_audio_test_source_get_type
instance B.Types.GObject AudioTestSource
class (SP.GObject o, O.IsDescendantOf AudioTestSource o) => IsAudioTestSource o
instance (SP.GObject o, O.IsDescendantOf AudioTestSource o) => IsAudioTestSource o
instance O.HasParentTypes AudioTestSource
type instance O.ParentTypes AudioTestSource = '[GES.AudioSource.AudioSource, GES.Source.Source, GES.TrackElement.TrackElement, GES.TimelineElement.TimelineElement, GObject.Object.Object, GES.Extractable.Extractable, GES.MetaContainer.MetaContainer]
toAudioTestSource :: (MIO.MonadIO m, IsAudioTestSource o) => o -> m AudioTestSource
toAudioTestSource :: forall (m :: * -> *) o.
(MonadIO m, IsAudioTestSource o) =>
o -> m AudioTestSource
toAudioTestSource = IO AudioTestSource -> m AudioTestSource
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO AudioTestSource -> m AudioTestSource)
-> (o -> IO AudioTestSource) -> o -> m AudioTestSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr AudioTestSource -> AudioTestSource)
-> o -> IO AudioTestSource
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr AudioTestSource -> AudioTestSource
AudioTestSource
instance B.GValue.IsGValue (Maybe AudioTestSource) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_ges_audio_test_source_get_type
gvalueSet_ :: Ptr GValue -> Maybe AudioTestSource -> IO ()
gvalueSet_ Ptr GValue
gv Maybe AudioTestSource
P.Nothing = Ptr GValue -> Ptr AudioTestSource -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr AudioTestSource
forall a. Ptr a
FP.nullPtr :: FP.Ptr AudioTestSource)
gvalueSet_ Ptr GValue
gv (P.Just AudioTestSource
obj) = AudioTestSource -> (Ptr AudioTestSource -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr AudioTestSource
obj (Ptr GValue -> Ptr AudioTestSource -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe AudioTestSource)
gvalueGet_ Ptr GValue
gv = do
Ptr AudioTestSource
ptr <- Ptr GValue -> IO (Ptr AudioTestSource)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr AudioTestSource)
if Ptr AudioTestSource
ptr Ptr AudioTestSource -> Ptr AudioTestSource -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr AudioTestSource
forall a. Ptr a
FP.nullPtr
then AudioTestSource -> Maybe AudioTestSource
forall a. a -> Maybe a
P.Just (AudioTestSource -> Maybe AudioTestSource)
-> IO AudioTestSource -> IO (Maybe AudioTestSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr AudioTestSource -> AudioTestSource)
-> Ptr AudioTestSource -> IO AudioTestSource
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr AudioTestSource -> AudioTestSource
AudioTestSource Ptr AudioTestSource
ptr
else Maybe AudioTestSource -> IO (Maybe AudioTestSource)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AudioTestSource
forall a. Maybe a
P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveAudioTestSourceMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveAudioTestSourceMethod "addChildProperty" o = GES.TimelineElement.TimelineElementAddChildPropertyMethodInfo
ResolveAudioTestSourceMethod "addChildrenProps" o = GES.TrackElement.TrackElementAddChildrenPropsMethodInfo
ResolveAudioTestSourceMethod "addMetasFromString" o = GES.MetaContainer.MetaContainerAddMetasFromStringMethodInfo
ResolveAudioTestSourceMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveAudioTestSourceMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveAudioTestSourceMethod "checkMetaRegistered" o = GES.MetaContainer.MetaContainerCheckMetaRegisteredMethodInfo
ResolveAudioTestSourceMethod "clampControlSource" o = GES.TrackElement.TrackElementClampControlSourceMethodInfo
ResolveAudioTestSourceMethod "copy" o = GES.TimelineElement.TimelineElementCopyMethodInfo
ResolveAudioTestSourceMethod "edit" o = GES.TrackElement.TrackElementEditMethodInfo
ResolveAudioTestSourceMethod "editFull" o = GES.TimelineElement.TimelineElementEditFullMethodInfo
ResolveAudioTestSourceMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveAudioTestSourceMethod "foreach" o = GES.MetaContainer.MetaContainerForeachMethodInfo
ResolveAudioTestSourceMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveAudioTestSourceMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveAudioTestSourceMethod "hasInternalSource" o = GES.TrackElement.TrackElementHasInternalSourceMethodInfo
ResolveAudioTestSourceMethod "isActive" o = GES.TrackElement.TrackElementIsActiveMethodInfo
ResolveAudioTestSourceMethod "isCore" o = GES.TrackElement.TrackElementIsCoreMethodInfo
ResolveAudioTestSourceMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveAudioTestSourceMethod "listChildrenProperties" o = GES.TrackElement.TrackElementListChildrenPropertiesMethodInfo
ResolveAudioTestSourceMethod "lookupChild" o = GES.TrackElement.TrackElementLookupChildMethodInfo
ResolveAudioTestSourceMethod "metasToString" o = GES.MetaContainer.MetaContainerMetasToStringMethodInfo
ResolveAudioTestSourceMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveAudioTestSourceMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveAudioTestSourceMethod "paste" o = GES.TimelineElement.TimelineElementPasteMethodInfo
ResolveAudioTestSourceMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveAudioTestSourceMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveAudioTestSourceMethod "registerMeta" o = GES.MetaContainer.MetaContainerRegisterMetaMethodInfo
ResolveAudioTestSourceMethod "registerMetaBoolean" o = GES.MetaContainer.MetaContainerRegisterMetaBooleanMethodInfo
ResolveAudioTestSourceMethod "registerMetaDate" o = GES.MetaContainer.MetaContainerRegisterMetaDateMethodInfo
ResolveAudioTestSourceMethod "registerMetaDateTime" o = GES.MetaContainer.MetaContainerRegisterMetaDateTimeMethodInfo
ResolveAudioTestSourceMethod "registerMetaDouble" o = GES.MetaContainer.MetaContainerRegisterMetaDoubleMethodInfo
ResolveAudioTestSourceMethod "registerMetaFloat" o = GES.MetaContainer.MetaContainerRegisterMetaFloatMethodInfo
ResolveAudioTestSourceMethod "registerMetaInt" o = GES.MetaContainer.MetaContainerRegisterMetaIntMethodInfo
ResolveAudioTestSourceMethod "registerMetaInt64" o = GES.MetaContainer.MetaContainerRegisterMetaInt64MethodInfo
ResolveAudioTestSourceMethod "registerMetaString" o = GES.MetaContainer.MetaContainerRegisterMetaStringMethodInfo
ResolveAudioTestSourceMethod "registerMetaUint" o = GES.MetaContainer.MetaContainerRegisterMetaUintMethodInfo
ResolveAudioTestSourceMethod "registerMetaUint64" o = GES.MetaContainer.MetaContainerRegisterMetaUint64MethodInfo
ResolveAudioTestSourceMethod "registerStaticMeta" o = GES.MetaContainer.MetaContainerRegisterStaticMetaMethodInfo
ResolveAudioTestSourceMethod "removeChildProperty" o = GES.TimelineElement.TimelineElementRemoveChildPropertyMethodInfo
ResolveAudioTestSourceMethod "removeControlBinding" o = GES.TrackElement.TrackElementRemoveControlBindingMethodInfo
ResolveAudioTestSourceMethod "ripple" o = GES.TimelineElement.TimelineElementRippleMethodInfo
ResolveAudioTestSourceMethod "rippleEnd" o = GES.TimelineElement.TimelineElementRippleEndMethodInfo
ResolveAudioTestSourceMethod "rollEnd" o = GES.TimelineElement.TimelineElementRollEndMethodInfo
ResolveAudioTestSourceMethod "rollStart" o = GES.TimelineElement.TimelineElementRollStartMethodInfo
ResolveAudioTestSourceMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveAudioTestSourceMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveAudioTestSourceMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveAudioTestSourceMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveAudioTestSourceMethod "trim" o = GES.TimelineElement.TimelineElementTrimMethodInfo
ResolveAudioTestSourceMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveAudioTestSourceMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveAudioTestSourceMethod "getAllControlBindings" o = GES.TrackElement.TrackElementGetAllControlBindingsMethodInfo
ResolveAudioTestSourceMethod "getAsset" o = GES.Extractable.ExtractableGetAssetMethodInfo
ResolveAudioTestSourceMethod "getAutoClampControlSources" o = GES.TrackElement.TrackElementGetAutoClampControlSourcesMethodInfo
ResolveAudioTestSourceMethod "getBoolean" o = GES.MetaContainer.MetaContainerGetBooleanMethodInfo
ResolveAudioTestSourceMethod "getChildProperty" o = GES.TimelineElement.TimelineElementGetChildPropertyMethodInfo
ResolveAudioTestSourceMethod "getChildPropertyByPspec" o = GES.TimelineElement.TimelineElementGetChildPropertyByPspecMethodInfo
ResolveAudioTestSourceMethod "getControlBinding" o = GES.TrackElement.TrackElementGetControlBindingMethodInfo
ResolveAudioTestSourceMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveAudioTestSourceMethod "getDate" o = GES.MetaContainer.MetaContainerGetDateMethodInfo
ResolveAudioTestSourceMethod "getDateTime" o = GES.MetaContainer.MetaContainerGetDateTimeMethodInfo
ResolveAudioTestSourceMethod "getDouble" o = GES.MetaContainer.MetaContainerGetDoubleMethodInfo
ResolveAudioTestSourceMethod "getDuration" o = GES.TimelineElement.TimelineElementGetDurationMethodInfo
ResolveAudioTestSourceMethod "getElement" o = GES.TrackElement.TrackElementGetElementMethodInfo
ResolveAudioTestSourceMethod "getFloat" o = GES.MetaContainer.MetaContainerGetFloatMethodInfo
ResolveAudioTestSourceMethod "getFreq" o = AudioTestSourceGetFreqMethodInfo
ResolveAudioTestSourceMethod "getGnlobject" o = GES.TrackElement.TrackElementGetGnlobjectMethodInfo
ResolveAudioTestSourceMethod "getId" o = GES.Extractable.ExtractableGetIdMethodInfo
ResolveAudioTestSourceMethod "getInpoint" o = GES.TimelineElement.TimelineElementGetInpointMethodInfo
ResolveAudioTestSourceMethod "getInt" o = GES.MetaContainer.MetaContainerGetIntMethodInfo
ResolveAudioTestSourceMethod "getInt64" o = GES.MetaContainer.MetaContainerGetInt64MethodInfo
ResolveAudioTestSourceMethod "getLayerPriority" o = GES.TimelineElement.TimelineElementGetLayerPriorityMethodInfo
ResolveAudioTestSourceMethod "getMarkerList" o = GES.MetaContainer.MetaContainerGetMarkerListMethodInfo
ResolveAudioTestSourceMethod "getMaxDuration" o = GES.TimelineElement.TimelineElementGetMaxDurationMethodInfo
ResolveAudioTestSourceMethod "getMeta" o = GES.MetaContainer.MetaContainerGetMetaMethodInfo
ResolveAudioTestSourceMethod "getName" o = GES.TimelineElement.TimelineElementGetNameMethodInfo
ResolveAudioTestSourceMethod "getNaturalFramerate" o = GES.TimelineElement.TimelineElementGetNaturalFramerateMethodInfo
ResolveAudioTestSourceMethod "getNleobject" o = GES.TrackElement.TrackElementGetNleobjectMethodInfo
ResolveAudioTestSourceMethod "getParent" o = GES.TimelineElement.TimelineElementGetParentMethodInfo
ResolveAudioTestSourceMethod "getPriority" o = GES.TimelineElement.TimelineElementGetPriorityMethodInfo
ResolveAudioTestSourceMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveAudioTestSourceMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveAudioTestSourceMethod "getStart" o = GES.TimelineElement.TimelineElementGetStartMethodInfo
ResolveAudioTestSourceMethod "getString" o = GES.MetaContainer.MetaContainerGetStringMethodInfo
ResolveAudioTestSourceMethod "getTimeline" o = GES.TimelineElement.TimelineElementGetTimelineMethodInfo
ResolveAudioTestSourceMethod "getToplevelParent" o = GES.TimelineElement.TimelineElementGetToplevelParentMethodInfo
ResolveAudioTestSourceMethod "getTrack" o = GES.TrackElement.TrackElementGetTrackMethodInfo
ResolveAudioTestSourceMethod "getTrackType" o = GES.TrackElement.TrackElementGetTrackTypeMethodInfo
ResolveAudioTestSourceMethod "getTrackTypes" o = GES.TimelineElement.TimelineElementGetTrackTypesMethodInfo
ResolveAudioTestSourceMethod "getUint" o = GES.MetaContainer.MetaContainerGetUintMethodInfo
ResolveAudioTestSourceMethod "getUint64" o = GES.MetaContainer.MetaContainerGetUint64MethodInfo
ResolveAudioTestSourceMethod "getVolume" o = AudioTestSourceGetVolumeMethodInfo
ResolveAudioTestSourceMethod "setActive" o = GES.TrackElement.TrackElementSetActiveMethodInfo
ResolveAudioTestSourceMethod "setAsset" o = GES.Extractable.ExtractableSetAssetMethodInfo
ResolveAudioTestSourceMethod "setAutoClampControlSources" o = GES.TrackElement.TrackElementSetAutoClampControlSourcesMethodInfo
ResolveAudioTestSourceMethod "setBoolean" o = GES.MetaContainer.MetaContainerSetBooleanMethodInfo
ResolveAudioTestSourceMethod "setChildProperty" o = GES.TimelineElement.TimelineElementSetChildPropertyMethodInfo
ResolveAudioTestSourceMethod "setChildPropertyByPspec" o = GES.TimelineElement.TimelineElementSetChildPropertyByPspecMethodInfo
ResolveAudioTestSourceMethod "setChildPropertyFull" o = GES.TimelineElement.TimelineElementSetChildPropertyFullMethodInfo
ResolveAudioTestSourceMethod "setControlSource" o = GES.TrackElement.TrackElementSetControlSourceMethodInfo
ResolveAudioTestSourceMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveAudioTestSourceMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveAudioTestSourceMethod "setDate" o = GES.MetaContainer.MetaContainerSetDateMethodInfo
ResolveAudioTestSourceMethod "setDateTime" o = GES.MetaContainer.MetaContainerSetDateTimeMethodInfo
ResolveAudioTestSourceMethod "setDouble" o = GES.MetaContainer.MetaContainerSetDoubleMethodInfo
ResolveAudioTestSourceMethod "setDuration" o = GES.TimelineElement.TimelineElementSetDurationMethodInfo
ResolveAudioTestSourceMethod "setFloat" o = GES.MetaContainer.MetaContainerSetFloatMethodInfo
ResolveAudioTestSourceMethod "setFreq" o = AudioTestSourceSetFreqMethodInfo
ResolveAudioTestSourceMethod "setHasInternalSource" o = GES.TrackElement.TrackElementSetHasInternalSourceMethodInfo
ResolveAudioTestSourceMethod "setInpoint" o = GES.TimelineElement.TimelineElementSetInpointMethodInfo
ResolveAudioTestSourceMethod "setInt" o = GES.MetaContainer.MetaContainerSetIntMethodInfo
ResolveAudioTestSourceMethod "setInt64" o = GES.MetaContainer.MetaContainerSetInt64MethodInfo
ResolveAudioTestSourceMethod "setMarkerList" o = GES.MetaContainer.MetaContainerSetMarkerListMethodInfo
ResolveAudioTestSourceMethod "setMaxDuration" o = GES.TimelineElement.TimelineElementSetMaxDurationMethodInfo
ResolveAudioTestSourceMethod "setMeta" o = GES.MetaContainer.MetaContainerSetMetaMethodInfo
ResolveAudioTestSourceMethod "setName" o = GES.TimelineElement.TimelineElementSetNameMethodInfo
ResolveAudioTestSourceMethod "setParent" o = GES.TimelineElement.TimelineElementSetParentMethodInfo
ResolveAudioTestSourceMethod "setPriority" o = GES.TimelineElement.TimelineElementSetPriorityMethodInfo
ResolveAudioTestSourceMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveAudioTestSourceMethod "setStart" o = GES.TimelineElement.TimelineElementSetStartMethodInfo
ResolveAudioTestSourceMethod "setString" o = GES.MetaContainer.MetaContainerSetStringMethodInfo
ResolveAudioTestSourceMethod "setTimeline" o = GES.TimelineElement.TimelineElementSetTimelineMethodInfo
ResolveAudioTestSourceMethod "setTrackType" o = GES.TrackElement.TrackElementSetTrackTypeMethodInfo
ResolveAudioTestSourceMethod "setUint" o = GES.MetaContainer.MetaContainerSetUintMethodInfo
ResolveAudioTestSourceMethod "setUint64" o = GES.MetaContainer.MetaContainerSetUint64MethodInfo
ResolveAudioTestSourceMethod "setVolume" o = AudioTestSourceSetVolumeMethodInfo
ResolveAudioTestSourceMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveAudioTestSourceMethod t AudioTestSource, O.OverloadedMethod info AudioTestSource p) => OL.IsLabel t (AudioTestSource -> 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 ~ ResolveAudioTestSourceMethod t AudioTestSource, O.OverloadedMethod info AudioTestSource p, R.HasField t AudioTestSource p) => R.HasField t AudioTestSource p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveAudioTestSourceMethod t AudioTestSource, O.OverloadedMethodInfo info AudioTestSource) => OL.IsLabel t (O.MethodProxy info AudioTestSource) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList AudioTestSource
type instance O.AttributeList AudioTestSource = AudioTestSourceAttributeList
type AudioTestSourceAttributeList = ('[ '("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, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList AudioTestSource = AudioTestSourceSignalList
type AudioTestSourceSignalList = ('[ '("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, DK.Type)])
#endif
foreign import ccall "ges_audio_test_source_get_freq" ges_audio_test_source_get_freq ::
Ptr AudioTestSource ->
IO CDouble
audioTestSourceGetFreq ::
(B.CallStack.HasCallStack, MonadIO m, IsAudioTestSource a) =>
a
-> m Double
audioTestSourceGetFreq :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAudioTestSource a) =>
a -> m Double
audioTestSourceGetFreq a
self = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
Ptr AudioTestSource
self' <- a -> IO (Ptr AudioTestSource)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CDouble
result <- Ptr AudioTestSource -> IO CDouble
ges_audio_test_source_get_freq Ptr AudioTestSource
self'
let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'
#if defined(ENABLE_OVERLOADING)
data AudioTestSourceGetFreqMethodInfo
instance (signature ~ (m Double), MonadIO m, IsAudioTestSource a) => O.OverloadedMethod AudioTestSourceGetFreqMethodInfo a signature where
overloadedMethod = audioTestSourceGetFreq
instance O.OverloadedMethodInfo AudioTestSourceGetFreqMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GES.Objects.AudioTestSource.audioTestSourceGetFreq",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-AudioTestSource.html#v:audioTestSourceGetFreq"
})
#endif
foreign import ccall "ges_audio_test_source_get_volume" ges_audio_test_source_get_volume ::
Ptr AudioTestSource ->
IO CDouble
audioTestSourceGetVolume ::
(B.CallStack.HasCallStack, MonadIO m, IsAudioTestSource a) =>
a
-> m Double
audioTestSourceGetVolume :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAudioTestSource a) =>
a -> m Double
audioTestSourceGetVolume a
self = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
Ptr AudioTestSource
self' <- a -> IO (Ptr AudioTestSource)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CDouble
result <- Ptr AudioTestSource -> IO CDouble
ges_audio_test_source_get_volume Ptr AudioTestSource
self'
let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'
#if defined(ENABLE_OVERLOADING)
data AudioTestSourceGetVolumeMethodInfo
instance (signature ~ (m Double), MonadIO m, IsAudioTestSource a) => O.OverloadedMethod AudioTestSourceGetVolumeMethodInfo a signature where
overloadedMethod = audioTestSourceGetVolume
instance O.OverloadedMethodInfo AudioTestSourceGetVolumeMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GES.Objects.AudioTestSource.audioTestSourceGetVolume",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-AudioTestSource.html#v:audioTestSourceGetVolume"
})
#endif
foreign import ccall "ges_audio_test_source_set_freq" ges_audio_test_source_set_freq ::
Ptr AudioTestSource ->
CDouble ->
IO ()
audioTestSourceSetFreq ::
(B.CallStack.HasCallStack, MonadIO m, IsAudioTestSource a) =>
a
-> Double
-> m ()
audioTestSourceSetFreq :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAudioTestSource a) =>
a -> Double -> m ()
audioTestSourceSetFreq a
self Double
freq = 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 AudioTestSource
self' <- a -> IO (Ptr AudioTestSource)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
let freq' :: CDouble
freq' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
freq
Ptr AudioTestSource -> CDouble -> IO ()
ges_audio_test_source_set_freq Ptr AudioTestSource
self' CDouble
freq'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data AudioTestSourceSetFreqMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsAudioTestSource a) => O.OverloadedMethod AudioTestSourceSetFreqMethodInfo a signature where
overloadedMethod = audioTestSourceSetFreq
instance O.OverloadedMethodInfo AudioTestSourceSetFreqMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GES.Objects.AudioTestSource.audioTestSourceSetFreq",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-AudioTestSource.html#v:audioTestSourceSetFreq"
})
#endif
foreign import ccall "ges_audio_test_source_set_volume" ges_audio_test_source_set_volume ::
Ptr AudioTestSource ->
CDouble ->
IO ()
audioTestSourceSetVolume ::
(B.CallStack.HasCallStack, MonadIO m, IsAudioTestSource a) =>
a
-> Double
-> m ()
audioTestSourceSetVolume :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAudioTestSource a) =>
a -> Double -> m ()
audioTestSourceSetVolume a
self Double
volume = 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 AudioTestSource
self' <- a -> IO (Ptr AudioTestSource)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
let volume' :: CDouble
volume' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
volume
Ptr AudioTestSource -> CDouble -> IO ()
ges_audio_test_source_set_volume Ptr AudioTestSource
self' CDouble
volume'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data AudioTestSourceSetVolumeMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsAudioTestSource a) => O.OverloadedMethod AudioTestSourceSetVolumeMethodInfo a signature where
overloadedMethod = audioTestSourceSetVolume
instance O.OverloadedMethodInfo AudioTestSourceSetVolumeMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GES.Objects.AudioTestSource.audioTestSourceSetVolume",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.4/docs/GI-GES-Objects-AudioTestSource.html#v:audioTestSourceSetVolume"
})
#endif