{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A video frame obtained from 'GI.GstVideo.Functions.videoFrameMap'

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

module GI.GstVideo.Structs.VideoFrame
    ( 

-- * Exported types
    VideoFrame(..)                          ,
    newZeroVideoFrame                       ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveVideoFrameMethod                 ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    VideoFrameCopyMethodInfo                ,
#endif
    videoFrameCopy                          ,


-- ** copyPlane #method:copyPlane#

#if defined(ENABLE_OVERLOADING)
    VideoFrameCopyPlaneMethodInfo           ,
#endif
    videoFrameCopyPlane                     ,


-- ** map #method:map#

    videoFrameMap                           ,


-- ** mapId #method:mapId#

    videoFrameMapId                         ,


-- ** unmap #method:unmap#

#if defined(ENABLE_OVERLOADING)
    VideoFrameUnmapMethodInfo               ,
#endif
    videoFrameUnmap                         ,




 -- * Properties


-- ** buffer #attr:buffer#
-- | the mapped buffer

    clearVideoFrameBuffer                   ,
    getVideoFrameBuffer                     ,
    setVideoFrameBuffer                     ,
#if defined(ENABLE_OVERLOADING)
    videoFrame_buffer                       ,
#endif


-- ** flags #attr:flags#
-- | t'GI.GstVideo.Flags.VideoFrameFlags' for the frame

    getVideoFrameFlags                      ,
    setVideoFrameFlags                      ,
#if defined(ENABLE_OVERLOADING)
    videoFrame_flags                        ,
#endif


-- ** id #attr:id#
-- | id of the mapped frame. the id can for example be used to
--   identify the frame in case of multiview video.

    getVideoFrameId                         ,
    setVideoFrameId                         ,
#if defined(ENABLE_OVERLOADING)
    videoFrame_id                           ,
#endif


-- ** info #attr:info#
-- | the t'GI.GstVideo.Structs.VideoInfo.VideoInfo'

    getVideoFrameInfo                       ,
#if defined(ENABLE_OVERLOADING)
    videoFrame_info                         ,
#endif


-- ** meta #attr:meta#
-- | pointer to metadata if any

    clearVideoFrameMeta                     ,
    getVideoFrameMeta                       ,
    setVideoFrameMeta                       ,
#if defined(ENABLE_OVERLOADING)
    videoFrame_meta                         ,
#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.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.Gst.Flags as Gst.Flags
import qualified GI.Gst.Structs.Buffer as Gst.Buffer
import {-# SOURCE #-} qualified GI.GstVideo.Flags as GstVideo.Flags
import {-# SOURCE #-} qualified GI.GstVideo.Structs.VideoInfo as GstVideo.VideoInfo

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

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

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


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

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


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

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

videoFrame_info :: AttrLabelProxy "info"
videoFrame_info = AttrLabelProxy

#endif


-- | Get the value of the “@flags@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoFrame #flags
-- @
getVideoFrameFlags :: MonadIO m => VideoFrame -> m [GstVideo.Flags.VideoFrameFlags]
getVideoFrameFlags :: forall (m :: * -> *).
MonadIO m =>
VideoFrame -> m [VideoFrameFlags]
getVideoFrameFlags VideoFrame
s = IO [VideoFrameFlags] -> m [VideoFrameFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [VideoFrameFlags] -> m [VideoFrameFlags])
-> IO [VideoFrameFlags] -> m [VideoFrameFlags]
forall a b. (a -> b) -> a -> b
$ VideoFrame
-> (Ptr VideoFrame -> IO [VideoFrameFlags]) -> IO [VideoFrameFlags]
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFrame
s ((Ptr VideoFrame -> IO [VideoFrameFlags]) -> IO [VideoFrameFlags])
-> (Ptr VideoFrame -> IO [VideoFrameFlags]) -> IO [VideoFrameFlags]
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFrame
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoFrame
ptr Ptr VideoFrame -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
120) :: IO CUInt
    let val' :: [VideoFrameFlags]
val' = CUInt -> [VideoFrameFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
val
    [VideoFrameFlags] -> IO [VideoFrameFlags]
forall (m :: * -> *) a. Monad m => a -> m a
return [VideoFrameFlags]
val'

-- | Set the value of the “@flags@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoFrame [ #flags 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoFrameFlags :: MonadIO m => VideoFrame -> [GstVideo.Flags.VideoFrameFlags] -> m ()
setVideoFrameFlags :: forall (m :: * -> *).
MonadIO m =>
VideoFrame -> [VideoFrameFlags] -> m ()
setVideoFrameFlags VideoFrame
s [VideoFrameFlags]
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoFrame -> (Ptr VideoFrame -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFrame
s ((Ptr VideoFrame -> IO ()) -> IO ())
-> (Ptr VideoFrame -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFrame
ptr -> do
    let val' :: CUInt
val' = [VideoFrameFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [VideoFrameFlags]
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoFrame
ptr Ptr VideoFrame -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
120) (CUInt
val' :: CUInt)

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

videoFrame_flags :: AttrLabelProxy "flags"
videoFrame_flags = AttrLabelProxy

#endif


-- | Get the value of the “@buffer@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoFrame #buffer
-- @
getVideoFrameBuffer :: MonadIO m => VideoFrame -> m (Maybe Gst.Buffer.Buffer)
getVideoFrameBuffer :: forall (m :: * -> *). MonadIO m => VideoFrame -> m (Maybe Buffer)
getVideoFrameBuffer VideoFrame
s = IO (Maybe Buffer) -> m (Maybe Buffer)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Buffer) -> m (Maybe Buffer))
-> IO (Maybe Buffer) -> m (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ VideoFrame
-> (Ptr VideoFrame -> IO (Maybe Buffer)) -> IO (Maybe Buffer)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFrame
s ((Ptr VideoFrame -> IO (Maybe Buffer)) -> IO (Maybe Buffer))
-> (Ptr VideoFrame -> IO (Maybe Buffer)) -> IO (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFrame
ptr -> do
    Ptr Buffer
val <- Ptr (Ptr Buffer) -> IO (Ptr Buffer)
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoFrame
ptr Ptr VideoFrame -> Int -> Ptr (Ptr Buffer)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
128) :: IO (Ptr Gst.Buffer.Buffer)
    Maybe Buffer
result <- Ptr Buffer -> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr Buffer
val ((Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer))
-> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ \Ptr Buffer
val' -> do
        Buffer
val'' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Buffer -> Buffer
Gst.Buffer.Buffer) Ptr Buffer
val'
        Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
val''
    Maybe Buffer -> IO (Maybe Buffer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Buffer
result

-- | Set the value of the “@buffer@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoFrame [ #buffer 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoFrameBuffer :: MonadIO m => VideoFrame -> Ptr Gst.Buffer.Buffer -> m ()
setVideoFrameBuffer :: forall (m :: * -> *). MonadIO m => VideoFrame -> Ptr Buffer -> m ()
setVideoFrameBuffer VideoFrame
s Ptr Buffer
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoFrame -> (Ptr VideoFrame -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFrame
s ((Ptr VideoFrame -> IO ()) -> IO ())
-> (Ptr VideoFrame -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFrame
ptr -> do
    Ptr (Ptr Buffer) -> Ptr Buffer -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoFrame
ptr Ptr VideoFrame -> Int -> Ptr (Ptr Buffer)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
128) (Ptr Buffer
val :: Ptr Gst.Buffer.Buffer)

-- | Set the value of the “@buffer@” 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' #buffer
-- @
clearVideoFrameBuffer :: MonadIO m => VideoFrame -> m ()
clearVideoFrameBuffer :: forall (m :: * -> *). MonadIO m => VideoFrame -> m ()
clearVideoFrameBuffer VideoFrame
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoFrame -> (Ptr VideoFrame -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFrame
s ((Ptr VideoFrame -> IO ()) -> IO ())
-> (Ptr VideoFrame -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFrame
ptr -> do
    Ptr (Ptr Buffer) -> Ptr Buffer -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoFrame
ptr Ptr VideoFrame -> Int -> Ptr (Ptr Buffer)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
128) (Ptr Buffer
forall a. Ptr a
FP.nullPtr :: Ptr Gst.Buffer.Buffer)

#if defined(ENABLE_OVERLOADING)
data VideoFrameBufferFieldInfo
instance AttrInfo VideoFrameBufferFieldInfo where
    type AttrBaseTypeConstraint VideoFrameBufferFieldInfo = (~) VideoFrame
    type AttrAllowedOps VideoFrameBufferFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint VideoFrameBufferFieldInfo = (~) (Ptr Gst.Buffer.Buffer)
    type AttrTransferTypeConstraint VideoFrameBufferFieldInfo = (~)(Ptr Gst.Buffer.Buffer)
    type AttrTransferType VideoFrameBufferFieldInfo = (Ptr Gst.Buffer.Buffer)
    type AttrGetType VideoFrameBufferFieldInfo = Maybe Gst.Buffer.Buffer
    type AttrLabel VideoFrameBufferFieldInfo = "buffer"
    type AttrOrigin VideoFrameBufferFieldInfo = VideoFrame
    attrGet = getVideoFrameBuffer
    attrSet = setVideoFrameBuffer
    attrConstruct = undefined
    attrClear = clearVideoFrameBuffer
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoFrame.buffer"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.25/docs/GI-GstVideo-Structs-VideoFrame.html#g:attr:buffer"
        })

videoFrame_buffer :: AttrLabelProxy "buffer"
videoFrame_buffer = AttrLabelProxy

#endif


-- | 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' videoFrame #meta
-- @
getVideoFrameMeta :: MonadIO m => VideoFrame -> m (Ptr ())
getVideoFrameMeta :: forall (m :: * -> *). MonadIO m => VideoFrame -> m (Ptr ())
getVideoFrameMeta VideoFrame
s = IO (Ptr ()) -> m (Ptr ())
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
$ VideoFrame -> (Ptr VideoFrame -> IO (Ptr ())) -> IO (Ptr ())
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFrame
s ((Ptr VideoFrame -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr VideoFrame -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFrame
ptr -> do
    Ptr ()
val <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoFrame
ptr Ptr VideoFrame -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
136) :: IO (Ptr ())
    Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
val

-- | Set 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.set' videoFrame [ #meta 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoFrameMeta :: MonadIO m => VideoFrame -> Ptr () -> m ()
setVideoFrameMeta :: forall (m :: * -> *). MonadIO m => VideoFrame -> Ptr () -> m ()
setVideoFrameMeta VideoFrame
s Ptr ()
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoFrame -> (Ptr VideoFrame -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFrame
s ((Ptr VideoFrame -> IO ()) -> IO ())
-> (Ptr VideoFrame -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFrame
ptr -> do
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoFrame
ptr Ptr VideoFrame -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
136) (Ptr ()
val :: Ptr ())

-- | Set the value of the “@meta@” 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' #meta
-- @
clearVideoFrameMeta :: MonadIO m => VideoFrame -> m ()
clearVideoFrameMeta :: forall (m :: * -> *). MonadIO m => VideoFrame -> m ()
clearVideoFrameMeta VideoFrame
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoFrame -> (Ptr VideoFrame -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFrame
s ((Ptr VideoFrame -> IO ()) -> IO ())
-> (Ptr VideoFrame -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFrame
ptr -> do
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoFrame
ptr Ptr VideoFrame -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
136) (Ptr ()
forall a. Ptr a
FP.nullPtr :: Ptr ())

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

videoFrame_meta :: AttrLabelProxy "meta"
videoFrame_meta = 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' videoFrame #id
-- @
getVideoFrameId :: MonadIO m => VideoFrame -> m Int32
getVideoFrameId :: forall (m :: * -> *). MonadIO m => VideoFrame -> m Int32
getVideoFrameId VideoFrame
s = IO Int32 -> m Int32
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
$ VideoFrame -> (Ptr VideoFrame -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFrame
s ((Ptr VideoFrame -> IO Int32) -> IO Int32)
-> (Ptr VideoFrame -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFrame
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoFrame
ptr Ptr VideoFrame -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
144) :: IO Int32
    Int32 -> IO Int32
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' videoFrame [ #id 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoFrameId :: MonadIO m => VideoFrame -> Int32 -> m ()
setVideoFrameId :: forall (m :: * -> *). MonadIO m => VideoFrame -> Int32 -> m ()
setVideoFrameId VideoFrame
s Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoFrame -> (Ptr VideoFrame -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoFrame
s ((Ptr VideoFrame -> IO ()) -> IO ())
-> (Ptr VideoFrame -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFrame
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoFrame
ptr Ptr VideoFrame -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
144) (Int32
val :: Int32)

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

videoFrame_id :: AttrLabelProxy "id"
videoFrame_id = AttrLabelProxy

#endif


-- XXX Skipped attribute for "VideoFrame:data"
-- Not implemented: Don't know how to unpack C array of type TCArray False 4 (-1) (TBasicType TPtr)
-- XXX Skipped attribute for "VideoFrame:map"
-- Not implemented: Don't know how to unpack C array of type TCArray False 4 (-1) (TInterface (Name {namespace = "Gst", name = "MapInfo"}))

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList VideoFrame
type instance O.AttributeList VideoFrame = VideoFrameAttributeList
type VideoFrameAttributeList = ('[ '("info", VideoFrameInfoFieldInfo), '("flags", VideoFrameFlagsFieldInfo), '("buffer", VideoFrameBufferFieldInfo), '("meta", VideoFrameMetaFieldInfo), '("id", VideoFrameIdFieldInfo)] :: [(Symbol, *)])
#endif

-- method VideoFrame::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "dest"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoFrame" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoFrame" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_frame_copy" gst_video_frame_copy :: 
    Ptr VideoFrame ->                       -- dest : TInterface (Name {namespace = "GstVideo", name = "VideoFrame"})
    Ptr VideoFrame ->                       -- src : TInterface (Name {namespace = "GstVideo", name = "VideoFrame"})
    IO CInt

-- | Copy the contents from /@src@/ to /@dest@/.
-- 
-- Note: Since: 1.18, /@dest@/ dimensions are allowed to be
-- smaller than /@src@/ dimensions.
videoFrameCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoFrame
    -- ^ /@dest@/: a t'GI.GstVideo.Structs.VideoFrame.VideoFrame'
    -> VideoFrame
    -- ^ /@src@/: a t'GI.GstVideo.Structs.VideoFrame.VideoFrame'
    -> m Bool
    -- ^ __Returns:__ TRUE if the contents could be copied.
videoFrameCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoFrame -> VideoFrame -> m Bool
videoFrameCopy VideoFrame
dest VideoFrame
src = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoFrame
dest' <- VideoFrame -> IO (Ptr VideoFrame)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoFrame
dest
    Ptr VideoFrame
src' <- VideoFrame -> IO (Ptr VideoFrame)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoFrame
src
    CInt
result <- Ptr VideoFrame -> Ptr VideoFrame -> IO CInt
gst_video_frame_copy Ptr VideoFrame
dest' Ptr VideoFrame
src'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    VideoFrame -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoFrame
dest
    VideoFrame -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoFrame
src
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoFrameCopyMethodInfo
instance (signature ~ (VideoFrame -> m Bool), MonadIO m) => O.OverloadedMethod VideoFrameCopyMethodInfo VideoFrame signature where
    overloadedMethod = videoFrameCopy

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


#endif

-- method VideoFrame::copy_plane
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "dest"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoFrame" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoFrame" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "plane"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a plane" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_frame_copy_plane" gst_video_frame_copy_plane :: 
    Ptr VideoFrame ->                       -- dest : TInterface (Name {namespace = "GstVideo", name = "VideoFrame"})
    Ptr VideoFrame ->                       -- src : TInterface (Name {namespace = "GstVideo", name = "VideoFrame"})
    Word32 ->                               -- plane : TBasicType TUInt
    IO CInt

-- | Copy the plane with index /@plane@/ from /@src@/ to /@dest@/.
-- 
-- Note: Since: 1.18, /@dest@/ dimensions are allowed to be
-- smaller than /@src@/ dimensions.
videoFrameCopyPlane ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoFrame
    -- ^ /@dest@/: a t'GI.GstVideo.Structs.VideoFrame.VideoFrame'
    -> VideoFrame
    -- ^ /@src@/: a t'GI.GstVideo.Structs.VideoFrame.VideoFrame'
    -> Word32
    -- ^ /@plane@/: a plane
    -> m Bool
    -- ^ __Returns:__ TRUE if the contents could be copied.
videoFrameCopyPlane :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoFrame -> VideoFrame -> Word32 -> m Bool
videoFrameCopyPlane VideoFrame
dest VideoFrame
src Word32
plane = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoFrame
dest' <- VideoFrame -> IO (Ptr VideoFrame)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoFrame
dest
    Ptr VideoFrame
src' <- VideoFrame -> IO (Ptr VideoFrame)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoFrame
src
    CInt
result <- Ptr VideoFrame -> Ptr VideoFrame -> Word32 -> IO CInt
gst_video_frame_copy_plane Ptr VideoFrame
dest' Ptr VideoFrame
src' Word32
plane
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    VideoFrame -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoFrame
dest
    VideoFrame -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoFrame
src
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoFrameCopyPlaneMethodInfo
instance (signature ~ (VideoFrame -> Word32 -> m Bool), MonadIO m) => O.OverloadedMethod VideoFrameCopyPlaneMethodInfo VideoFrame signature where
    overloadedMethod = videoFrameCopyPlane

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


#endif

-- method VideoFrame::unmap
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "frame"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoFrame" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_frame_unmap" gst_video_frame_unmap :: 
    Ptr VideoFrame ->                       -- frame : TInterface (Name {namespace = "GstVideo", name = "VideoFrame"})
    IO ()

-- | Unmap the memory previously mapped with gst_video_frame_map.
videoFrameUnmap ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoFrame
    -- ^ /@frame@/: a t'GI.GstVideo.Structs.VideoFrame.VideoFrame'
    -> m ()
videoFrameUnmap :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoFrame -> m ()
videoFrameUnmap VideoFrame
frame = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoFrame
frame' <- VideoFrame -> IO (Ptr VideoFrame)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoFrame
frame
    Ptr VideoFrame -> IO ()
gst_video_frame_unmap Ptr VideoFrame
frame'
    VideoFrame -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoFrame
frame
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoFrameUnmapMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod VideoFrameUnmapMethodInfo VideoFrame signature where
    overloadedMethod = videoFrameUnmap

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


#endif

-- method VideoFrame::map
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "frame"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoFrame" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pointer to #GstVideoFrame"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the buffer to map" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MapFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstMapFlags" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_frame_map" gst_video_frame_map :: 
    Ptr VideoFrame ->                       -- frame : TInterface (Name {namespace = "GstVideo", name = "VideoFrame"})
    Ptr GstVideo.VideoInfo.VideoInfo ->     -- info : TInterface (Name {namespace = "GstVideo", name = "VideoInfo"})
    Ptr Gst.Buffer.Buffer ->                -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "MapFlags"})
    IO CInt

-- | Use /@info@/ and /@buffer@/ to fill in the values of /@frame@/. /@frame@/ is usually
-- allocated on the stack, and you will pass the address to the t'GI.GstVideo.Structs.VideoFrame.VideoFrame'
-- structure allocated on the stack; 'GI.GstVideo.Functions.videoFrameMap' will then fill in
-- the structures with the various video-specific information you need to access
-- the pixels of the video buffer. You can then use accessor macros such as
-- @/GST_VIDEO_FRAME_COMP_DATA()/@, @/GST_VIDEO_FRAME_PLANE_DATA()/@,
-- @/GST_VIDEO_FRAME_COMP_STRIDE()/@, @/GST_VIDEO_FRAME_PLANE_STRIDE()/@ etc.
-- to get to the pixels.
-- 
-- 
-- === /C code/
-- >
-- >  GstVideoFrame vframe;
-- >  ...
-- >  // set RGB pixels to black one at a time
-- >  if (gst_video_frame_map (&amp;vframe, video_info, video_buffer, GST_MAP_WRITE)) {
-- >    guint8 *pixels = GST_VIDEO_FRAME_PLANE_DATA (vframe, 0);
-- >    guint stride = GST_VIDEO_FRAME_PLANE_STRIDE (vframe, 0);
-- >    guint pixel_stride = GST_VIDEO_FRAME_COMP_PSTRIDE (vframe, 0);
-- >
-- >    for (h = 0; h < height; ++h) {
-- >      for (w = 0; w < width; ++w) {
-- >        guint8 *pixel = pixels + h * stride + w * pixel_stride;
-- >
-- >        memset (pixel, 0, pixel_stride);
-- >      }
-- >    }
-- >
-- >    gst_video_frame_unmap (&amp;vframe);
-- >  }
-- >  ...
-- 
-- 
-- All video planes of /@buffer@/ will be mapped and the pointers will be set in
-- /@frame@/->data.
-- 
-- The purpose of this function is to make it easy for you to get to the video
-- pixels in a generic way, without you having to worry too much about details
-- such as whether the video data is allocated in one contiguous memory chunk
-- or multiple memory chunks (e.g. one for each plane); or if custom strides
-- and custom plane offsets are used or not (as signalled by GstVideoMeta on
-- each buffer). This function will just fill the t'GI.GstVideo.Structs.VideoFrame.VideoFrame' structure
-- with the right values and if you use the accessor macros everything will
-- just work and you can access the data easily. It also maps the underlying
-- memory chunks for you.
videoFrameMap ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GstVideo.VideoInfo.VideoInfo
    -- ^ /@info@/: a t'GI.GstVideo.Structs.VideoInfo.VideoInfo'
    -> Gst.Buffer.Buffer
    -- ^ /@buffer@/: the buffer to map
    -> [Gst.Flags.MapFlags]
    -- ^ /@flags@/: t'GI.Gst.Flags.MapFlags'
    -> m ((Bool, VideoFrame))
    -- ^ __Returns:__ 'P.True' on success.
videoFrameMap :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoInfo -> Buffer -> [MapFlags] -> m (Bool, VideoFrame)
videoFrameMap VideoInfo
info Buffer
buffer [MapFlags]
flags = IO (Bool, VideoFrame) -> m (Bool, VideoFrame)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, VideoFrame) -> m (Bool, VideoFrame))
-> IO (Bool, VideoFrame) -> m (Bool, VideoFrame)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoFrame
frame <- Int -> IO (Ptr VideoFrame)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
632 :: IO (Ptr VideoFrame)
    Ptr VideoInfo
info' <- VideoInfo -> IO (Ptr VideoInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoInfo
info
    Ptr Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    let flags' :: CUInt
flags' = [MapFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MapFlags]
flags
    CInt
result <- Ptr VideoFrame -> Ptr VideoInfo -> Ptr Buffer -> CUInt -> IO CInt
gst_video_frame_map Ptr VideoFrame
frame Ptr VideoInfo
info' Ptr Buffer
buffer' CUInt
flags'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    VideoFrame
frame' <- ((ManagedPtr VideoFrame -> VideoFrame)
-> Ptr VideoFrame -> IO VideoFrame
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr VideoFrame -> VideoFrame
VideoFrame) Ptr VideoFrame
frame
    VideoInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoInfo
info
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    (Bool, VideoFrame) -> IO (Bool, VideoFrame)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', VideoFrame
frame')

#if defined(ENABLE_OVERLOADING)
#endif

-- method VideoFrame::map_id
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "frame"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoFrame" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pointer to #GstVideoFrame"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the buffer to map" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the frame id to map"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MapFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstMapFlags" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_frame_map_id" gst_video_frame_map_id :: 
    Ptr VideoFrame ->                       -- frame : TInterface (Name {namespace = "GstVideo", name = "VideoFrame"})
    Ptr GstVideo.VideoInfo.VideoInfo ->     -- info : TInterface (Name {namespace = "GstVideo", name = "VideoInfo"})
    Ptr Gst.Buffer.Buffer ->                -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Int32 ->                                -- id : TBasicType TInt
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "MapFlags"})
    IO CInt

-- | Use /@info@/ and /@buffer@/ to fill in the values of /@frame@/ with the video frame
-- information of frame /@id@/.
-- 
-- When /@id@/ is -1, the default frame is mapped. When /@id@/ != -1, this function
-- will return 'P.False' when there is no GstVideoMeta with that id.
-- 
-- All video planes of /@buffer@/ will be mapped and the pointers will be set in
-- /@frame@/->data.
videoFrameMapId ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GstVideo.VideoInfo.VideoInfo
    -- ^ /@info@/: a t'GI.GstVideo.Structs.VideoInfo.VideoInfo'
    -> Gst.Buffer.Buffer
    -- ^ /@buffer@/: the buffer to map
    -> Int32
    -- ^ /@id@/: the frame id to map
    -> [Gst.Flags.MapFlags]
    -- ^ /@flags@/: t'GI.Gst.Flags.MapFlags'
    -> m ((Bool, VideoFrame))
    -- ^ __Returns:__ 'P.True' on success.
videoFrameMapId :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoInfo -> Buffer -> Int32 -> [MapFlags] -> m (Bool, VideoFrame)
videoFrameMapId VideoInfo
info Buffer
buffer Int32
id [MapFlags]
flags = IO (Bool, VideoFrame) -> m (Bool, VideoFrame)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, VideoFrame) -> m (Bool, VideoFrame))
-> IO (Bool, VideoFrame) -> m (Bool, VideoFrame)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoFrame
frame <- Int -> IO (Ptr VideoFrame)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
632 :: IO (Ptr VideoFrame)
    Ptr VideoInfo
info' <- VideoInfo -> IO (Ptr VideoInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoInfo
info
    Ptr Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    let flags' :: CUInt
flags' = [MapFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MapFlags]
flags
    CInt
result <- Ptr VideoFrame
-> Ptr VideoInfo -> Ptr Buffer -> Int32 -> CUInt -> IO CInt
gst_video_frame_map_id Ptr VideoFrame
frame Ptr VideoInfo
info' Ptr Buffer
buffer' Int32
id CUInt
flags'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    VideoFrame
frame' <- ((ManagedPtr VideoFrame -> VideoFrame)
-> Ptr VideoFrame -> IO VideoFrame
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr VideoFrame -> VideoFrame
VideoFrame) Ptr VideoFrame
frame
    VideoInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoInfo
info
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    (Bool, VideoFrame) -> IO (Bool, VideoFrame)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', VideoFrame
frame')

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveVideoFrameMethod (t :: Symbol) (o :: *) :: * where
    ResolveVideoFrameMethod "copy" o = VideoFrameCopyMethodInfo
    ResolveVideoFrameMethod "copyPlane" o = VideoFrameCopyPlaneMethodInfo
    ResolveVideoFrameMethod "unmap" o = VideoFrameUnmapMethodInfo
    ResolveVideoFrameMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif