{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Extra buffer metadata describing an image region of interest

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

module GI.GstVideo.Structs.VideoRegionOfInterestMeta
    ( 

-- * Exported types
    VideoRegionOfInterestMeta(..)           ,
    newZeroVideoRegionOfInterestMeta        ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addParam]("GI.GstVideo.Structs.VideoRegionOfInterestMeta#g:method:addParam").
-- 
-- ==== Getters
-- [getParam]("GI.GstVideo.Structs.VideoRegionOfInterestMeta#g:method:getParam").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveVideoRegionOfInterestMetaMethod  ,
#endif

-- ** addParam #method:addParam#

#if defined(ENABLE_OVERLOADING)
    VideoRegionOfInterestMetaAddParamMethodInfo,
#endif
    videoRegionOfInterestMetaAddParam       ,


-- ** getInfo #method:getInfo#

    videoRegionOfInterestMetaGetInfo        ,


-- ** getParam #method:getParam#

#if defined(ENABLE_OVERLOADING)
    VideoRegionOfInterestMetaGetParamMethodInfo,
#endif
    videoRegionOfInterestMetaGetParam       ,




 -- * Properties


-- ** h #attr:h#
-- | bounding box height

    getVideoRegionOfInterestMetaH           ,
    setVideoRegionOfInterestMetaH           ,
#if defined(ENABLE_OVERLOADING)
    videoRegionOfInterestMeta_h             ,
#endif


-- ** id #attr:id#
-- | identifier of this particular ROI

    getVideoRegionOfInterestMetaId          ,
    setVideoRegionOfInterestMetaId          ,
#if defined(ENABLE_OVERLOADING)
    videoRegionOfInterestMeta_id            ,
#endif


-- ** meta #attr:meta#
-- | parent t'GI.Gst.Structs.Meta.Meta'

    getVideoRegionOfInterestMetaMeta        ,
#if defined(ENABLE_OVERLOADING)
    videoRegionOfInterestMeta_meta          ,
#endif


-- ** params #attr:params#
-- | list of t'GI.Gst.Structs.Structure.Structure' containing element-specific params for downstream,
--          see 'GI.GstVideo.Structs.VideoRegionOfInterestMeta.videoRegionOfInterestMetaAddParam'. (Since: 1.14)

    clearVideoRegionOfInterestMetaParams    ,
    getVideoRegionOfInterestMetaParams      ,
    setVideoRegionOfInterestMetaParams      ,
#if defined(ENABLE_OVERLOADING)
    videoRegionOfInterestMeta_params        ,
#endif


-- ** parentId #attr:parentId#
-- | identifier of its parent ROI, used f.i. for ROI hierarchisation.

    getVideoRegionOfInterestMetaParentId    ,
    setVideoRegionOfInterestMetaParentId    ,
#if defined(ENABLE_OVERLOADING)
    videoRegionOfInterestMeta_parentId      ,
#endif


-- ** roiType #attr:roiType#
-- | GQuark describing the semantic of the Roi (f.i. a face, a pedestrian)

    getVideoRegionOfInterestMetaRoiType     ,
    setVideoRegionOfInterestMetaRoiType     ,
#if defined(ENABLE_OVERLOADING)
    videoRegionOfInterestMeta_roiType       ,
#endif


-- ** w #attr:w#
-- | bounding box width

    getVideoRegionOfInterestMetaW           ,
    setVideoRegionOfInterestMetaW           ,
#if defined(ENABLE_OVERLOADING)
    videoRegionOfInterestMeta_w             ,
#endif


-- ** x #attr:x#
-- | x component of upper-left corner

    getVideoRegionOfInterestMetaX           ,
    setVideoRegionOfInterestMetaX           ,
#if defined(ENABLE_OVERLOADING)
    videoRegionOfInterestMeta_x             ,
#endif


-- ** y #attr:y#
-- | y component of upper-left corner

    getVideoRegionOfInterestMetaY           ,
    setVideoRegionOfInterestMetaY           ,
#if defined(ENABLE_OVERLOADING)
    videoRegionOfInterestMeta_y             ,
#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.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 qualified GI.Gst.Structs.Meta as Gst.Meta
import qualified GI.Gst.Structs.MetaInfo as Gst.MetaInfo
import qualified GI.Gst.Structs.Structure as Gst.Structure

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

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

instance BoxedPtr VideoRegionOfInterestMeta where
    boxedPtrCopy :: VideoRegionOfInterestMeta -> IO VideoRegionOfInterestMeta
boxedPtrCopy = \VideoRegionOfInterestMeta
p -> VideoRegionOfInterestMeta
-> (Ptr VideoRegionOfInterestMeta -> IO VideoRegionOfInterestMeta)
-> IO VideoRegionOfInterestMeta
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr VideoRegionOfInterestMeta
p (Int
-> Ptr VideoRegionOfInterestMeta
-> IO (Ptr VideoRegionOfInterestMeta)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
56 (Ptr VideoRegionOfInterestMeta
 -> IO (Ptr VideoRegionOfInterestMeta))
-> (Ptr VideoRegionOfInterestMeta -> IO VideoRegionOfInterestMeta)
-> Ptr VideoRegionOfInterestMeta
-> IO VideoRegionOfInterestMeta
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr VideoRegionOfInterestMeta -> VideoRegionOfInterestMeta)
-> Ptr VideoRegionOfInterestMeta -> IO VideoRegionOfInterestMeta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr VideoRegionOfInterestMeta -> VideoRegionOfInterestMeta
VideoRegionOfInterestMeta)
    boxedPtrFree :: VideoRegionOfInterestMeta -> IO ()
