{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.GES.Objects.TrackElementAsset
(
TrackElementAsset(..) ,
IsTrackElementAsset ,
toTrackElementAsset ,
#if defined(ENABLE_OVERLOADING)
ResolveTrackElementAssetMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
TrackElementAssetGetNaturalFramerateMethodInfo,
#endif
trackElementAssetGetNaturalFramerate ,
#if defined(ENABLE_OVERLOADING)
TrackElementAssetGetTrackTypeMethodInfo ,
#endif
trackElementAssetGetTrackType ,
#if defined(ENABLE_OVERLOADING)
TrackElementAssetSetTrackTypeMethodInfo ,
#endif
trackElementAssetSetTrackType ,
#if defined(ENABLE_OVERLOADING)
TrackElementAssetTrackTypePropertyInfo ,
#endif
constructTrackElementAssetTrackType ,
getTrackElementAssetTrackType ,
setTrackElementAssetTrackType ,
#if defined(ENABLE_OVERLOADING)
trackElementAssetTrackType ,
#endif
) 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.GES.Flags as GES.Flags
import {-# SOURCE #-} qualified GI.GES.Interfaces.MetaContainer as GES.MetaContainer
import {-# SOURCE #-} qualified GI.GES.Objects.Asset as GES.Asset
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.AsyncInitable as Gio.AsyncInitable
import qualified GI.Gio.Interfaces.Initable as Gio.Initable
newtype TrackElementAsset = TrackElementAsset (SP.ManagedPtr TrackElementAsset)
deriving (TrackElementAsset -> TrackElementAsset -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TrackElementAsset -> TrackElementAsset -> Bool
$c/= :: TrackElementAsset -> TrackElementAsset -> Bool
== :: TrackElementAsset -> TrackElementAsset -> Bool
$c== :: TrackElementAsset -> TrackElementAsset -> Bool
Eq)
instance SP.ManagedPtrNewtype TrackElementAsset where
toManagedPtr :: TrackElementAsset -> ManagedPtr TrackElementAsset
toManagedPtr (TrackElementAsset ManagedPtr TrackElementAsset
p) = ManagedPtr TrackElementAsset
p
foreign import ccall "ges_track_element_asset_get_type"
c_ges_track_element_asset_get_type :: IO B.Types.GType
instance B.Types.TypedObject TrackElementAsset where
glibType :: IO GType
glibType = IO GType
c_ges_track_element_asset_get_type
instance B.Types.GObject TrackElementAsset
class (SP.GObject o, O.IsDescendantOf TrackElementAsset o) => IsTrackElementAsset o
instance (SP.GObject o, O.IsDescendantOf TrackElementAsset o) => IsTrackElementAsset o
instance O.HasParentTypes TrackElementAsset
type instance O.ParentTypes TrackElementAsset = '[GES.Asset.Asset, GObject.Object.Object, GES.MetaContainer.MetaContainer, Gio.AsyncInitable.AsyncInitable, Gio.Initable.Initable]
toTrackElementAsset :: (MIO.MonadIO m, IsTrackElementAsset o) => o -> m TrackElementAsset
toTrackElementAsset :: forall (m :: * -> *) o.
(MonadIO m, IsTrackElementAsset o) =>
o -> m TrackElementAsset
toTrackElementAsset = forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr TrackElementAsset -> TrackElementAsset
TrackElementAsset
instance B.GValue.IsGValue (Maybe TrackElementAsset) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_ges_track_element_asset_get_type
gvalueSet_ :: Ptr GValue -> Maybe TrackElementAsset -> IO ()
gvalueSet_ Ptr GValue
gv Maybe TrackElementAsset
P.Nothing = forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (forall a. Ptr a
FP.nullPtr :: FP.Ptr TrackElementAsset)
gvalueSet_ Ptr GValue
gv (P.Just TrackElementAsset
obj) = forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr TrackElementAsset
obj (forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe TrackElementAsset)
gvalueGet_ Ptr GValue
gv = do
Ptr TrackElementAsset
ptr <- forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr TrackElementAsset)
if Ptr TrackElementAsset
ptr forall a. Eq a => a -> a -> Bool
/= forall a. Ptr a
FP.nullPtr
then forall a. a -> Maybe a
P.Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr TrackElementAsset -> TrackElementAsset
TrackElementAsset Ptr TrackElementAsset
ptr
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveTrackElementAssetMethod (t :: Symbol) (o :: *) :: * where
ResolveTrackElementAssetMethod "addMetasFromString" o = GES.MetaContainer.MetaContainerAddMetasFromStringMethodInfo
ResolveTrackElementAssetMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveTrackElementAssetMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveTrackElementAssetMethod "checkMetaRegistered" o = GES.MetaContainer.MetaContainerCheckMetaRegisteredMethodInfo
ResolveTrackElementAssetMethod "extract" o = GES.Asset.AssetExtractMethodInfo
ResolveTrackElementAssetMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveTrackElementAssetMethod "foreach" o = GES.MetaContainer.MetaContainerForeachMethodInfo
ResolveTrackElementAssetMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveTrackElementAssetMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveTrackElementAssetMethod "init" o = Gio.Initable.InitableInitMethodInfo
ResolveTrackElementAssetMethod "initAsync" o = Gio.AsyncInitable.AsyncInitableInitAsyncMethodInfo
ResolveTrackElementAssetMethod "initFinish" o = Gio.AsyncInitable.AsyncInitableInitFinishMethodInfo
ResolveTrackElementAssetMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveTrackElementAssetMethod "listProxies" o = GES.Asset.AssetListProxiesMethodInfo
ResolveTrackElementAssetMethod "metasToString" o = GES.MetaContainer.MetaContainerMetasToStringMethodInfo
ResolveTrackElementAssetMethod "newFinish" o = Gio.AsyncInitable.AsyncInitableNewFinishMethodInfo
ResolveTrackElementAssetMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveTrackElementAssetMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveTrackElementAssetMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveTrackElementAssetMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveTrackElementAssetMethod "registerMeta" o = GES.MetaContainer.MetaContainerRegisterMetaMethodInfo
ResolveTrackElementAssetMethod "registerMetaBoolean" o = GES.MetaContainer.MetaContainerRegisterMetaBooleanMethodInfo
ResolveTrackElementAssetMethod "registerMetaDate" o = GES.MetaContainer.MetaContainerRegisterMetaDateMethodInfo
ResolveTrackElementAssetMethod "registerMetaDateTime" o = GES.MetaContainer.MetaContainerRegisterMetaDateTimeMethodInfo
ResolveTrackElementAssetMethod "registerMetaDouble" o = GES.MetaContainer.MetaContainerRegisterMetaDoubleMethodInfo
ResolveTrackElementAssetMethod "registerMetaFloat" o = GES.MetaContainer.MetaContainerRegisterMetaFloatMethodInfo
ResolveTrackElementAssetMethod "registerMetaInt" o = GES.MetaContainer.MetaContainerRegisterMetaIntMethodInfo
ResolveTrackElementAssetMethod "registerMetaInt64" o = GES.MetaContainer.MetaContainerRegisterMetaInt64MethodInfo
ResolveTrackElementAssetMethod "registerMetaString" o = GES.MetaContainer.MetaContainerRegisterMetaStringMethodInfo
ResolveTrackElementAssetMethod "registerMetaUint" o = GES.MetaContainer.MetaContainerRegisterMetaUintMethodInfo
ResolveTrackElementAssetMethod "registerMetaUint64" o = GES.MetaContainer.MetaContainerRegisterMetaUint64MethodInfo
ResolveTrackElementAssetMethod "registerStaticMeta" o = GES.MetaContainer.MetaContainerRegisterStaticMetaMethodInfo
ResolveTrackElementAssetMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveTrackElementAssetMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveTrackElementAssetMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveTrackElementAssetMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveTrackElementAssetMethod "unproxy" o = GES.Asset.AssetUnproxyMethodInfo
ResolveTrackElementAssetMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveTrackElementAssetMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveTrackElementAssetMethod "getBoolean" o = GES.MetaContainer.MetaContainerGetBooleanMethodInfo
ResolveTrackElementAssetMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveTrackElementAssetMethod "getDate" o = GES.MetaContainer.MetaContainerGetDateMethodInfo
ResolveTrackElementAssetMethod "getDateTime" o = GES.MetaContainer.MetaContainerGetDateTimeMethodInfo
ResolveTrackElementAssetMethod "getDouble" o = GES.MetaContainer.MetaContainerGetDoubleMethodInfo
ResolveTrackElementAssetMethod "getError" o = GES.Asset.AssetGetErrorMethodInfo
ResolveTrackElementAssetMethod "getExtractableType" o = GES.Asset.AssetGetExtractableTypeMethodInfo
ResolveTrackElementAssetMethod "getFloat" o = GES.MetaContainer.MetaContainerGetFloatMethodInfo
ResolveTrackElementAssetMethod "getId" o = GES.Asset.AssetGetIdMethodInfo
ResolveTrackElementAssetMethod "getInt" o = GES.MetaContainer.MetaContainerGetIntMethodInfo
ResolveTrackElementAssetMethod "getInt64" o = GES.MetaContainer.MetaContainerGetInt64MethodInfo
ResolveTrackElementAssetMethod "getMarkerList" o = GES.MetaContainer.MetaContainerGetMarkerListMethodInfo
ResolveTrackElementAssetMethod "getMeta" o = GES.MetaContainer.MetaContainerGetMetaMethodInfo
ResolveTrackElementAssetMethod "getNaturalFramerate" o = TrackElementAssetGetNaturalFramerateMethodInfo
ResolveTrackElementAssetMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveTrackElementAssetMethod "getProxy" o = GES.Asset.AssetGetProxyMethodInfo
ResolveTrackElementAssetMethod "getProxyTarget" o = GES.Asset.AssetGetProxyTargetMethodInfo
ResolveTrackElementAssetMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveTrackElementAssetMethod "getString" o = GES.MetaContainer.MetaContainerGetStringMethodInfo
ResolveTrackElementAssetMethod "getTrackType" o = TrackElementAssetGetTrackTypeMethodInfo
ResolveTrackElementAssetMethod "getUint" o = GES.MetaContainer.MetaContainerGetUintMethodInfo
ResolveTrackElementAssetMethod "getUint64" o = GES.MetaContainer.MetaContainerGetUint64MethodInfo
ResolveTrackElementAssetMethod "setBoolean" o = GES.MetaContainer.MetaContainerSetBooleanMethodInfo
ResolveTrackElementAssetMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveTrackElementAssetMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveTrackElementAssetMethod "setDate" o = GES.MetaContainer.MetaContainerSetDateMethodInfo
ResolveTrackElementAssetMethod "setDateTime" o = GES.MetaContainer.MetaContainerSetDateTimeMethodInfo
ResolveTrackElementAssetMethod "setDouble" o = GES.MetaContainer.MetaContainerSetDoubleMethodInfo
ResolveTrackElementAssetMethod "setFloat" o = GES.MetaContainer.MetaContainerSetFloatMethodInfo
ResolveTrackElementAssetMethod "setInt" o = GES.MetaContainer.MetaContainerSetIntMethodInfo
ResolveTrackElementAssetMethod "setInt64" o = GES.MetaContainer.MetaContainerSetInt64MethodInfo
ResolveTrackElementAssetMethod "setMarkerList" o = GES.MetaContainer.MetaContainerSetMarkerListMethodInfo
ResolveTrackElementAssetMethod "setMeta" o = GES.MetaContainer.MetaContainerSetMetaMethodInfo
ResolveTrackElementAssetMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveTrackElementAssetMethod "setProxy" o = GES.Asset.AssetSetProxyMethodInfo
ResolveTrackElementAssetMethod "setString" o = GES.MetaContainer.MetaContainerSetStringMethodInfo
ResolveTrackElementAssetMethod "setTrackType" o = TrackElementAssetSetTrackTypeMethodInfo
ResolveTrackElementAssetMethod "setUint" o = GES.MetaContainer.MetaContainerSetUintMethodInfo
ResolveTrackElementAssetMethod "setUint64" o = GES.MetaContainer.MetaContainerSetUint64MethodInfo
ResolveTrackElementAssetMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveTrackElementAssetMethod t TrackElementAsset, O.OverloadedMethod info TrackElementAsset p) => OL.IsLabel t (TrackElementAsset -> 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 ~ ResolveTrackElementAssetMethod t TrackElementAsset, O.OverloadedMethod info TrackElementAsset p, R.HasField t TrackElementAsset p) => R.HasField t TrackElementAsset p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveTrackElementAssetMethod t TrackElementAsset, O.OverloadedMethodInfo info TrackElementAsset) => OL.IsLabel t (O.MethodProxy info TrackElementAsset) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
getTrackElementAssetTrackType :: (MonadIO m, IsTrackElementAsset o) => o -> m [GES.Flags.TrackType]
getTrackElementAssetTrackType :: forall (m :: * -> *) o.
(MonadIO m, IsTrackElementAsset o) =>
o -> m [TrackType]
getTrackElementAssetTrackType o
obj = forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO forall a b. (a -> b) -> a -> b
$ forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj String
"track-type"
setTrackElementAssetTrackType :: (MonadIO m, IsTrackElementAsset o) => o -> [GES.Flags.TrackType] -> m ()
setTrackElementAssetTrackType :: forall (m :: * -> *) o.
(MonadIO m, IsTrackElementAsset o) =>
o -> [TrackType] -> m ()
setTrackElementAssetTrackType o
obj [TrackType]
val = forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO forall a b. (a -> b) -> a -> b
$ do
forall a b.
(IsGFlag b, BoxedFlags b, GObject a) =>
a -> String -> [b] -> IO ()
B.Properties.setObjectPropertyFlags o
obj String
"track-type" [TrackType]
val
constructTrackElementAssetTrackType :: (IsTrackElementAsset o, MIO.MonadIO m) => [GES.Flags.TrackType] -> m (GValueConstruct o)
constructTrackElementAssetTrackType :: forall o (m :: * -> *).
(IsTrackElementAsset o, MonadIO m) =>
[TrackType] -> m (GValueConstruct o)
constructTrackElementAssetTrackType [TrackType]
val = forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO forall a b. (a -> b) -> a -> b
$ forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"track-type" [TrackType]
val
#if defined(ENABLE_OVERLOADING)
data TrackElementAssetTrackTypePropertyInfo
instance AttrInfo TrackElementAssetTrackTypePropertyInfo where
type AttrAllowedOps TrackElementAssetTrackTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint TrackElementAssetTrackTypePropertyInfo = IsTrackElementAsset
type AttrSetTypeConstraint TrackElementAssetTrackTypePropertyInfo = (~) [GES.Flags.TrackType]
type AttrTransferTypeConstraint TrackElementAssetTrackTypePropertyInfo = (~) [GES.Flags.TrackType]
type AttrTransferType TrackElementAssetTrackTypePropertyInfo = [GES.Flags.TrackType]
type AttrGetType TrackElementAssetTrackTypePropertyInfo = [GES.Flags.TrackType]
type AttrLabel TrackElementAssetTrackTypePropertyInfo = "track-type"
type AttrOrigin TrackElementAssetTrackTypePropertyInfo = TrackElementAsset
attrGet = getTrackElementAssetTrackType
attrSet = setTrackElementAssetTrackType
attrTransfer _ v = do
return v
attrConstruct = constructTrackElementAssetTrackType
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GES.Objects.TrackElementAsset.trackType"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.1/docs/GI-GES-Objects-TrackElementAsset.html#g:attr:trackType"
})
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList TrackElementAsset
type instance O.AttributeList TrackElementAsset = TrackElementAssetAttributeList
type TrackElementAssetAttributeList = ('[ '("extractableType", GES.Asset.AssetExtractableTypePropertyInfo), '("id", GES.Asset.AssetIdPropertyInfo), '("proxy", GES.Asset.AssetProxyPropertyInfo), '("proxyTarget", GES.Asset.AssetProxyTargetPropertyInfo), '("trackType", TrackElementAssetTrackTypePropertyInfo)] :: [(Symbol, *)])
#endif
#if defined(ENABLE_OVERLOADING)
trackElementAssetTrackType :: AttrLabelProxy "trackType"
trackElementAssetTrackType = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList TrackElementAsset = TrackElementAssetSignalList
type TrackElementAssetSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo), '("notifyMeta", GES.MetaContainer.MetaContainerNotifyMetaSignalInfo)] :: [(Symbol, *)])
#endif
foreign import ccall "ges_track_element_asset_get_natural_framerate" ges_track_element_asset_get_natural_framerate ::
Ptr TrackElementAsset ->
Ptr Int32 ->
Ptr Int32 ->
IO CInt
trackElementAssetGetNaturalFramerate ::
(B.CallStack.HasCallStack, MonadIO m, IsTrackElementAsset a) =>
a
-> m ((Bool, Int32, Int32))
trackElementAssetGetNaturalFramerate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTrackElementAsset a) =>
a -> m (Bool, Int32, Int32)
trackElementAssetGetNaturalFramerate a
self = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Ptr TrackElementAsset
self' <- forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Ptr Int32
framerateN <- forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
Ptr Int32
framerateD <- forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
CInt
result <- Ptr TrackElementAsset -> Ptr Int32 -> Ptr Int32 -> IO CInt
ges_track_element_asset_get_natural_framerate Ptr TrackElementAsset
self' Ptr Int32
framerateN Ptr Int32
framerateD
let result' :: Bool
result' = (forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
Int32
framerateN' <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
framerateN
Int32
framerateD' <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
framerateD
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
forall a. Ptr a -> IO ()
freeMem Ptr Int32
framerateN
forall a. Ptr a -> IO ()
freeMem Ptr Int32
framerateD
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int32
framerateN', Int32
framerateD')
#if defined(ENABLE_OVERLOADING)
data TrackElementAssetGetNaturalFramerateMethodInfo
instance (signature ~ (m ((Bool, Int32, Int32))), MonadIO m, IsTrackElementAsset a) => O.OverloadedMethod TrackElementAssetGetNaturalFramerateMethodInfo a signature where
overloadedMethod = trackElementAssetGetNaturalFramerate
instance O.OverloadedMethodInfo TrackElementAssetGetNaturalFramerateMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GES.Objects.TrackElementAsset.trackElementAssetGetNaturalFramerate",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.1/docs/GI-GES-Objects-TrackElementAsset.html#v:trackElementAssetGetNaturalFramerate"
})
#endif
foreign import ccall "ges_track_element_asset_get_track_type" ges_track_element_asset_get_track_type ::
Ptr TrackElementAsset ->
IO CUInt
trackElementAssetGetTrackType ::
(B.CallStack.HasCallStack, MonadIO m, IsTrackElementAsset a) =>
a
-> m [GES.Flags.TrackType]
trackElementAssetGetTrackType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTrackElementAsset a) =>
a -> m [TrackType]
trackElementAssetGetTrackType a
asset = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Ptr TrackElementAsset
asset' <- forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
asset
CUInt
result <- Ptr TrackElementAsset -> IO CUInt
ges_track_element_asset_get_track_type Ptr TrackElementAsset
asset'
let result' :: [TrackType]
result' = forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
asset
forall (m :: * -> *) a. Monad m => a -> m a
return [TrackType]
result'
#if defined(ENABLE_OVERLOADING)
data TrackElementAssetGetTrackTypeMethodInfo
instance (signature ~ (m [GES.Flags.TrackType]), MonadIO m, IsTrackElementAsset a) => O.OverloadedMethod TrackElementAssetGetTrackTypeMethodInfo a signature where
overloadedMethod = trackElementAssetGetTrackType
instance O.OverloadedMethodInfo TrackElementAssetGetTrackTypeMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GES.Objects.TrackElementAsset.trackElementAssetGetTrackType",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.1/docs/GI-GES-Objects-TrackElementAsset.html#v:trackElementAssetGetTrackType"
})
#endif
foreign import ccall "ges_track_element_asset_set_track_type" ges_track_element_asset_set_track_type ::
Ptr TrackElementAsset ->
CUInt ->
IO ()
trackElementAssetSetTrackType ::
(B.CallStack.HasCallStack, MonadIO m, IsTrackElementAsset a) =>
a
-> [GES.Flags.TrackType]
-> m ()
trackElementAssetSetTrackType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTrackElementAsset a) =>
a -> [TrackType] -> m ()
trackElementAssetSetTrackType a
asset [TrackType]
type_ = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Ptr TrackElementAsset
asset' <- forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
asset
let type_' :: CUInt
type_' = forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [TrackType]
type_
Ptr TrackElementAsset -> CUInt -> IO ()
ges_track_element_asset_set_track_type Ptr TrackElementAsset
asset' CUInt
type_'
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
asset
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data TrackElementAssetSetTrackTypeMethodInfo
instance (signature ~ ([GES.Flags.TrackType] -> m ()), MonadIO m, IsTrackElementAsset a) => O.OverloadedMethod TrackElementAssetSetTrackTypeMethodInfo a signature where
overloadedMethod = trackElementAssetSetTrackType
instance O.OverloadedMethodInfo TrackElementAssetSetTrackTypeMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GES.Objects.TrackElementAsset.trackElementAssetSetTrackType",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ges-1.0.1/docs/GI-GES-Objects-TrackElementAsset.html#v:trackElementAssetSetTrackType"
})
#endif