{- | Copyright : Will Thompson, Iñaki García Etxebarria and Jonas Platte License : LGPL-2.1 Maintainer : Iñaki García Etxebarria (inaki@blueleaf.cc) Extra buffer metadata providing Closed Caption. /Since: 1.16/ -} #define ENABLE_OVERLOADING (MIN_VERSION_haskell_gi_overloading(1,0,0) \ && !defined(__HADDOCK_VERSION__)) module GI.GstVideo.Structs.VideoCaptionMeta ( -- * Exported types VideoCaptionMeta(..) , newZeroVideoCaptionMeta , noVideoCaptionMeta , -- * Methods -- ** getInfo #method:getInfo# videoCaptionMetaGetInfo , -- * Properties -- ** captionType #attr:captionType# {- | The type of Closed Caption contained in the meta. -} getVideoCaptionMetaCaptionType , setVideoCaptionMetaCaptionType , #if ENABLE_OVERLOADING videoCaptionMeta_captionType , #endif -- ** meta #attr:meta# {- | parent 'GI.Gst.Structs.Meta.Meta' -} getVideoCaptionMetaMeta , #if ENABLE_OVERLOADING videoCaptionMeta_meta , #endif -- ** size #attr:size# {- | The size in bytes of /@data@/ -} getVideoCaptionMetaSize , setVideoCaptionMetaSize , #if ENABLE_OVERLOADING videoCaptionMeta_size , #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.ManagedPtr as B.ManagedPtr import qualified Data.GI.Base.GClosure as B.GClosure import qualified Data.GI.Base.GError as B.GError 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.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 GI.Gst.Structs.Meta as Gst.Meta import qualified GI.Gst.Structs.MetaInfo as Gst.MetaInfo import {-# SOURCE #-} qualified GI.GstVideo.Enums as GstVideo.Enums -- | Memory-managed wrapper type. newtype VideoCaptionMeta = VideoCaptionMeta (ManagedPtr VideoCaptionMeta) instance WrappedPtr VideoCaptionMeta where wrappedPtrCalloc = callocBytes 40 wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 40 >=> wrapPtr VideoCaptionMeta) wrappedPtrFree = Just ptr_to_g_free -- | Construct a `VideoCaptionMeta` struct initialized to zero. newZeroVideoCaptionMeta :: MonadIO m => m VideoCaptionMeta newZeroVideoCaptionMeta = liftIO $ wrappedPtrCalloc >>= wrapPtr VideoCaptionMeta instance tag ~ 'AttrSet => Constructible VideoCaptionMeta tag where new _ attrs = do o <- newZeroVideoCaptionMeta GI.Attributes.set o attrs return o -- | A convenience alias for `Nothing` :: `Maybe` `VideoCaptionMeta`. noVideoCaptionMeta :: Maybe VideoCaptionMeta noVideoCaptionMeta = Nothing {- | Get the value of the “@meta@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' videoCaptionMeta #meta @ -} getVideoCaptionMetaMeta :: MonadIO m => VideoCaptionMeta -> m Gst.Meta.Meta getVideoCaptionMetaMeta s = liftIO $ withManagedPtr s $ \ptr -> do let val = ptr `plusPtr` 0 :: (Ptr Gst.Meta.Meta) val' <- (newPtr Gst.Meta.Meta) val return val' #if ENABLE_OVERLOADING data VideoCaptionMetaMetaFieldInfo instance AttrInfo VideoCaptionMetaMetaFieldInfo where type AttrAllowedOps VideoCaptionMetaMetaFieldInfo = '[ 'AttrGet] type AttrSetTypeConstraint VideoCaptionMetaMetaFieldInfo = (~) (Ptr Gst.Meta.Meta) type AttrBaseTypeConstraint VideoCaptionMetaMetaFieldInfo = (~) VideoCaptionMeta type AttrGetType VideoCaptionMetaMetaFieldInfo = Gst.Meta.Meta type AttrLabel VideoCaptionMetaMetaFieldInfo = "meta" type AttrOrigin VideoCaptionMetaMetaFieldInfo = VideoCaptionMeta attrGet _ = getVideoCaptionMetaMeta attrSet _ = undefined attrConstruct = undefined attrClear _ = undefined videoCaptionMeta_meta :: AttrLabelProxy "meta" videoCaptionMeta_meta = AttrLabelProxy #endif {- | Get the value of the “@caption_type@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' videoCaptionMeta #captionType @ -} getVideoCaptionMetaCaptionType :: MonadIO m => VideoCaptionMeta -> m GstVideo.Enums.VideoCaptionType getVideoCaptionMetaCaptionType s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO CUInt let val' = (toEnum . fromIntegral) val return val' {- | Set the value of the “@caption_type@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' videoCaptionMeta [ #captionType 'Data.GI.Base.Attributes.:=' value ] @ -} setVideoCaptionMetaCaptionType :: MonadIO m => VideoCaptionMeta -> GstVideo.Enums.VideoCaptionType -> m () setVideoCaptionMetaCaptionType s val = liftIO $ withManagedPtr s $ \ptr -> do let val' = (fromIntegral . fromEnum) val poke (ptr `plusPtr` 16) (val' :: CUInt) #if ENABLE_OVERLOADING data VideoCaptionMetaCaptionTypeFieldInfo instance AttrInfo VideoCaptionMetaCaptionTypeFieldInfo where type AttrAllowedOps VideoCaptionMetaCaptionTypeFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint VideoCaptionMetaCaptionTypeFieldInfo = (~) GstVideo.Enums.VideoCaptionType type AttrBaseTypeConstraint VideoCaptionMetaCaptionTypeFieldInfo = (~) VideoCaptionMeta type AttrGetType VideoCaptionMetaCaptionTypeFieldInfo = GstVideo.Enums.VideoCaptionType type AttrLabel VideoCaptionMetaCaptionTypeFieldInfo = "caption_type" type AttrOrigin VideoCaptionMetaCaptionTypeFieldInfo = VideoCaptionMeta attrGet _ = getVideoCaptionMetaCaptionType attrSet _ = setVideoCaptionMetaCaptionType attrConstruct = undefined attrClear _ = undefined videoCaptionMeta_captionType :: AttrLabelProxy "captionType" videoCaptionMeta_captionType = AttrLabelProxy #endif -- XXX Skipped attribute for "VideoCaptionMeta:data" :: Not implemented: "Don't know how to unpack C array of type TCArray False (-1) 3 (TBasicType TUInt8)" {- | Get the value of the “@size@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' videoCaptionMeta #size @ -} getVideoCaptionMetaSize :: MonadIO m => VideoCaptionMeta -> m Word64 getVideoCaptionMetaSize s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 32) :: IO Word64 return val {- | Set the value of the “@size@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' videoCaptionMeta [ #size 'Data.GI.Base.Attributes.:=' value ] @ -} setVideoCaptionMetaSize :: MonadIO m => VideoCaptionMeta -> Word64 -> m () setVideoCaptionMetaSize s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 32) (val :: Word64) #if ENABLE_OVERLOADING data VideoCaptionMetaSizeFieldInfo instance AttrInfo VideoCaptionMetaSizeFieldInfo where type AttrAllowedOps VideoCaptionMetaSizeFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint VideoCaptionMetaSizeFieldInfo = (~) Word64 type AttrBaseTypeConstraint VideoCaptionMetaSizeFieldInfo = (~) VideoCaptionMeta type AttrGetType VideoCaptionMetaSizeFieldInfo = Word64 type AttrLabel VideoCaptionMetaSizeFieldInfo = "size" type AttrOrigin VideoCaptionMetaSizeFieldInfo = VideoCaptionMeta attrGet _ = getVideoCaptionMetaSize attrSet _ = setVideoCaptionMetaSize attrConstruct = undefined attrClear _ = undefined videoCaptionMeta_size :: AttrLabelProxy "size" videoCaptionMeta_size = AttrLabelProxy #endif #if ENABLE_OVERLOADING instance O.HasAttributeList VideoCaptionMeta type instance O.AttributeList VideoCaptionMeta = VideoCaptionMetaAttributeList type VideoCaptionMetaAttributeList = ('[ '("meta", VideoCaptionMetaMetaFieldInfo), '("captionType", VideoCaptionMetaCaptionTypeFieldInfo), '("size", VideoCaptionMetaSizeFieldInfo)] :: [(Symbol, *)]) #endif -- method VideoCaptionMeta::get_info -- method type : MemberFunction -- Args : [] -- Lengths : [] -- returnType : Just (TInterface (Name {namespace = "Gst", name = "MetaInfo"})) -- throws : False -- Skip return : False foreign import ccall "gst_video_caption_meta_get_info" gst_video_caption_meta_get_info :: IO (Ptr Gst.MetaInfo.MetaInfo) {- | /No description available in the introspection data./ -} videoCaptionMetaGetInfo :: (B.CallStack.HasCallStack, MonadIO m) => m Gst.MetaInfo.MetaInfo videoCaptionMetaGetInfo = liftIO $ do result <- gst_video_caption_meta_get_info checkUnexpectedReturnNULL "videoCaptionMetaGetInfo" result result' <- (newPtr Gst.MetaInfo.MetaInfo) result return result' #if ENABLE_OVERLOADING #endif #if ENABLE_OVERLOADING type family ResolveVideoCaptionMetaMethod (t :: Symbol) (o :: *) :: * where ResolveVideoCaptionMetaMethod l o = O.MethodResolutionFailed l o instance (info ~ ResolveVideoCaptionMetaMethod t VideoCaptionMeta, O.MethodInfo info VideoCaptionMeta p) => OL.IsLabel t (VideoCaptionMeta -> p) where #if MIN_VERSION_base(4,10,0) fromLabel = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info) #else fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info) #endif #endif