boxedPtrFree = \VideoRegionOfInterestMeta
x -> VideoRegionOfInterestMeta
-> (Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr VideoRegionOfInterestMeta
x Ptr VideoRegionOfInterestMeta -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr VideoRegionOfInterestMeta where
    boxedPtrCalloc :: IO (Ptr VideoRegionOfInterestMeta)
boxedPtrCalloc = Int -> IO (Ptr VideoRegionOfInterestMeta)
forall a. Int -> IO (Ptr a)
callocBytes Int
56


-- | Construct a `VideoRegionOfInterestMeta` struct initialized to zero.
newZeroVideoRegionOfInterestMeta :: MonadIO m => m VideoRegionOfInterestMeta
newZeroVideoRegionOfInterestMeta :: forall (m :: * -> *). MonadIO m => m VideoRegionOfInterestMeta
newZeroVideoRegionOfInterestMeta = IO VideoRegionOfInterestMeta -> m VideoRegionOfInterestMeta
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VideoRegionOfInterestMeta -> m VideoRegionOfInterestMeta)
-> IO VideoRegionOfInterestMeta -> m VideoRegionOfInterestMeta
forall a b. (a -> b) -> a -> b
$ IO (Ptr VideoRegionOfInterestMeta)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr VideoRegionOfInterestMeta)
-> (Ptr VideoRegionOfInterestMeta -> IO VideoRegionOfInterestMeta)
-> IO VideoRegionOfInterestMeta
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr VideoRegionOfInterestMeta -> VideoRegionOfInterestMeta)
-> Ptr VideoRegionOfInterestMeta -> IO VideoRegionOfInterestMeta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr VideoRegionOfInterestMeta -> VideoRegionOfInterestMeta
VideoRegionOfInterestMeta

instance tag ~ 'AttrSet => Constructible VideoRegionOfInterestMeta tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr VideoRegionOfInterestMeta -> VideoRegionOfInterestMeta)
-> [AttrOp VideoRegionOfInterestMeta tag]
-> m VideoRegionOfInterestMeta
new ManagedPtr VideoRegionOfInterestMeta -> VideoRegionOfInterestMeta
_ [AttrOp VideoRegionOfInterestMeta tag]
attrs = do
        VideoRegionOfInterestMeta
o <- m VideoRegionOfInterestMeta
forall (m :: * -> *). MonadIO m => m VideoRegionOfInterestMeta
newZeroVideoRegionOfInterestMeta
        VideoRegionOfInterestMeta
-> [AttrOp VideoRegionOfInterestMeta 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set VideoRegionOfInterestMeta
o [AttrOp VideoRegionOfInterestMeta tag]
[AttrOp VideoRegionOfInterestMeta 'AttrSet]
attrs
        VideoRegionOfInterestMeta -> m VideoRegionOfInterestMeta
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VideoRegionOfInterestMeta
o


-- | Get the value of the “@meta@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoRegionOfInterestMeta #meta
-- @
getVideoRegionOfInterestMetaMeta :: MonadIO m => VideoRegionOfInterestMeta -> m Gst.Meta.Meta
getVideoRegionOfInterestMetaMeta :: forall (m :: * -> *).
MonadIO m =>
VideoRegionOfInterestMeta -> m Meta
getVideoRegionOfInterestMetaMeta VideoRegionOfInterestMeta
s = IO Meta -> m Meta
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Meta -> m Meta) -> IO Meta -> m Meta
forall a b. (a -> b) -> a -> b
$ VideoRegionOfInterestMeta
-> (Ptr VideoRegionOfInterestMeta -> IO Meta) -> IO Meta
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoRegionOfInterestMeta
s ((Ptr VideoRegionOfInterestMeta -> IO Meta) -> IO Meta)
-> (Ptr VideoRegionOfInterestMeta -> IO Meta) -> IO Meta
forall a b. (a -> b) -> a -> b
$ \Ptr VideoRegionOfInterestMeta
ptr -> do
    let val :: Ptr Meta
val = Ptr VideoRegionOfInterestMeta
ptr Ptr VideoRegionOfInterestMeta -> Int -> Ptr Meta
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: (Ptr Gst.Meta.Meta)
    Meta
val' <- ((ManagedPtr Meta -> Meta) -> Ptr Meta -> IO Meta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr Meta -> Meta
Gst.Meta.Meta) Ptr Meta
val
    Meta -> IO Meta
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Meta
val'

#if defined(ENABLE_OVERLOADING)
data VideoRegionOfInterestMetaMetaFieldInfo
instance AttrInfo VideoRegionOfInterestMetaMetaFieldInfo where
    type AttrBaseTypeConstraint VideoRegionOfInterestMetaMetaFieldInfo = (~) VideoRegionOfInterestMeta
    type AttrAllowedOps VideoRegionOfInterestMetaMetaFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint VideoRegionOfInterestMetaMetaFieldInfo = (~) (Ptr Gst.Meta.Meta)
    type AttrTransferTypeConstraint VideoRegionOfInterestMetaMetaFieldInfo = (~)(Ptr Gst.Meta.Meta)
    type AttrTransferType VideoRegionOfInterestMetaMetaFieldInfo = (Ptr Gst.Meta.Meta)
    type AttrGetType VideoRegionOfInterestMetaMetaFieldInfo = Gst.Meta.Meta
    type AttrLabel VideoRegionOfInterestMetaMetaFieldInfo = "meta"
    type AttrOrigin VideoRegionOfInterestMetaMetaFieldInfo = VideoRegionOfInterestMeta
    attrGet = getVideoRegionOfInterestMetaMeta
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoRegionOfInterestMeta.meta"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoRegionOfInterestMeta.html#g:attr:meta"
        })

videoRegionOfInterestMeta_meta :: AttrLabelProxy "meta"
videoRegionOfInterestMeta_meta = AttrLabelProxy

#endif


-- | Get the value of the “@roi_type@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoRegionOfInterestMeta #roiType
-- @
getVideoRegionOfInterestMetaRoiType :: MonadIO m => VideoRegionOfInterestMeta -> m Word32
getVideoRegionOfInterestMetaRoiType :: forall (m :: * -> *).
MonadIO m =>
VideoRegionOfInterestMeta -> m Word32
getVideoRegionOfInterestMetaRoiType VideoRegionOfInterestMeta
s = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ VideoRegionOfInterestMeta
-> (Ptr VideoRegionOfInterestMeta -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoRegionOfInterestMeta
s ((Ptr VideoRegionOfInterestMeta -> IO Word32) -> IO Word32)
-> (Ptr VideoRegionOfInterestMeta -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr VideoRegionOfInterestMeta
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoRegionOfInterestMeta
ptr Ptr VideoRegionOfInterestMeta -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO Word32
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

-- | Set the value of the “@roi_type@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoRegionOfInterestMeta [ #roiType 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoRegionOfInterestMetaRoiType :: MonadIO m => VideoRegionOfInterestMeta -> Word32 -> m ()
setVideoRegionOfInterestMetaRoiType :: forall (m :: * -> *).
MonadIO m =>
VideoRegionOfInterestMeta -> Word32 -> m ()
setVideoRegionOfInterestMetaRoiType VideoRegionOfInterestMeta
s Word32
val = 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
$ VideoRegionOfInterestMeta
-> (Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoRegionOfInterestMeta
s ((Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ())
-> (Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoRegionOfInterestMeta
ptr -> do
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoRegionOfInterestMeta
ptr Ptr VideoRegionOfInterestMeta -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (Word32
val :: Word32)

#if defined(ENABLE_OVERLOADING)
data VideoRegionOfInterestMetaRoiTypeFieldInfo
instance AttrInfo VideoRegionOfInterestMetaRoiTypeFieldInfo where
    type AttrBaseTypeConstraint VideoRegionOfInterestMetaRoiTypeFieldInfo = (~) VideoRegionOfInterestMeta
    type AttrAllowedOps VideoRegionOfInterestMetaRoiTypeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoRegionOfInterestMetaRoiTypeFieldInfo = (~) Word32
    type AttrTransferTypeConstraint VideoRegionOfInterestMetaRoiTypeFieldInfo = (~)Word32
    type AttrTransferType VideoRegionOfInterestMetaRoiTypeFieldInfo = Word32
    type AttrGetType VideoRegionOfInterestMetaRoiTypeFieldInfo = Word32
    type AttrLabel VideoRegionOfInterestMetaRoiTypeFieldInfo = "roi_type"
    type AttrOrigin VideoRegionOfInterestMetaRoiTypeFieldInfo = VideoRegionOfInterestMeta
    attrGet = getVideoRegionOfInterestMetaRoiType
    attrSet = setVideoRegionOfInterestMetaRoiType
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoRegionOfInterestMeta.roiType"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoRegionOfInterestMeta.html#g:attr:roiType"
        })

videoRegionOfInterestMeta_roiType :: AttrLabelProxy "roiType"
videoRegionOfInterestMeta_roiType = AttrLabelProxy

#endif


-- | Get the value of the “@id@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoRegionOfInterestMeta #id
-- @
getVideoRegionOfInterestMetaId :: MonadIO m => VideoRegionOfInterestMeta -> m Int32
getVideoRegionOfInterestMetaId :: forall (m :: * -> *).
MonadIO m =>
VideoRegionOfInterestMeta -> m Int32
getVideoRegionOfInterestMetaId VideoRegionOfInterestMeta
s = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ VideoRegionOfInterestMeta
-> (Ptr VideoRegionOfInterestMeta -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoRegionOfInterestMeta
s ((Ptr VideoRegionOfInterestMeta -> IO Int32) -> IO Int32)
-> (Ptr VideoRegionOfInterestMeta -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr VideoRegionOfInterestMeta
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoRegionOfInterestMeta
ptr Ptr VideoRegionOfInterestMeta -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20) :: IO Int32
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

-- | Set the value of the “@id@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoRegionOfInterestMeta [ #id 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoRegionOfInterestMetaId :: MonadIO m => VideoRegionOfInterestMeta -> Int32 -> m ()
setVideoRegionOfInterestMetaId :: forall (m :: * -> *).
MonadIO m =>
VideoRegionOfInterestMeta -> Int32 -> m ()
setVideoRegionOfInterestMetaId VideoRegionOfInterestMeta
s Int32
val = 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
$ VideoRegionOfInterestMeta
-> (Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoRegionOfInterestMeta
s ((Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ())
-> (Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoRegionOfInterestMeta
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoRegionOfInterestMeta
ptr Ptr VideoRegionOfInterestMeta -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data VideoRegionOfInterestMetaIdFieldInfo
instance AttrInfo VideoRegionOfInterestMetaIdFieldInfo where
    type AttrBaseTypeConstraint VideoRegionOfInterestMetaIdFieldInfo = (~) VideoRegionOfInterestMeta
    type AttrAllowedOps VideoRegionOfInterestMetaIdFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoRegionOfInterestMetaIdFieldInfo = (~) Int32
    type AttrTransferTypeConstraint VideoRegionOfInterestMetaIdFieldInfo = (~)Int32
    type AttrTransferType VideoRegionOfInterestMetaIdFieldInfo = Int32
    type AttrGetType VideoRegionOfInterestMetaIdFieldInfo = Int32
    type AttrLabel VideoRegionOfInterestMetaIdFieldInfo = "id"
    type AttrOrigin VideoRegionOfInterestMetaIdFieldInfo = VideoRegionOfInterestMeta
    attrGet = getVideoRegionOfInterestMetaId
    attrSet = setVideoRegionOfInterestMetaId
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoRegionOfInterestMeta.id"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoRegionOfInterestMeta.html#g:attr:id"
        })

videoRegionOfInterestMeta_id :: AttrLabelProxy "id"
videoRegionOfInterestMeta_id = AttrLabelProxy

#endif


-- | Get the value of the “@parent_id@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoRegionOfInterestMeta #parentId
-- @
getVideoRegionOfInterestMetaParentId :: MonadIO m => VideoRegionOfInterestMeta -> m Int32
getVideoRegionOfInterestMetaParentId :: forall (m :: * -> *).
MonadIO m =>
VideoRegionOfInterestMeta -> m Int32
getVideoRegionOfInterestMetaParentId VideoRegionOfInterestMeta
s = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ VideoRegionOfInterestMeta
-> (Ptr VideoRegionOfInterestMeta -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoRegionOfInterestMeta
s ((Ptr VideoRegionOfInterestMeta -> IO Int32) -> IO Int32)
-> (Ptr VideoRegionOfInterestMeta -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr VideoRegionOfInterestMeta
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoRegionOfInterestMeta
ptr Ptr VideoRegionOfInterestMeta -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO Int32
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

-- | Set the value of the “@parent_id@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoRegionOfInterestMeta [ #parentId 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoRegionOfInterestMetaParentId :: MonadIO m => VideoRegionOfInterestMeta -> Int32 -> m ()
setVideoRegionOfInterestMetaParentId :: forall (m :: * -> *).
MonadIO m =>
VideoRegionOfInterestMeta -> Int32 -> m ()
setVideoRegionOfInterestMetaParentId VideoRegionOfInterestMeta
s Int32
val = 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
$ VideoRegionOfInterestMeta
-> (Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoRegionOfInterestMeta
s ((Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ())
-> (Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoRegionOfInterestMeta
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoRegionOfInterestMeta
ptr Ptr VideoRegionOfInterestMeta -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data VideoRegionOfInterestMetaParentIdFieldInfo
instance AttrInfo VideoRegionOfInterestMetaParentIdFieldInfo where
    type AttrBaseTypeConstraint VideoRegionOfInterestMetaParentIdFieldInfo = (~) VideoRegionOfInterestMeta
    type AttrAllowedOps VideoRegionOfInterestMetaParentIdFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoRegionOfInterestMetaParentIdFieldInfo = (~) Int32
    type AttrTransferTypeConstraint VideoRegionOfInterestMetaParentIdFieldInfo = (~)Int32
    type AttrTransferType VideoRegionOfInterestMetaParentIdFieldInfo = Int32
    type AttrGetType VideoRegionOfInterestMetaParentIdFieldInfo = Int32
    type AttrLabel VideoRegionOfInterestMetaParentIdFieldInfo = "parent_id"
    type AttrOrigin VideoRegionOfInterestMetaParentIdFieldInfo = VideoRegionOfInterestMeta
    attrGet = getVideoRegionOfInterestMetaParentId
    attrSet = setVideoRegionOfInterestMetaParentId
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoRegionOfInterestMeta.parentId"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoRegionOfInterestMeta.html#g:attr:parentId"
        })

videoRegionOfInterestMeta_parentId :: AttrLabelProxy "parentId"
videoRegionOfInterestMeta_parentId = AttrLabelProxy

#endif


-- | Get the value of the “@x@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoRegionOfInterestMeta #x
-- @
getVideoRegionOfInterestMetaX :: MonadIO m => VideoRegionOfInterestMeta -> m Word32
getVideoRegionOfInterestMetaX :: forall (m :: * -> *).
MonadIO m =>
VideoRegionOfInterestMeta -> m Word32
getVideoRegionOfInterestMetaX VideoRegionOfInterestMeta
s = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ VideoRegionOfInterestMeta
-> (Ptr VideoRegionOfInterestMeta -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoRegionOfInterestMeta
s ((Ptr VideoRegionOfInterestMeta -> IO Word32) -> IO Word32)
-> (Ptr VideoRegionOfInterestMeta -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr VideoRegionOfInterestMeta
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoRegionOfInterestMeta
ptr Ptr VideoRegionOfInterestMeta -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28) :: IO Word32
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

-- | Set the value of the “@x@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoRegionOfInterestMeta [ #x 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoRegionOfInterestMetaX :: MonadIO m => VideoRegionOfInterestMeta -> Word32 -> m ()
setVideoRegionOfInterestMetaX :: forall (m :: * -> *).
MonadIO m =>
VideoRegionOfInterestMeta -> Word32 -> m ()
setVideoRegionOfInterestMetaX VideoRegionOfInterestMeta
s Word32
val = 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
$ VideoRegionOfInterestMeta
-> (Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoRegionOfInterestMeta
s ((Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ())
-> (Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoRegionOfInterestMeta
ptr -> do
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoRegionOfInterestMeta
ptr Ptr VideoRegionOfInterestMeta -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28) (Word32
val :: Word32)

#if defined(ENABLE_OVERLOADING)
data VideoRegionOfInterestMetaXFieldInfo
instance AttrInfo VideoRegionOfInterestMetaXFieldInfo where
    type AttrBaseTypeConstraint VideoRegionOfInterestMetaXFieldInfo = (~) VideoRegionOfInterestMeta
    type AttrAllowedOps VideoRegionOfInterestMetaXFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoRegionOfInterestMetaXFieldInfo = (~) Word32
    type AttrTransferTypeConstraint VideoRegionOfInterestMetaXFieldInfo = (~)Word32
    type AttrTransferType VideoRegionOfInterestMetaXFieldInfo = Word32
    type AttrGetType VideoRegionOfInterestMetaXFieldInfo = Word32
    type AttrLabel VideoRegionOfInterestMetaXFieldInfo = "x"
    type AttrOrigin VideoRegionOfInterestMetaXFieldInfo = VideoRegionOfInterestMeta
    attrGet = getVideoRegionOfInterestMetaX
    attrSet = setVideoRegionOfInterestMetaX
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoRegionOfInterestMeta.x"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoRegionOfInterestMeta.html#g:attr:x"
        })

videoRegionOfInterestMeta_x :: AttrLabelProxy "x"
videoRegionOfInterestMeta_x = AttrLabelProxy

#endif


-- | Get the value of the “@y@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoRegionOfInterestMeta #y
-- @
getVideoRegionOfInterestMetaY :: MonadIO m => VideoRegionOfInterestMeta -> m Word32
getVideoRegionOfInterestMetaY :: forall (m :: * -> *).
MonadIO m =>
VideoRegionOfInterestMeta -> m Word32
getVideoRegionOfInterestMetaY VideoRegionOfInterestMeta
s = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ VideoRegionOfInterestMeta
-> (Ptr VideoRegionOfInterestMeta -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoRegionOfInterestMeta
s ((Ptr VideoRegionOfInterestMeta -> IO Word32) -> IO Word32)
-> (Ptr VideoRegionOfInterestMeta -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr VideoRegionOfInterestMeta
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoRegionOfInterestMeta
ptr Ptr VideoRegionOfInterestMeta -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) :: IO Word32
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

-- | Set the value of the “@y@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoRegionOfInterestMeta [ #y 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoRegionOfInterestMetaY :: MonadIO m => VideoRegionOfInterestMeta -> Word32 -> m ()
setVideoRegionOfInterestMetaY :: forall (m :: * -> *).
MonadIO m =>
VideoRegionOfInterestMeta -> Word32 -> m ()
setVideoRegionOfInterestMetaY VideoRegionOfInterestMeta
s Word32
val = 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
$ VideoRegionOfInterestMeta
-> (Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoRegionOfInterestMeta
s ((Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ())
-> (Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoRegionOfInterestMeta
ptr -> do
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoRegionOfInterestMeta
ptr Ptr VideoRegionOfInterestMeta -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) (Word32
val :: Word32)

#if defined(ENABLE_OVERLOADING)
data VideoRegionOfInterestMetaYFieldInfo
instance AttrInfo VideoRegionOfInterestMetaYFieldInfo where
    type AttrBaseTypeConstraint VideoRegionOfInterestMetaYFieldInfo = (~) VideoRegionOfInterestMeta
    type AttrAllowedOps VideoRegionOfInterestMetaYFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoRegionOfInterestMetaYFieldInfo = (~) Word32
    type AttrTransferTypeConstraint VideoRegionOfInterestMetaYFieldInfo = (~)Word32
    type AttrTransferType VideoRegionOfInterestMetaYFieldInfo = Word32
    type AttrGetType VideoRegionOfInterestMetaYFieldInfo = Word32
    type AttrLabel VideoRegionOfInterestMetaYFieldInfo = "y"
    type AttrOrigin VideoRegionOfInterestMetaYFieldInfo = VideoRegionOfInterestMeta
    attrGet = getVideoRegionOfInterestMetaY
    attrSet = setVideoRegionOfInterestMetaY
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoRegionOfInterestMeta.y"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoRegionOfInterestMeta.html#g:attr:y"
        })

videoRegionOfInterestMeta_y :: AttrLabelProxy "y"
videoRegionOfInterestMeta_y = AttrLabelProxy

#endif


-- | Get the value of the “@w@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoRegionOfInterestMeta #w
-- @
getVideoRegionOfInterestMetaW :: MonadIO m => VideoRegionOfInterestMeta -> m Word32
getVideoRegionOfInterestMetaW :: forall (m :: * -> *).
MonadIO m =>
VideoRegionOfInterestMeta -> m Word32
getVideoRegionOfInterestMetaW VideoRegionOfInterestMeta
s = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ VideoRegionOfInterestMeta
-> (Ptr VideoRegionOfInterestMeta -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoRegionOfInterestMeta
s ((Ptr VideoRegionOfInterestMeta -> IO Word32) -> IO Word32)
-> (Ptr VideoRegionOfInterestMeta -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr VideoRegionOfInterestMeta
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoRegionOfInterestMeta
ptr Ptr VideoRegionOfInterestMeta -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36) :: IO Word32
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

-- | Set the value of the “@w@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoRegionOfInterestMeta [ #w 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoRegionOfInterestMetaW :: MonadIO m => VideoRegionOfInterestMeta -> Word32 -> m ()
setVideoRegionOfInterestMetaW :: forall (m :: * -> *).
MonadIO m =>
VideoRegionOfInterestMeta -> Word32 -> m ()
setVideoRegionOfInterestMetaW VideoRegionOfInterestMeta
s Word32
val = 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
$ VideoRegionOfInterestMeta
-> (Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoRegionOfInterestMeta
s ((Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ())
-> (Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoRegionOfInterestMeta
ptr -> do
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoRegionOfInterestMeta
ptr Ptr VideoRegionOfInterestMeta -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36) (Word32
val :: Word32)

#if defined(ENABLE_OVERLOADING)
data VideoRegionOfInterestMetaWFieldInfo
instance AttrInfo VideoRegionOfInterestMetaWFieldInfo where
    type AttrBaseTypeConstraint VideoRegionOfInterestMetaWFieldInfo = (~) VideoRegionOfInterestMeta
    type AttrAllowedOps VideoRegionOfInterestMetaWFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoRegionOfInterestMetaWFieldInfo = (~) Word32
    type AttrTransferTypeConstraint VideoRegionOfInterestMetaWFieldInfo = (~)Word32
    type AttrTransferType VideoRegionOfInterestMetaWFieldInfo = Word32
    type AttrGetType VideoRegionOfInterestMetaWFieldInfo = Word32
    type AttrLabel VideoRegionOfInterestMetaWFieldInfo = "w"
    type AttrOrigin VideoRegionOfInterestMetaWFieldInfo = VideoRegionOfInterestMeta
    attrGet = getVideoRegionOfInterestMetaW
    attrSet = setVideoRegionOfInterestMetaW
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoRegionOfInterestMeta.w"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoRegionOfInterestMeta.html#g:attr:w"
        })

videoRegionOfInterestMeta_w :: AttrLabelProxy "w"
videoRegionOfInterestMeta_w = AttrLabelProxy

#endif


-- | Get the value of the “@h@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoRegionOfInterestMeta #h
-- @
getVideoRegionOfInterestMetaH :: MonadIO m => VideoRegionOfInterestMeta -> m Word32
getVideoRegionOfInterestMetaH :: forall (m :: * -> *).
MonadIO m =>
VideoRegionOfInterestMeta -> m Word32
getVideoRegionOfInterestMetaH VideoRegionOfInterestMeta
s = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ VideoRegionOfInterestMeta
-> (Ptr VideoRegionOfInterestMeta -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoRegionOfInterestMeta
s ((Ptr VideoRegionOfInterestMeta -> IO Word32) -> IO Word32)
-> (Ptr VideoRegionOfInterestMeta -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr VideoRegionOfInterestMeta
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoRegionOfInterestMeta
ptr Ptr VideoRegionOfInterestMeta -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) :: IO Word32
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

-- | Set the value of the “@h@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoRegionOfInterestMeta [ #h 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoRegionOfInterestMetaH :: MonadIO m => VideoRegionOfInterestMeta -> Word32 -> m ()
setVideoRegionOfInterestMetaH :: forall (m :: * -> *).
MonadIO m =>
VideoRegionOfInterestMeta -> Word32 -> m ()
setVideoRegionOfInterestMetaH VideoRegionOfInterestMeta
s Word32
val = 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
$ VideoRegionOfInterestMeta
-> (Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoRegionOfInterestMeta
s ((Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ())
-> (Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoRegionOfInterestMeta
ptr -> do
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoRegionOfInterestMeta
ptr Ptr VideoRegionOfInterestMeta -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) (Word32
val :: Word32)

#if defined(ENABLE_OVERLOADING)
data VideoRegionOfInterestMetaHFieldInfo
instance AttrInfo VideoRegionOfInterestMetaHFieldInfo where
    type AttrBaseTypeConstraint VideoRegionOfInterestMetaHFieldInfo = (~) VideoRegionOfInterestMeta
    type AttrAllowedOps VideoRegionOfInterestMetaHFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoRegionOfInterestMetaHFieldInfo = (~) Word32
    type AttrTransferTypeConstraint VideoRegionOfInterestMetaHFieldInfo = (~)Word32
    type AttrTransferType VideoRegionOfInterestMetaHFieldInfo = Word32
    type AttrGetType VideoRegionOfInterestMetaHFieldInfo = Word32
    type AttrLabel VideoRegionOfInterestMetaHFieldInfo = "h"
    type AttrOrigin VideoRegionOfInterestMetaHFieldInfo = VideoRegionOfInterestMeta
    attrGet = getVideoRegionOfInterestMetaH
    attrSet = setVideoRegionOfInterestMetaH
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoRegionOfInterestMeta.h"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoRegionOfInterestMeta.html#g:attr:h"
        })

videoRegionOfInterestMeta_h :: AttrLabelProxy "h"
videoRegionOfInterestMeta_h = AttrLabelProxy

#endif


-- | Get the value of the “@params@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoRegionOfInterestMeta #params
-- @
getVideoRegionOfInterestMetaParams :: MonadIO m => VideoRegionOfInterestMeta -> m ([Ptr ()])
getVideoRegionOfInterestMetaParams :: forall (m :: * -> *).
MonadIO m =>
VideoRegionOfInterestMeta -> m [Ptr ()]
getVideoRegionOfInterestMetaParams VideoRegionOfInterestMeta
s = IO [Ptr ()] -> m [Ptr ()]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Ptr ()] -> m [Ptr ()]) -> IO [Ptr ()] -> m [Ptr ()]
forall a b. (a -> b) -> a -> b
$ VideoRegionOfInterestMeta
-> (Ptr VideoRegionOfInterestMeta -> IO [Ptr ()]) -> IO [Ptr ()]
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoRegionOfInterestMeta
s ((Ptr VideoRegionOfInterestMeta -> IO [Ptr ()]) -> IO [Ptr ()])
-> (Ptr VideoRegionOfInterestMeta -> IO [Ptr ()]) -> IO [Ptr ()]
forall a b. (a -> b) -> a -> b
$ \Ptr VideoRegionOfInterestMeta
ptr -> do
    Ptr (GList (Ptr ()))
val <- Ptr (Ptr (GList (Ptr ()))) -> IO (Ptr (GList (Ptr ())))
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoRegionOfInterestMeta
ptr Ptr VideoRegionOfInterestMeta -> Int -> Ptr (Ptr (GList (Ptr ())))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48) :: IO (Ptr (GList (Ptr ())))
    [Ptr ()]
val' <- Ptr (GList (Ptr ())) -> IO [Ptr ()]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr ()))
val
    [Ptr ()] -> IO [Ptr ()]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Ptr ()]
val'

-- | Set the value of the “@params@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoRegionOfInterestMeta [ #params 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoRegionOfInterestMetaParams :: MonadIO m => VideoRegionOfInterestMeta -> Ptr (GList (Ptr ())) -> m ()
setVideoRegionOfInterestMetaParams :: forall (m :: * -> *).
MonadIO m =>
VideoRegionOfInterestMeta -> Ptr (GList (Ptr ())) -> m ()
setVideoRegionOfInterestMetaParams VideoRegionOfInterestMeta
s Ptr (GList (Ptr ()))
val = 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
$ VideoRegionOfInterestMeta
-> (Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoRegionOfInterestMeta
s ((Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ())
-> (Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoRegionOfInterestMeta
ptr -> do
    Ptr (Ptr (GList (Ptr ()))) -> Ptr (GList (Ptr ())) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoRegionOfInterestMeta
ptr Ptr VideoRegionOfInterestMeta -> Int -> Ptr (Ptr (GList (Ptr ())))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48) (Ptr (GList (Ptr ()))
val :: Ptr (GList (Ptr ())))

-- | Set the value of the “@params@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #params
-- @
clearVideoRegionOfInterestMetaParams :: MonadIO m => VideoRegionOfInterestMeta -> m ()
clearVideoRegionOfInterestMetaParams :: forall (m :: * -> *).
MonadIO m =>
VideoRegionOfInterestMeta -> m ()
clearVideoRegionOfInterestMetaParams VideoRegionOfInterestMeta
s = 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
$ VideoRegionOfInterestMeta
-> (Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoRegionOfInterestMeta
s ((Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ())
-> (Ptr VideoRegionOfInterestMeta -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoRegionOfInterestMeta
ptr -> do
    Ptr (Ptr (GList (Ptr ()))) -> Ptr (GList (Ptr ())) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoRegionOfInterestMeta
ptr Ptr VideoRegionOfInterestMeta -> Int -> Ptr (Ptr (GList (Ptr ())))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48) (Ptr (GList (Ptr ()))
forall a. Ptr a
FP.nullPtr :: Ptr (GList (Ptr ())))

#if defined(ENABLE_OVERLOADING)
data VideoRegionOfInterestMetaParamsFieldInfo
instance AttrInfo VideoRegionOfInterestMetaParamsFieldInfo where
    type AttrBaseTypeConstraint VideoRegionOfInterestMetaParamsFieldInfo = (~) VideoRegionOfInterestMeta
    type AttrAllowedOps VideoRegionOfInterestMetaParamsFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint VideoRegionOfInterestMetaParamsFieldInfo = (~) (Ptr (GList (Ptr ())))
    type AttrTransferTypeConstraint VideoRegionOfInterestMetaParamsFieldInfo = (~)(Ptr (GList (Ptr ())))
    type AttrTransferType VideoRegionOfInterestMetaParamsFieldInfo = (Ptr (GList (Ptr ())))
    type AttrGetType VideoRegionOfInterestMetaParamsFieldInfo = [Ptr ()]
    type AttrLabel VideoRegionOfInterestMetaParamsFieldInfo = "params"
    type AttrOrigin VideoRegionOfInterestMetaParamsFieldInfo = VideoRegionOfInterestMeta
    attrGet = getVideoRegionOfInterestMetaParams
    attrSet = setVideoRegionOfInterestMetaParams
    attrConstruct = undefined
    attrClear = clearVideoRegionOfInterestMetaParams
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoRegionOfInterestMeta.params"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoRegionOfInterestMeta.html#g:attr:params"
        })

videoRegionOfInterestMeta_params :: AttrLabelProxy "params"
videoRegionOfInterestMeta_params = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList VideoRegionOfInterestMeta
type instance O.AttributeList VideoRegionOfInterestMeta = VideoRegionOfInterestMetaAttributeList
type VideoRegionOfInterestMetaAttributeList = ('[ '("meta", VideoRegionOfInterestMetaMetaFieldInfo), '("roiType", VideoRegionOfInterestMetaRoiTypeFieldInfo), '("id", VideoRegionOfInterestMetaIdFieldInfo), '("parentId", VideoRegionOfInterestMetaParentIdFieldInfo), '("x", VideoRegionOfInterestMetaXFieldInfo), '("y", VideoRegionOfInterestMetaYFieldInfo), '("w", VideoRegionOfInterestMetaWFieldInfo), '("h", VideoRegionOfInterestMetaHFieldInfo), '("params", VideoRegionOfInterestMetaParamsFieldInfo)] :: [(Symbol, DK.Type)])
#endif

-- method VideoRegionOfInterestMeta::add_param
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "meta"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "GstVideo" , name = "VideoRegionOfInterestMeta" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoRegionOfInterestMeta"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "s"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_region_of_interest_meta_add_param" gst_video_region_of_interest_meta_add_param :: 
    Ptr VideoRegionOfInterestMeta ->        -- meta : TInterface (Name {namespace = "GstVideo", name = "VideoRegionOfInterestMeta"})
    Ptr Gst.Structure.Structure ->          -- s : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO ()

-- | Attach element-specific parameters to /@meta@/ meant to be used by downstream
-- elements which may handle this ROI.
-- The name of /@s@/ is used to identify the element these parameters are meant for.
-- 
-- This is typically used to tell encoders how they should encode this specific region.
-- For example, a structure named \"roi\/x264enc\" could be used to give the
-- QP offsets this encoder should use when encoding the region described in /@meta@/.
-- Multiple parameters can be defined for the same meta so different encoders
-- can be supported by cross platform applications).
-- 
-- /Since: 1.14/
videoRegionOfInterestMetaAddParam ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoRegionOfInterestMeta
    -- ^ /@meta@/: a t'GI.GstVideo.Structs.VideoRegionOfInterestMeta.VideoRegionOfInterestMeta'
    -> Gst.Structure.Structure
    -- ^ /@s@/: a t'GI.Gst.Structs.Structure.Structure'
    -> m ()
videoRegionOfInterestMetaAddParam :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoRegionOfInterestMeta -> Structure -> m ()
videoRegionOfInterestMetaAddParam VideoRegionOfInterestMeta
meta Structure
s = 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 VideoRegionOfInterestMeta
meta' <- VideoRegionOfInterestMeta -> IO (Ptr VideoRegionOfInterestMeta)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoRegionOfInterestMeta
meta
    Ptr Structure
s' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Structure
s
    Ptr VideoRegionOfInterestMeta -> Ptr Structure -> IO ()
gst_video_region_of_interest_meta_add_param Ptr VideoRegionOfInterestMeta
meta' Ptr Structure
s'
    VideoRegionOfInterestMeta -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoRegionOfInterestMeta
meta
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
s
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoRegionOfInterestMetaAddParamMethodInfo
instance (signature ~ (Gst.Structure.Structure -> m ()), MonadIO m) => O.OverloadedMethod VideoRegionOfInterestMetaAddParamMethodInfo VideoRegionOfInterestMeta signature where
    overloadedMethod = videoRegionOfInterestMetaAddParam

instance O.OverloadedMethodInfo VideoRegionOfInterestMetaAddParamMethodInfo VideoRegionOfInterestMeta where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoRegionOfInterestMeta.videoRegionOfInterestMetaAddParam",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoRegionOfInterestMeta.html#v:videoRegionOfInterestMetaAddParam"
        })


#endif

-- method VideoRegionOfInterestMeta::get_param
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "meta"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "GstVideo" , name = "VideoRegionOfInterestMeta" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoRegionOfInterestMeta"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a name." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Structure" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_region_of_interest_meta_get_param" gst_video_region_of_interest_meta_get_param :: 
    Ptr VideoRegionOfInterestMeta ->        -- meta : TInterface (Name {namespace = "GstVideo", name = "VideoRegionOfInterestMeta"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr Gst.Structure.Structure)

-- | Retrieve the parameter for /@meta@/ having /@name@/ as structure name,
-- or 'P.Nothing' if there is none.
-- 
-- /Since: 1.14/
videoRegionOfInterestMetaGetParam ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoRegionOfInterestMeta
    -- ^ /@meta@/: a t'GI.GstVideo.Structs.VideoRegionOfInterestMeta.VideoRegionOfInterestMeta'
    -> T.Text
    -- ^ /@name@/: a name.
    -> m (Maybe Gst.Structure.Structure)
    -- ^ __Returns:__ a t'GI.Gst.Structs.Structure.Structure'
videoRegionOfInterestMetaGetParam :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoRegionOfInterestMeta -> Text -> m (Maybe Structure)
videoRegionOfInterestMetaGetParam VideoRegionOfInterestMeta
meta Text
name = IO (Maybe Structure) -> m (Maybe Structure)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Structure) -> m (Maybe Structure))
-> IO (Maybe Structure) -> m (Maybe Structure)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoRegionOfInterestMeta
meta' <- VideoRegionOfInterestMeta -> IO (Ptr VideoRegionOfInterestMeta)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoRegionOfInterestMeta
meta
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Structure
result <- Ptr VideoRegionOfInterestMeta -> CString -> IO (Ptr Structure)
gst_video_region_of_interest_meta_get_param Ptr VideoRegionOfInterestMeta
meta' CString
name'
    Maybe Structure
maybeResult <- Ptr Structure
-> (Ptr Structure -> IO Structure) -> IO (Maybe Structure)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Structure
result ((Ptr Structure -> IO Structure) -> IO (Maybe Structure))
-> (Ptr Structure -> IO Structure) -> IO (Maybe Structure)
forall a b. (a -> b) -> a -> b
$ \Ptr Structure
result' -> do
        Structure
result'' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Structure -> Structure
Gst.Structure.Structure) Ptr Structure
result'
        Structure -> IO Structure
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
result''
    VideoRegionOfInterestMeta -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoRegionOfInterestMeta
meta
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Maybe Structure -> IO (Maybe Structure)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Structure
maybeResult

#if defined(ENABLE_OVERLOADING)
data VideoRegionOfInterestMetaGetParamMethodInfo
instance (signature ~ (T.Text -> m (Maybe Gst.Structure.Structure)), MonadIO m) => O.OverloadedMethod VideoRegionOfInterestMetaGetParamMethodInfo VideoRegionOfInterestMeta signature where
    overloadedMethod = videoRegionOfInterestMetaGetParam

instance O.OverloadedMethodInfo VideoRegionOfInterestMetaGetParamMethodInfo VideoRegionOfInterestMeta where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoRegionOfInterestMeta.videoRegionOfInterestMetaGetParam",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoRegionOfInterestMeta.html#v:videoRegionOfInterestMetaGetParam"
        })


#endif

-- method VideoRegionOfInterestMeta::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_region_of_interest_meta_get_info" gst_video_region_of_interest_meta_get_info :: 
    IO (Ptr Gst.MetaInfo.MetaInfo)

-- | /No description available in the introspection data./
videoRegionOfInterestMetaGetInfo ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Gst.MetaInfo.MetaInfo
videoRegionOfInterestMetaGetInfo :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m MetaInfo
videoRegionOfInterestMetaGetInfo  = IO MetaInfo -> m MetaInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MetaInfo -> m MetaInfo) -> IO MetaInfo -> m MetaInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaInfo
result <- IO (Ptr MetaInfo)
gst_video_region_of_interest_meta_get_info
    Text -> Ptr MetaInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"videoRegionOfInterestMetaGetInfo" Ptr MetaInfo
result
    MetaInfo
result' <- ((ManagedPtr MetaInfo -> MetaInfo) -> Ptr MetaInfo -> IO MetaInfo
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr MetaInfo -> MetaInfo
Gst.MetaInfo.MetaInfo) Ptr MetaInfo
result
    MetaInfo -> IO MetaInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MetaInfo
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveVideoRegionOfInterestMetaMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveVideoRegionOfInterestMetaMethod "addParam" o = VideoRegionOfInterestMetaAddParamMethodInfo
    ResolveVideoRegionOfInterestMetaMethod "getParam" o = VideoRegionOfInterestMetaGetParamMethodInfo
    ResolveVideoRegionOfInterestMetaMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif