{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Information describing image properties. This information can be filled
-- in from GstCaps with 'GI.GstVideo.Structs.VideoInfo.videoInfoFromCaps'. The information is also used
-- to store the specific video info when mapping a video frame with
-- 'GI.GstVideo.Structs.VideoFrame.videoFrameMap'.
-- 
-- Use the provided macros to access the info in this structure.

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

module GI.GstVideo.Structs.VideoInfo
    ( 

-- * Exported types
    VideoInfo(..)                           ,
    newZeroVideoInfo                        ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [align]("GI.GstVideo.Structs.VideoInfo#g:method:align"), [alignFull]("GI.GstVideo.Structs.VideoInfo#g:method:alignFull"), [convert]("GI.GstVideo.Structs.VideoInfo#g:method:convert"), [copy]("GI.GstVideo.Structs.VideoInfo#g:method:copy"), [free]("GI.GstVideo.Structs.VideoInfo#g:method:free"), [fromCaps]("GI.GstVideo.Structs.VideoInfo#g:method:fromCaps"), [init]("GI.GstVideo.Structs.VideoInfo#g:method:init"), [isEqual]("GI.GstVideo.Structs.VideoInfo#g:method:isEqual"), [toCaps]("GI.GstVideo.Structs.VideoInfo#g:method:toCaps").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- [setFormat]("GI.GstVideo.Structs.VideoInfo#g:method:setFormat"), [setInterlacedFormat]("GI.GstVideo.Structs.VideoInfo#g:method:setInterlacedFormat").

#if defined(ENABLE_OVERLOADING)
    ResolveVideoInfoMethod                  ,
#endif

-- ** align #method:align#

#if defined(ENABLE_OVERLOADING)
    VideoInfoAlignMethodInfo                ,
#endif
    videoInfoAlign                          ,


-- ** alignFull #method:alignFull#

#if defined(ENABLE_OVERLOADING)
    VideoInfoAlignFullMethodInfo            ,
#endif
    videoInfoAlignFull                      ,


-- ** convert #method:convert#

#if defined(ENABLE_OVERLOADING)
    VideoInfoConvertMethodInfo              ,
#endif
    videoInfoConvert                        ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    VideoInfoCopyMethodInfo                 ,
#endif
    videoInfoCopy                           ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    VideoInfoFreeMethodInfo                 ,
#endif
    videoInfoFree                           ,


-- ** fromCaps #method:fromCaps#

#if defined(ENABLE_OVERLOADING)
    VideoInfoFromCapsMethodInfo             ,
#endif
    videoInfoFromCaps                       ,


-- ** init #method:init#

#if defined(ENABLE_OVERLOADING)
    VideoInfoInitMethodInfo                 ,
#endif
    videoInfoInit                           ,


-- ** isEqual #method:isEqual#

#if defined(ENABLE_OVERLOADING)
    VideoInfoIsEqualMethodInfo              ,
#endif
    videoInfoIsEqual                        ,


-- ** new #method:new#

    videoInfoNew                            ,


-- ** setFormat #method:setFormat#

#if defined(ENABLE_OVERLOADING)
    VideoInfoSetFormatMethodInfo            ,
#endif
    videoInfoSetFormat                      ,


-- ** setInterlacedFormat #method:setInterlacedFormat#

#if defined(ENABLE_OVERLOADING)
    VideoInfoSetInterlacedFormatMethodInfo  ,
#endif
    videoInfoSetInterlacedFormat            ,


-- ** toCaps #method:toCaps#

#if defined(ENABLE_OVERLOADING)
    VideoInfoToCapsMethodInfo               ,
#endif
    videoInfoToCaps                         ,




 -- * Properties


-- ** chromaSite #attr:chromaSite#
-- | a t'GI.GstVideo.Flags.VideoChromaSite'.

    getVideoInfoChromaSite                  ,
    setVideoInfoChromaSite                  ,
#if defined(ENABLE_OVERLOADING)
    videoInfo_chromaSite                    ,
#endif


-- ** colorimetry #attr:colorimetry#
-- | the colorimetry info

    getVideoInfoColorimetry                 ,
#if defined(ENABLE_OVERLOADING)
    videoInfo_colorimetry                   ,
#endif


-- ** finfo #attr:finfo#
-- | the format info of the video

    clearVideoInfoFinfo                     ,
    getVideoInfoFinfo                       ,
    setVideoInfoFinfo                       ,
#if defined(ENABLE_OVERLOADING)
    videoInfo_finfo                         ,
#endif


-- ** flags #attr:flags#
-- | additional video flags

    getVideoInfoFlags                       ,
    setVideoInfoFlags                       ,
#if defined(ENABLE_OVERLOADING)
    videoInfo_flags                         ,
#endif


-- ** fpsD #attr:fpsD#
-- | the framerate denominator

    getVideoInfoFpsD                        ,
    setVideoInfoFpsD                        ,
#if defined(ENABLE_OVERLOADING)
    videoInfo_fpsD                          ,
#endif


-- ** fpsN #attr:fpsN#
-- | the framerate numerator

    getVideoInfoFpsN                        ,
    setVideoInfoFpsN                        ,
#if defined(ENABLE_OVERLOADING)
    videoInfo_fpsN                          ,
#endif


-- ** height #attr:height#
-- | the height of the video

    getVideoInfoHeight                      ,
    setVideoInfoHeight                      ,
#if defined(ENABLE_OVERLOADING)
    videoInfo_height                        ,
#endif


-- ** interlaceMode #attr:interlaceMode#
-- | the interlace mode

    getVideoInfoInterlaceMode               ,
    setVideoInfoInterlaceMode               ,
#if defined(ENABLE_OVERLOADING)
    videoInfo_interlaceMode                 ,
#endif


-- ** parD #attr:parD#
-- | the pixel-aspect-ratio denominator

    getVideoInfoParD                        ,
    setVideoInfoParD                        ,
#if defined(ENABLE_OVERLOADING)
    videoInfo_parD                          ,
#endif


-- ** parN #attr:parN#
-- | the pixel-aspect-ratio numerator

    getVideoInfoParN                        ,
    setVideoInfoParN                        ,
#if defined(ENABLE_OVERLOADING)
    videoInfo_parN                          ,
#endif


-- ** size #attr:size#
-- | the default size of one frame

    getVideoInfoSize                        ,
    setVideoInfoSize                        ,
#if defined(ENABLE_OVERLOADING)
    videoInfo_size                          ,
#endif


-- ** views #attr:views#
-- | the number of views for multiview video

    getVideoInfoViews                       ,
    setVideoInfoViews                       ,
#if defined(ENABLE_OVERLOADING)
    videoInfo_views                         ,
#endif


-- ** width #attr:width#
-- | the width of the video

    getVideoInfoWidth                       ,
    setVideoInfoWidth                       ,
#if defined(ENABLE_OVERLOADING)
    videoInfo_width                         ,
#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.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.Enums as Gst.Enums
import qualified GI.Gst.Structs.Caps as Gst.Caps
import {-# SOURCE #-} qualified GI.GstVideo.Enums as GstVideo.Enums
import {-# SOURCE #-} qualified GI.GstVideo.Flags as GstVideo.Flags
import {-# SOURCE #-} qualified GI.GstVideo.Structs.VideoAlignment as GstVideo.VideoAlignment
import {-# SOURCE #-} qualified GI.GstVideo.Structs.VideoColorimetry as GstVideo.VideoColorimetry
import {-# SOURCE #-} qualified GI.GstVideo.Structs.VideoFormatInfo as GstVideo.VideoFormatInfo

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

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

foreign import ccall "gst_video_info_get_type" c_gst_video_info_get_type :: 
    IO GType

type instance O.ParentTypes VideoInfo = '[]
instance O.HasParentTypes VideoInfo

instance B.Types.TypedObject VideoInfo where
    glibType :: IO GType
glibType = IO GType
c_gst_video_info_get_type

instance B.Types.GBoxed VideoInfo

-- | Convert 'VideoInfo' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe VideoInfo) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gst_video_info_get_type
    gvalueSet_ :: Ptr GValue -> Maybe VideoInfo -> IO ()
gvalueSet_ Ptr GValue
gv Maybe VideoInfo
P.Nothing = Ptr GValue -> Ptr VideoInfo -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr VideoInfo
forall a. Ptr a
FP.nullPtr :: FP.Ptr VideoInfo)
    gvalueSet_ Ptr GValue
gv (P.Just VideoInfo
obj) = VideoInfo -> (Ptr VideoInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr VideoInfo
obj (Ptr GValue -> Ptr VideoInfo -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe VideoInfo)
gvalueGet_ Ptr GValue
gv = do
        Ptr VideoInfo
ptr <- Ptr GValue -> IO (Ptr VideoInfo)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr VideoInfo)
        if Ptr VideoInfo
ptr Ptr VideoInfo -> Ptr VideoInfo -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr VideoInfo
forall a. Ptr a
FP.nullPtr
        then VideoInfo -> Maybe VideoInfo
forall a. a -> Maybe a
P.Just (VideoInfo -> Maybe VideoInfo)
-> IO VideoInfo -> IO (Maybe VideoInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr VideoInfo -> VideoInfo)
-> Ptr VideoInfo -> IO VideoInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr VideoInfo -> VideoInfo
VideoInfo Ptr VideoInfo
ptr
        else Maybe VideoInfo -> IO (Maybe VideoInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe VideoInfo
forall a. Maybe a
P.Nothing
        
    

-- | Construct a `VideoInfo` struct initialized to zero.
newZeroVideoInfo :: MonadIO m => m VideoInfo
newZeroVideoInfo :: forall (m :: * -> *). MonadIO m => m VideoInfo
newZeroVideoInfo = 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
$ Int -> IO (Ptr VideoInfo)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
120 IO (Ptr VideoInfo)
-> (Ptr VideoInfo -> IO VideoInfo) -> IO VideoInfo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr VideoInfo -> VideoInfo)
-> Ptr VideoInfo -> IO VideoInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr VideoInfo -> VideoInfo
VideoInfo

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


-- | Get the value of the “@finfo@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoInfo #finfo
-- @
getVideoInfoFinfo :: MonadIO m => VideoInfo -> m (Maybe GstVideo.VideoFormatInfo.VideoFormatInfo)
getVideoInfoFinfo :: forall (m :: * -> *).
MonadIO m =>
VideoInfo -> m (Maybe VideoFormatInfo)
getVideoInfoFinfo VideoInfo
s = IO (Maybe VideoFormatInfo) -> m (Maybe VideoFormatInfo)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe VideoFormatInfo) -> m (Maybe VideoFormatInfo))
-> IO (Maybe VideoFormatInfo) -> m (Maybe VideoFormatInfo)
forall a b. (a -> b) -> a -> b
$ VideoInfo
-> (Ptr VideoInfo -> IO (Maybe VideoFormatInfo))
-> IO (Maybe VideoFormatInfo)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoInfo
s ((Ptr VideoInfo -> IO (Maybe VideoFormatInfo))
 -> IO (Maybe VideoFormatInfo))
-> (Ptr VideoInfo -> IO (Maybe VideoFormatInfo))
-> IO (Maybe VideoFormatInfo)
forall a b. (a -> b) -> a -> b
$ \Ptr VideoInfo
ptr -> do
    Ptr VideoFormatInfo
val <- Ptr (Ptr VideoFormatInfo) -> IO (Ptr VideoFormatInfo)
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoInfo
ptr Ptr VideoInfo -> Int -> Ptr (Ptr VideoFormatInfo)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO (Ptr GstVideo.VideoFormatInfo.VideoFormatInfo)
    Maybe VideoFormatInfo
result <- Ptr VideoFormatInfo
-> (Ptr VideoFormatInfo -> IO VideoFormatInfo)
-> IO (Maybe VideoFormatInfo)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr VideoFormatInfo
val ((Ptr VideoFormatInfo -> IO VideoFormatInfo)
 -> IO (Maybe VideoFormatInfo))
-> (Ptr VideoFormatInfo -> IO VideoFormatInfo)
-> IO (Maybe VideoFormatInfo)
forall a b. (a -> b) -> a -> b
$ \Ptr VideoFormatInfo
val' -> do
        VideoFormatInfo
val'' <- ((ManagedPtr VideoFormatInfo -> VideoFormatInfo)
-> Ptr VideoFormatInfo -> IO VideoFormatInfo
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr VideoFormatInfo -> VideoFormatInfo
GstVideo.VideoFormatInfo.VideoFormatInfo) Ptr VideoFormatInfo
val'
        VideoFormatInfo -> IO VideoFormatInfo
forall (m :: * -> *) a. Monad m => a -> m a
return VideoFormatInfo
val''
    Maybe VideoFormatInfo -> IO (Maybe VideoFormatInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe VideoFormatInfo
result

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

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

#if defined(ENABLE_OVERLOADING)
data VideoInfoFinfoFieldInfo
instance AttrInfo VideoInfoFinfoFieldInfo where
    type AttrBaseTypeConstraint VideoInfoFinfoFieldInfo = (~) VideoInfo
    type AttrAllowedOps VideoInfoFinfoFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint VideoInfoFinfoFieldInfo = (~) (Ptr GstVideo.VideoFormatInfo.VideoFormatInfo)
    type AttrTransferTypeConstraint VideoInfoFinfoFieldInfo = (~)(Ptr GstVideo.VideoFormatInfo.VideoFormatInfo)
    type AttrTransferType VideoInfoFinfoFieldInfo = (Ptr GstVideo.VideoFormatInfo.VideoFormatInfo)
    type AttrGetType VideoInfoFinfoFieldInfo = Maybe GstVideo.VideoFormatInfo.VideoFormatInfo
    type AttrLabel VideoInfoFinfoFieldInfo = "finfo"
    type AttrOrigin VideoInfoFinfoFieldInfo = VideoInfo
    attrGet = getVideoInfoFinfo
    attrSet = setVideoInfoFinfo
    attrConstruct = undefined
    attrClear = clearVideoInfoFinfo
    attrTransfer _ v = do
        return v

videoInfo_finfo :: AttrLabelProxy "finfo"
videoInfo_finfo = AttrLabelProxy

#endif


-- | Get the value of the “@interlace_mode@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoInfo #interlaceMode
-- @
getVideoInfoInterlaceMode :: MonadIO m => VideoInfo -> m GstVideo.Enums.VideoInterlaceMode
getVideoInfoInterlaceMode :: forall (m :: * -> *).
MonadIO m =>
VideoInfo -> m VideoInterlaceMode
getVideoInfoInterlaceMode VideoInfo
s = IO VideoInterlaceMode -> m VideoInterlaceMode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VideoInterlaceMode -> m VideoInterlaceMode)
-> IO VideoInterlaceMode -> m VideoInterlaceMode
forall a b. (a -> b) -> a -> b
$ VideoInfo
-> (Ptr VideoInfo -> IO VideoInterlaceMode)
-> IO VideoInterlaceMode
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoInfo
s ((Ptr VideoInfo -> IO VideoInterlaceMode) -> IO VideoInterlaceMode)
-> (Ptr VideoInfo -> IO VideoInterlaceMode)
-> IO VideoInterlaceMode
forall a b. (a -> b) -> a -> b
$ \Ptr VideoInfo
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoInfo
ptr Ptr VideoInfo -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO CUInt
    let val' :: VideoInterlaceMode
val' = (Int -> VideoInterlaceMode
forall a. Enum a => Int -> a
toEnum (Int -> VideoInterlaceMode)
-> (CUInt -> Int) -> CUInt -> VideoInterlaceMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
val
    VideoInterlaceMode -> IO VideoInterlaceMode
forall (m :: * -> *) a. Monad m => a -> m a
return VideoInterlaceMode
val'

-- | Set the value of the “@interlace_mode@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoInfo [ #interlaceMode 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoInfoInterlaceMode :: MonadIO m => VideoInfo -> GstVideo.Enums.VideoInterlaceMode -> m ()
setVideoInfoInterlaceMode :: forall (m :: * -> *).
MonadIO m =>
VideoInfo -> VideoInterlaceMode -> m ()
setVideoInfoInterlaceMode VideoInfo
s VideoInterlaceMode
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoInfo -> (Ptr VideoInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoInfo
s ((Ptr VideoInfo -> IO ()) -> IO ())
-> (Ptr VideoInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoInfo
ptr -> do
    let val' :: CUInt
val' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (VideoInterlaceMode -> Int) -> VideoInterlaceMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VideoInterlaceMode -> Int
forall a. Enum a => a -> Int
fromEnum) VideoInterlaceMode
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoInfo
ptr Ptr VideoInfo -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data VideoInfoInterlaceModeFieldInfo
instance AttrInfo VideoInfoInterlaceModeFieldInfo where
    type AttrBaseTypeConstraint VideoInfoInterlaceModeFieldInfo = (~) VideoInfo
    type AttrAllowedOps VideoInfoInterlaceModeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoInfoInterlaceModeFieldInfo = (~) GstVideo.Enums.VideoInterlaceMode
    type AttrTransferTypeConstraint VideoInfoInterlaceModeFieldInfo = (~)GstVideo.Enums.VideoInterlaceMode
    type AttrTransferType VideoInfoInterlaceModeFieldInfo = GstVideo.Enums.VideoInterlaceMode
    type AttrGetType VideoInfoInterlaceModeFieldInfo = GstVideo.Enums.VideoInterlaceMode
    type AttrLabel VideoInfoInterlaceModeFieldInfo = "interlace_mode"
    type AttrOrigin VideoInfoInterlaceModeFieldInfo = VideoInfo
    attrGet = getVideoInfoInterlaceMode
    attrSet = setVideoInfoInterlaceMode
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

videoInfo_interlaceMode :: AttrLabelProxy "interlaceMode"
videoInfo_interlaceMode = 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' videoInfo #flags
-- @
getVideoInfoFlags :: MonadIO m => VideoInfo -> m [GstVideo.Flags.VideoFlags]
getVideoInfoFlags :: forall (m :: * -> *). MonadIO m => VideoInfo -> m [VideoFlags]
getVideoInfoFlags VideoInfo
s = IO [VideoFlags] -> m [VideoFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [VideoFlags] -> m [VideoFlags])
-> IO [VideoFlags] -> m [VideoFlags]
forall a b. (a -> b) -> a -> b
$ VideoInfo -> (Ptr VideoInfo -> IO [VideoFlags]) -> IO [VideoFlags]
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoInfo
s ((Ptr VideoInfo -> IO [VideoFlags]) -> IO [VideoFlags])
-> (Ptr VideoInfo -> IO [VideoFlags]) -> IO [VideoFlags]
forall a b. (a -> b) -> a -> b
$ \Ptr VideoInfo
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoInfo
ptr Ptr VideoInfo -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12) :: IO CUInt
    let val' :: [VideoFlags]
val' = CUInt -> [VideoFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
val
    [VideoFlags] -> IO [VideoFlags]
forall (m :: * -> *) a. Monad m => a -> m a
return [VideoFlags]
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' videoInfo [ #flags 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoInfoFlags :: MonadIO m => VideoInfo -> [GstVideo.Flags.VideoFlags] -> m ()
setVideoInfoFlags :: forall (m :: * -> *).
MonadIO m =>
VideoInfo -> [VideoFlags] -> m ()
setVideoInfoFlags VideoInfo
s [VideoFlags]
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoInfo -> (Ptr VideoInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoInfo
s ((Ptr VideoInfo -> IO ()) -> IO ())
-> (Ptr VideoInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoInfo
ptr -> do
    let val' :: CUInt
val' = [VideoFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [VideoFlags]
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoInfo
ptr Ptr VideoInfo -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data VideoInfoFlagsFieldInfo
instance AttrInfo VideoInfoFlagsFieldInfo where
    type AttrBaseTypeConstraint VideoInfoFlagsFieldInfo = (~) VideoInfo
    type AttrAllowedOps VideoInfoFlagsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoInfoFlagsFieldInfo = (~) [GstVideo.Flags.VideoFlags]
    type AttrTransferTypeConstraint VideoInfoFlagsFieldInfo = (~)[GstVideo.Flags.VideoFlags]
    type AttrTransferType VideoInfoFlagsFieldInfo = [GstVideo.Flags.VideoFlags]
    type AttrGetType VideoInfoFlagsFieldInfo = [GstVideo.Flags.VideoFlags]
    type AttrLabel VideoInfoFlagsFieldInfo = "flags"
    type AttrOrigin VideoInfoFlagsFieldInfo = VideoInfo
    attrGet = getVideoInfoFlags
    attrSet = setVideoInfoFlags
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

videoInfo_flags :: AttrLabelProxy "flags"
videoInfo_flags = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data VideoInfoWidthFieldInfo
instance AttrInfo VideoInfoWidthFieldInfo where
    type AttrBaseTypeConstraint VideoInfoWidthFieldInfo = (~) VideoInfo
    type AttrAllowedOps VideoInfoWidthFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoInfoWidthFieldInfo = (~) Int32
    type AttrTransferTypeConstraint VideoInfoWidthFieldInfo = (~)Int32
    type AttrTransferType VideoInfoWidthFieldInfo = Int32
    type AttrGetType VideoInfoWidthFieldInfo = Int32
    type AttrLabel VideoInfoWidthFieldInfo = "width"
    type AttrOrigin VideoInfoWidthFieldInfo = VideoInfo
    attrGet = getVideoInfoWidth
    attrSet = setVideoInfoWidth
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

videoInfo_width :: AttrLabelProxy "width"
videoInfo_width = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data VideoInfoHeightFieldInfo
instance AttrInfo VideoInfoHeightFieldInfo where
    type AttrBaseTypeConstraint VideoInfoHeightFieldInfo = (~) VideoInfo
    type AttrAllowedOps VideoInfoHeightFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoInfoHeightFieldInfo = (~) Int32
    type AttrTransferTypeConstraint VideoInfoHeightFieldInfo = (~)Int32
    type AttrTransferType VideoInfoHeightFieldInfo = Int32
    type AttrGetType VideoInfoHeightFieldInfo = Int32
    type AttrLabel VideoInfoHeightFieldInfo = "height"
    type AttrOrigin VideoInfoHeightFieldInfo = VideoInfo
    attrGet = getVideoInfoHeight
    attrSet = setVideoInfoHeight
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

videoInfo_height :: AttrLabelProxy "height"
videoInfo_height = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data VideoInfoSizeFieldInfo
instance AttrInfo VideoInfoSizeFieldInfo where
    type AttrBaseTypeConstraint VideoInfoSizeFieldInfo = (~) VideoInfo
    type AttrAllowedOps VideoInfoSizeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoInfoSizeFieldInfo = (~) Word64
    type AttrTransferTypeConstraint VideoInfoSizeFieldInfo = (~)Word64
    type AttrTransferType VideoInfoSizeFieldInfo = Word64
    type AttrGetType VideoInfoSizeFieldInfo = Word64
    type AttrLabel VideoInfoSizeFieldInfo = "size"
    type AttrOrigin VideoInfoSizeFieldInfo = VideoInfo
    attrGet = getVideoInfoSize
    attrSet = setVideoInfoSize
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

videoInfo_size :: AttrLabelProxy "size"
videoInfo_size = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data VideoInfoViewsFieldInfo
instance AttrInfo VideoInfoViewsFieldInfo where
    type AttrBaseTypeConstraint VideoInfoViewsFieldInfo = (~) VideoInfo
    type AttrAllowedOps VideoInfoViewsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoInfoViewsFieldInfo = (~) Int32
    type AttrTransferTypeConstraint VideoInfoViewsFieldInfo = (~)Int32
    type AttrTransferType VideoInfoViewsFieldInfo = Int32
    type AttrGetType VideoInfoViewsFieldInfo = Int32
    type AttrLabel VideoInfoViewsFieldInfo = "views"
    type AttrOrigin VideoInfoViewsFieldInfo = VideoInfo
    attrGet = getVideoInfoViews
    attrSet = setVideoInfoViews
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

videoInfo_views :: AttrLabelProxy "views"
videoInfo_views = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data VideoInfoChromaSiteFieldInfo
instance AttrInfo VideoInfoChromaSiteFieldInfo where
    type AttrBaseTypeConstraint VideoInfoChromaSiteFieldInfo = (~) VideoInfo
    type AttrAllowedOps VideoInfoChromaSiteFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoInfoChromaSiteFieldInfo = (~) [GstVideo.Flags.VideoChromaSite]
    type AttrTransferTypeConstraint VideoInfoChromaSiteFieldInfo = (~)[GstVideo.Flags.VideoChromaSite]
    type AttrTransferType VideoInfoChromaSiteFieldInfo = [GstVideo.Flags.VideoChromaSite]
    type AttrGetType VideoInfoChromaSiteFieldInfo = [GstVideo.Flags.VideoChromaSite]
    type AttrLabel VideoInfoChromaSiteFieldInfo = "chroma_site"
    type AttrOrigin VideoInfoChromaSiteFieldInfo = VideoInfo
    attrGet = getVideoInfoChromaSite
    attrSet = setVideoInfoChromaSite
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

videoInfo_chromaSite :: AttrLabelProxy "chromaSite"
videoInfo_chromaSite = AttrLabelProxy

#endif


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

#if defined(ENABLE_OVERLOADING)
data VideoInfoColorimetryFieldInfo
instance AttrInfo VideoInfoColorimetryFieldInfo where
    type AttrBaseTypeConstraint VideoInfoColorimetryFieldInfo = (~) VideoInfo
    type AttrAllowedOps VideoInfoColorimetryFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint VideoInfoColorimetryFieldInfo = (~) (Ptr GstVideo.VideoColorimetry.VideoColorimetry)
    type AttrTransferTypeConstraint VideoInfoColorimetryFieldInfo = (~)(Ptr GstVideo.VideoColorimetry.VideoColorimetry)
    type AttrTransferType VideoInfoColorimetryFieldInfo = (Ptr GstVideo.VideoColorimetry.VideoColorimetry)
    type AttrGetType VideoInfoColorimetryFieldInfo = GstVideo.VideoColorimetry.VideoColorimetry
    type AttrLabel VideoInfoColorimetryFieldInfo = "colorimetry"
    type AttrOrigin VideoInfoColorimetryFieldInfo = VideoInfo
    attrGet = getVideoInfoColorimetry
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined

videoInfo_colorimetry :: AttrLabelProxy "colorimetry"
videoInfo_colorimetry = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data VideoInfoParNFieldInfo
instance AttrInfo VideoInfoParNFieldInfo where
    type AttrBaseTypeConstraint VideoInfoParNFieldInfo = (~) VideoInfo
    type AttrAllowedOps VideoInfoParNFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoInfoParNFieldInfo = (~) Int32
    type AttrTransferTypeConstraint VideoInfoParNFieldInfo = (~)Int32
    type AttrTransferType VideoInfoParNFieldInfo = Int32
    type AttrGetType VideoInfoParNFieldInfo = Int32
    type AttrLabel VideoInfoParNFieldInfo = "par_n"
    type AttrOrigin VideoInfoParNFieldInfo = VideoInfo
    attrGet = getVideoInfoParN
    attrSet = setVideoInfoParN
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

videoInfo_parN :: AttrLabelProxy "parN"
videoInfo_parN = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data VideoInfoParDFieldInfo
instance AttrInfo VideoInfoParDFieldInfo where
    type AttrBaseTypeConstraint VideoInfoParDFieldInfo = (~) VideoInfo
    type AttrAllowedOps VideoInfoParDFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoInfoParDFieldInfo = (~) Int32
    type AttrTransferTypeConstraint VideoInfoParDFieldInfo = (~)Int32
    type AttrTransferType VideoInfoParDFieldInfo = Int32
    type AttrGetType VideoInfoParDFieldInfo = Int32
    type AttrLabel VideoInfoParDFieldInfo = "par_d"
    type AttrOrigin VideoInfoParDFieldInfo = VideoInfo
    attrGet = getVideoInfoParD
    attrSet = setVideoInfoParD
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

videoInfo_parD :: AttrLabelProxy "parD"
videoInfo_parD = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data VideoInfoFpsNFieldInfo
instance AttrInfo VideoInfoFpsNFieldInfo where
    type AttrBaseTypeConstraint VideoInfoFpsNFieldInfo = (~) VideoInfo
    type AttrAllowedOps VideoInfoFpsNFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoInfoFpsNFieldInfo = (~) Int32
    type AttrTransferTypeConstraint VideoInfoFpsNFieldInfo = (~)Int32
    type AttrTransferType VideoInfoFpsNFieldInfo = Int32
    type AttrGetType VideoInfoFpsNFieldInfo = Int32
    type AttrLabel VideoInfoFpsNFieldInfo = "fps_n"
    type AttrOrigin VideoInfoFpsNFieldInfo = VideoInfo
    attrGet = getVideoInfoFpsN
    attrSet = setVideoInfoFpsN
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

videoInfo_fpsN :: AttrLabelProxy "fpsN"
videoInfo_fpsN = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data VideoInfoFpsDFieldInfo
instance AttrInfo VideoInfoFpsDFieldInfo where
    type AttrBaseTypeConstraint VideoInfoFpsDFieldInfo = (~) VideoInfo
    type AttrAllowedOps VideoInfoFpsDFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoInfoFpsDFieldInfo = (~) Int32
    type AttrTransferTypeConstraint VideoInfoFpsDFieldInfo = (~)Int32
    type AttrTransferType VideoInfoFpsDFieldInfo = Int32
    type AttrGetType VideoInfoFpsDFieldInfo = Int32
    type AttrLabel VideoInfoFpsDFieldInfo = "fps_d"
    type AttrOrigin VideoInfoFpsDFieldInfo = VideoInfo
    attrGet = getVideoInfoFpsD
    attrSet = setVideoInfoFpsD
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

videoInfo_fpsD :: AttrLabelProxy "fpsD"
videoInfo_fpsD = AttrLabelProxy

#endif


-- XXX Skipped attribute for "VideoInfo:offset"
-- Not implemented: Don't know how to unpack C array of type TCArray False 4 (-1) (TBasicType TUInt64)
-- XXX Skipped attribute for "VideoInfo:stride"
-- Not implemented: Don't know how to unpack C array of type TCArray False 4 (-1) (TBasicType TInt)

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList VideoInfo
type instance O.AttributeList VideoInfo = VideoInfoAttributeList
type VideoInfoAttributeList = ('[ '("finfo", VideoInfoFinfoFieldInfo), '("interlaceMode", VideoInfoInterlaceModeFieldInfo), '("flags", VideoInfoFlagsFieldInfo), '("width", VideoInfoWidthFieldInfo), '("height", VideoInfoHeightFieldInfo), '("size", VideoInfoSizeFieldInfo), '("views", VideoInfoViewsFieldInfo), '("chromaSite", VideoInfoChromaSiteFieldInfo), '("colorimetry", VideoInfoColorimetryFieldInfo), '("parN", VideoInfoParNFieldInfo), '("parD", VideoInfoParDFieldInfo), '("fpsN", VideoInfoFpsNFieldInfo), '("fpsD", VideoInfoFpsDFieldInfo)] :: [(Symbol, *)])
#endif

-- method VideoInfo::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GstVideo" , name = "VideoInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_info_new" gst_video_info_new :: 
    IO (Ptr VideoInfo)

-- | Allocate a new t'GI.GstVideo.Structs.VideoInfo.VideoInfo' that is also initialized with
-- 'GI.GstVideo.Structs.VideoInfo.videoInfoInit'.
-- 
-- /Since: 1.6/
videoInfoNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m VideoInfo
    -- ^ __Returns:__ a new t'GI.GstVideo.Structs.VideoInfo.VideoInfo'. free with 'GI.GstVideo.Structs.VideoInfo.videoInfoFree'.
videoInfoNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m VideoInfo
videoInfoNew  = 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
$ do
    Ptr VideoInfo
result <- IO (Ptr VideoInfo)
gst_video_info_new
    Text -> Ptr VideoInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"videoInfoNew" Ptr VideoInfo
result
    VideoInfo
result' <- ((ManagedPtr VideoInfo -> VideoInfo)
-> Ptr VideoInfo -> IO VideoInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr VideoInfo -> VideoInfo
VideoInfo) Ptr VideoInfo
result
    VideoInfo -> IO VideoInfo
forall (m :: * -> *) a. Monad m => a -> m a
return VideoInfo
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method VideoInfo::align
-- method type : OrdinaryMethod
-- Args: [ 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 = "align"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoAlignment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "alignment parameters"
--                 , 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_info_align" gst_video_info_align :: 
    Ptr VideoInfo ->                        -- info : TInterface (Name {namespace = "GstVideo", name = "VideoInfo"})
    Ptr GstVideo.VideoAlignment.VideoAlignment -> -- align : TInterface (Name {namespace = "GstVideo", name = "VideoAlignment"})
    IO CInt

-- | Adjust the offset and stride fields in /@info@/ so that the padding and
-- stride alignment in /@align@/ is respected.
-- 
-- Extra padding will be added to the right side when stride alignment padding
-- is required and /@align@/ will be updated with the new padding values.
videoInfoAlign ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoInfo
    -- ^ /@info@/: a t'GI.GstVideo.Structs.VideoInfo.VideoInfo'
    -> GstVideo.VideoAlignment.VideoAlignment
    -- ^ /@align@/: alignment parameters
    -> m Bool
    -- ^ __Returns:__ 'P.False' if alignment could not be applied, e.g. because the
    --   size of a frame can\'t be represented as a 32 bit integer (Since: 1.12)
videoInfoAlign :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoInfo -> VideoAlignment -> m Bool
videoInfoAlign VideoInfo
info VideoAlignment
align = 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 VideoInfo
info' <- VideoInfo -> IO (Ptr VideoInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoInfo
info
    Ptr VideoAlignment
align' <- VideoAlignment -> IO (Ptr VideoAlignment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoAlignment
align
    CInt
result <- Ptr VideoInfo -> Ptr VideoAlignment -> IO CInt
gst_video_info_align Ptr VideoInfo
info' Ptr VideoAlignment
align'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    VideoInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoInfo
info
    VideoAlignment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoAlignment
align
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoInfoAlignMethodInfo
instance (signature ~ (GstVideo.VideoAlignment.VideoAlignment -> m Bool), MonadIO m) => O.OverloadedMethod VideoInfoAlignMethodInfo VideoInfo signature where
    overloadedMethod = videoInfoAlign

instance O.OverloadedMethodInfo VideoInfoAlignMethodInfo VideoInfo where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstVideo.Structs.VideoInfo.videoInfoAlign",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.24/docs/GI-GstVideo-Structs-VideoInfo.html#v:videoInfoAlign"
        }


#endif

-- method VideoInfo::align_full
-- method type : OrdinaryMethod
-- Args: [ 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 = "align"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoAlignment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "alignment parameters"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "plane_size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "array used to store the plane sizes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_info_align_full" gst_video_info_align_full :: 
    Ptr VideoInfo ->                        -- info : TInterface (Name {namespace = "GstVideo", name = "VideoInfo"})
    Ptr GstVideo.VideoAlignment.VideoAlignment -> -- align : TInterface (Name {namespace = "GstVideo", name = "VideoAlignment"})
    Ptr Word64 ->                           -- plane_size : TBasicType TUInt64
    IO CInt

-- | This variant of 'GI.GstVideo.Structs.VideoInfo.videoInfoAlign' provides the updated size, in bytes,
-- of each video plane after the alignment, including all horizontal and vertical
-- paddings.
-- 
-- In case of GST_VIDEO_INTERLACE_MODE_ALTERNATE info, the returned sizes are the
-- ones used to hold a single field, not the full frame.
-- 
-- /Since: 1.18/
videoInfoAlignFull ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoInfo
    -- ^ /@info@/: a t'GI.GstVideo.Structs.VideoInfo.VideoInfo'
    -> GstVideo.VideoAlignment.VideoAlignment
    -- ^ /@align@/: alignment parameters
    -> m ((Bool, Word64))
    -- ^ __Returns:__ 'P.False' if alignment could not be applied, e.g. because the
    --   size of a frame can\'t be represented as a 32 bit integer
videoInfoAlignFull :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoInfo -> VideoAlignment -> m (Bool, Word64)
videoInfoAlignFull VideoInfo
info VideoAlignment
align = IO (Bool, Word64) -> m (Bool, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word64) -> m (Bool, Word64))
-> IO (Bool, Word64) -> m (Bool, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoInfo
info' <- VideoInfo -> IO (Ptr VideoInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoInfo
info
    Ptr VideoAlignment
align' <- VideoAlignment -> IO (Ptr VideoAlignment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoAlignment
align
    Ptr Word64
planeSize <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    CInt
result <- Ptr VideoInfo -> Ptr VideoAlignment -> Ptr Word64 -> IO CInt
gst_video_info_align_full Ptr VideoInfo
info' Ptr VideoAlignment
align' Ptr Word64
planeSize
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word64
planeSize' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
planeSize
    VideoInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoInfo
info
    VideoAlignment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoAlignment
align
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
planeSize
    (Bool, Word64) -> IO (Bool, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word64
planeSize')

#if defined(ENABLE_OVERLOADING)
data VideoInfoAlignFullMethodInfo
instance (signature ~ (GstVideo.VideoAlignment.VideoAlignment -> m ((Bool, Word64))), MonadIO m) => O.OverloadedMethod VideoInfoAlignFullMethodInfo VideoInfo signature where
    overloadedMethod = videoInfoAlignFull

instance O.OverloadedMethodInfo VideoInfoAlignFullMethodInfo VideoInfo where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstVideo.Structs.VideoInfo.videoInfoAlignFull",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.24/docs/GI-GstVideo-Structs-VideoInfo.html#v:videoInfoAlignFull"
        }


#endif

-- method VideoInfo::convert
-- method type : OrdinaryMethod
-- Args: [ 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 = "src_format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstFormat of the @src_value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src_value"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "value to convert" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest_format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstFormat of the @dest_value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest_value"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pointer to destination value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_info_convert" gst_video_info_convert :: 
    Ptr VideoInfo ->                        -- info : TInterface (Name {namespace = "GstVideo", name = "VideoInfo"})
    CUInt ->                                -- src_format : TInterface (Name {namespace = "Gst", name = "Format"})
    Int64 ->                                -- src_value : TBasicType TInt64
    CUInt ->                                -- dest_format : TInterface (Name {namespace = "Gst", name = "Format"})
    Ptr Int64 ->                            -- dest_value : TBasicType TInt64
    IO CInt

-- | Converts among various t'GI.Gst.Enums.Format' types.  This function handles
-- GST_FORMAT_BYTES, GST_FORMAT_TIME, and GST_FORMAT_DEFAULT.  For
-- raw video, GST_FORMAT_DEFAULT corresponds to video frames.  This
-- function can be used to handle pad queries of the type GST_QUERY_CONVERT.
videoInfoConvert ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoInfo
    -- ^ /@info@/: a t'GI.GstVideo.Structs.VideoInfo.VideoInfo'
    -> Gst.Enums.Format
    -- ^ /@srcFormat@/: t'GI.Gst.Enums.Format' of the /@srcValue@/
    -> Int64
    -- ^ /@srcValue@/: value to convert
    -> Gst.Enums.Format
    -- ^ /@destFormat@/: t'GI.Gst.Enums.Format' of the /@destValue@/
    -> m ((Bool, Int64))
    -- ^ __Returns:__ TRUE if the conversion was successful.
videoInfoConvert :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoInfo -> Format -> Int64 -> Format -> m (Bool, Int64)
videoInfoConvert VideoInfo
info Format
srcFormat Int64
srcValue Format
destFormat = IO (Bool, Int64) -> m (Bool, Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int64) -> m (Bool, Int64))
-> IO (Bool, Int64) -> m (Bool, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoInfo
info' <- VideoInfo -> IO (Ptr VideoInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoInfo
info
    let srcFormat' :: CUInt
srcFormat' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
srcFormat
    let destFormat' :: CUInt
destFormat' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
destFormat
    Ptr Int64
destValue <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    CInt
result <- Ptr VideoInfo -> CUInt -> Int64 -> CUInt -> Ptr Int64 -> IO CInt
gst_video_info_convert Ptr VideoInfo
info' CUInt
srcFormat' Int64
srcValue CUInt
destFormat' Ptr Int64
destValue
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int64
destValue' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
destValue
    VideoInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoInfo
info
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
destValue
    (Bool, Int64) -> IO (Bool, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int64
destValue')

#if defined(ENABLE_OVERLOADING)
data VideoInfoConvertMethodInfo
instance (signature ~ (Gst.Enums.Format -> Int64 -> Gst.Enums.Format -> m ((Bool, Int64))), MonadIO m) => O.OverloadedMethod VideoInfoConvertMethodInfo VideoInfo signature where
    overloadedMethod = videoInfoConvert

instance O.OverloadedMethodInfo VideoInfoConvertMethodInfo VideoInfo where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstVideo.Structs.VideoInfo.videoInfoConvert",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.24/docs/GI-GstVideo-Structs-VideoInfo.html#v:videoInfoConvert"
        }


#endif

-- method VideoInfo::copy
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GstVideo" , name = "VideoInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_info_copy" gst_video_info_copy :: 
    Ptr VideoInfo ->                        -- info : TInterface (Name {namespace = "GstVideo", name = "VideoInfo"})
    IO (Ptr VideoInfo)

-- | Copy a GstVideoInfo structure.
-- 
-- /Since: 1.6/
videoInfoCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoInfo
    -- ^ /@info@/: a t'GI.GstVideo.Structs.VideoInfo.VideoInfo'
    -> m VideoInfo
    -- ^ __Returns:__ a new t'GI.GstVideo.Structs.VideoInfo.VideoInfo'. free with gst_video_info_free.
videoInfoCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoInfo -> m VideoInfo
videoInfoCopy VideoInfo
info = 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
$ do
    Ptr VideoInfo
info' <- VideoInfo -> IO (Ptr VideoInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoInfo
info
    Ptr VideoInfo
result <- Ptr VideoInfo -> IO (Ptr VideoInfo)
gst_video_info_copy Ptr VideoInfo
info'
    Text -> Ptr VideoInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"videoInfoCopy" Ptr VideoInfo
result
    VideoInfo
result' <- ((ManagedPtr VideoInfo -> VideoInfo)
-> Ptr VideoInfo -> IO VideoInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr VideoInfo -> VideoInfo
VideoInfo) Ptr VideoInfo
result
    VideoInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoInfo
info
    VideoInfo -> IO VideoInfo
forall (m :: * -> *) a. Monad m => a -> m a
return VideoInfo
result'

#if defined(ENABLE_OVERLOADING)
data VideoInfoCopyMethodInfo
instance (signature ~ (m VideoInfo), MonadIO m) => O.OverloadedMethod VideoInfoCopyMethodInfo VideoInfo signature where
    overloadedMethod = videoInfoCopy

instance O.OverloadedMethodInfo VideoInfoCopyMethodInfo VideoInfo where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstVideo.Structs.VideoInfo.videoInfoCopy",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.24/docs/GI-GstVideo-Structs-VideoInfo.html#v:videoInfoCopy"
        }


#endif

-- method VideoInfo::free
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_info_free" gst_video_info_free :: 
    Ptr VideoInfo ->                        -- info : TInterface (Name {namespace = "GstVideo", name = "VideoInfo"})
    IO ()

-- | Free a GstVideoInfo structure previously allocated with 'GI.GstVideo.Structs.VideoInfo.videoInfoNew'
-- or 'GI.GstVideo.Structs.VideoInfo.videoInfoCopy'.
-- 
-- /Since: 1.6/
videoInfoFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoInfo
    -- ^ /@info@/: a t'GI.GstVideo.Structs.VideoInfo.VideoInfo'
    -> m ()
videoInfoFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoInfo -> m ()
videoInfoFree VideoInfo
info = 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 VideoInfo
info' <- VideoInfo -> IO (Ptr VideoInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoInfo
info
    Ptr VideoInfo -> IO ()
gst_video_info_free Ptr VideoInfo
info'
    VideoInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoInfo
info
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoInfoFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod VideoInfoFreeMethodInfo VideoInfo signature where
    overloadedMethod = videoInfoFree

instance O.OverloadedMethodInfo VideoInfoFreeMethodInfo VideoInfo where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstVideo.Structs.VideoInfo.videoInfoFree",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.24/docs/GI-GstVideo-Structs-VideoInfo.html#v:videoInfoFree"
        }


#endif

-- method VideoInfo::from_caps
-- method type : OrdinaryMethod
-- Args: [ 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 = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCaps" , 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_info_from_caps" gst_video_info_from_caps :: 
    Ptr VideoInfo ->                        -- info : TInterface (Name {namespace = "GstVideo", name = "VideoInfo"})
    Ptr Gst.Caps.Caps ->                    -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO CInt

-- | Parse /@caps@/ and update /@info@/.
videoInfoFromCaps ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoInfo
    -- ^ /@info@/: a t'GI.GstVideo.Structs.VideoInfo.VideoInfo'
    -> Gst.Caps.Caps
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps'
    -> m Bool
    -- ^ __Returns:__ TRUE if /@caps@/ could be parsed
videoInfoFromCaps :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoInfo -> Caps -> m Bool
videoInfoFromCaps VideoInfo
info Caps
caps = 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 VideoInfo
info' <- VideoInfo -> IO (Ptr VideoInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoInfo
info
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    CInt
result <- Ptr VideoInfo -> Ptr Caps -> IO CInt
gst_video_info_from_caps Ptr VideoInfo
info' Ptr Caps
caps'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    VideoInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoInfo
info
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoInfoFromCapsMethodInfo
instance (signature ~ (Gst.Caps.Caps -> m Bool), MonadIO m) => O.OverloadedMethod VideoInfoFromCapsMethodInfo VideoInfo signature where
    overloadedMethod = videoInfoFromCaps

instance O.OverloadedMethodInfo VideoInfoFromCapsMethodInfo VideoInfo where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstVideo.Structs.VideoInfo.videoInfoFromCaps",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.24/docs/GI-GstVideo-Structs-VideoInfo.html#v:videoInfoFromCaps"
        }


#endif

-- method VideoInfo::init
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_info_init" gst_video_info_init :: 
    Ptr VideoInfo ->                        -- info : TInterface (Name {namespace = "GstVideo", name = "VideoInfo"})
    IO ()

-- | Initialize /@info@/ with default values.
videoInfoInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoInfo
    -- ^ /@info@/: a t'GI.GstVideo.Structs.VideoInfo.VideoInfo'
    -> m ()
videoInfoInit :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoInfo -> m ()
videoInfoInit VideoInfo
info = 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 VideoInfo
info' <- VideoInfo -> IO (Ptr VideoInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoInfo
info
    Ptr VideoInfo -> IO ()
gst_video_info_init Ptr VideoInfo
info'
    VideoInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoInfo
info
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoInfoInitMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod VideoInfoInitMethodInfo VideoInfo signature where
    overloadedMethod = videoInfoInit

instance O.OverloadedMethodInfo VideoInfoInitMethodInfo VideoInfo where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstVideo.Structs.VideoInfo.videoInfoInit",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.24/docs/GI-GstVideo-Structs-VideoInfo.html#v:videoInfoInit"
        }


#endif

-- method VideoInfo::is_equal
-- method type : OrdinaryMethod
-- Args: [ 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 = "other"
--           , 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_info_is_equal" gst_video_info_is_equal :: 
    Ptr VideoInfo ->                        -- info : TInterface (Name {namespace = "GstVideo", name = "VideoInfo"})
    Ptr VideoInfo ->                        -- other : TInterface (Name {namespace = "GstVideo", name = "VideoInfo"})
    IO CInt

-- | Compares two t'GI.GstVideo.Structs.VideoInfo.VideoInfo' and returns whether they are equal or not
videoInfoIsEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoInfo
    -- ^ /@info@/: a t'GI.GstVideo.Structs.VideoInfo.VideoInfo'
    -> VideoInfo
    -- ^ /@other@/: a t'GI.GstVideo.Structs.VideoInfo.VideoInfo'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@info@/ and /@other@/ are equal, else 'P.False'.
videoInfoIsEqual :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoInfo -> VideoInfo -> m Bool
videoInfoIsEqual VideoInfo
info VideoInfo
other = 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 VideoInfo
info' <- VideoInfo -> IO (Ptr VideoInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoInfo
info
    Ptr VideoInfo
other' <- VideoInfo -> IO (Ptr VideoInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoInfo
other
    CInt
result <- Ptr VideoInfo -> Ptr VideoInfo -> IO CInt
gst_video_info_is_equal Ptr VideoInfo
info' Ptr VideoInfo
other'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    VideoInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoInfo
info
    VideoInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoInfo
other
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoInfoIsEqualMethodInfo
instance (signature ~ (VideoInfo -> m Bool), MonadIO m) => O.OverloadedMethod VideoInfoIsEqualMethodInfo VideoInfo signature where
    overloadedMethod = videoInfoIsEqual

instance O.OverloadedMethodInfo VideoInfoIsEqualMethodInfo VideoInfo where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstVideo.Structs.VideoInfo.videoInfoIsEqual",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.24/docs/GI-GstVideo-Structs-VideoInfo.html#v:videoInfoIsEqual"
        }


#endif

-- method VideoInfo::set_format
-- method type : OrdinaryMethod
-- Args: [ 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 = "format"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the format" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a width" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a height" , 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_info_set_format" gst_video_info_set_format :: 
    Ptr VideoInfo ->                        -- info : TInterface (Name {namespace = "GstVideo", name = "VideoInfo"})
    CUInt ->                                -- format : TInterface (Name {namespace = "GstVideo", name = "VideoFormat"})
    Word32 ->                               -- width : TBasicType TUInt
    Word32 ->                               -- height : TBasicType TUInt
    IO CInt

-- | Set the default info for a video frame of /@format@/ and /@width@/ and /@height@/.
-- 
-- Note: This initializes /@info@/ first, no values are preserved. This function
-- does not set the offsets correctly for interlaced vertically
-- subsampled formats.
videoInfoSetFormat ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoInfo
    -- ^ /@info@/: a t'GI.GstVideo.Structs.VideoInfo.VideoInfo'
    -> GstVideo.Enums.VideoFormat
    -- ^ /@format@/: the format
    -> Word32
    -- ^ /@width@/: a width
    -> Word32
    -- ^ /@height@/: a height
    -> m Bool
    -- ^ __Returns:__ 'P.False' if the returned video info is invalid, e.g. because the
    --   size of a frame can\'t be represented as a 32 bit integer (Since: 1.12)
videoInfoSetFormat :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoInfo -> VideoFormat -> Word32 -> Word32 -> m Bool
videoInfoSetFormat VideoInfo
info VideoFormat
format Word32
width Word32
height = 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 VideoInfo
info' <- VideoInfo -> IO (Ptr VideoInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoInfo
info
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (VideoFormat -> Int) -> VideoFormat -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VideoFormat -> Int
forall a. Enum a => a -> Int
fromEnum) VideoFormat
format
    CInt
result <- Ptr VideoInfo -> CUInt -> Word32 -> Word32 -> IO CInt
gst_video_info_set_format Ptr VideoInfo
info' CUInt
format' Word32
width Word32
height
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    VideoInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoInfo
info
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoInfoSetFormatMethodInfo
instance (signature ~ (GstVideo.Enums.VideoFormat -> Word32 -> Word32 -> m Bool), MonadIO m) => O.OverloadedMethod VideoInfoSetFormatMethodInfo VideoInfo signature where
    overloadedMethod = videoInfoSetFormat

instance O.OverloadedMethodInfo VideoInfoSetFormatMethodInfo VideoInfo where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstVideo.Structs.VideoInfo.videoInfoSetFormat",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.24/docs/GI-GstVideo-Structs-VideoInfo.html#v:videoInfoSetFormat"
        }


#endif

-- method VideoInfo::set_interlaced_format
-- method type : OrdinaryMethod
-- Args: [ 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 = "format"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the format" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoInterlaceMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoInterlaceMode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a width" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a height" , 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_info_set_interlaced_format" gst_video_info_set_interlaced_format :: 
    Ptr VideoInfo ->                        -- info : TInterface (Name {namespace = "GstVideo", name = "VideoInfo"})
    CUInt ->                                -- format : TInterface (Name {namespace = "GstVideo", name = "VideoFormat"})
    CUInt ->                                -- mode : TInterface (Name {namespace = "GstVideo", name = "VideoInterlaceMode"})
    Word32 ->                               -- width : TBasicType TUInt
    Word32 ->                               -- height : TBasicType TUInt
    IO CInt

-- | Same as @/gst_video_info_set_format/@ but also allowing to set the interlaced
-- mode.
-- 
-- /Since: 1.16/
videoInfoSetInterlacedFormat ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoInfo
    -- ^ /@info@/: a t'GI.GstVideo.Structs.VideoInfo.VideoInfo'
    -> GstVideo.Enums.VideoFormat
    -- ^ /@format@/: the format
    -> GstVideo.Enums.VideoInterlaceMode
    -- ^ /@mode@/: a t'GI.GstVideo.Enums.VideoInterlaceMode'
    -> Word32
    -- ^ /@width@/: a width
    -> Word32
    -- ^ /@height@/: a height
    -> m Bool
    -- ^ __Returns:__ 'P.False' if the returned video info is invalid, e.g. because the
    --   size of a frame can\'t be represented as a 32 bit integer.
videoInfoSetInterlacedFormat :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoInfo
-> VideoFormat -> VideoInterlaceMode -> Word32 -> Word32 -> m Bool
videoInfoSetInterlacedFormat VideoInfo
info VideoFormat
format VideoInterlaceMode
mode Word32
width Word32
height = 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 VideoInfo
info' <- VideoInfo -> IO (Ptr VideoInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoInfo
info
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (VideoFormat -> Int) -> VideoFormat -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VideoFormat -> Int
forall a. Enum a => a -> Int
fromEnum) VideoFormat
format
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (VideoInterlaceMode -> Int) -> VideoInterlaceMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VideoInterlaceMode -> Int
forall a. Enum a => a -> Int
fromEnum) VideoInterlaceMode
mode
    CInt
result <- Ptr VideoInfo -> CUInt -> CUInt -> Word32 -> Word32 -> IO CInt
gst_video_info_set_interlaced_format Ptr VideoInfo
info' CUInt
format' CUInt
mode' Word32
width Word32
height
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    VideoInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoInfo
info
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoInfoSetInterlacedFormatMethodInfo
instance (signature ~ (GstVideo.Enums.VideoFormat -> GstVideo.Enums.VideoInterlaceMode -> Word32 -> Word32 -> m Bool), MonadIO m) => O.OverloadedMethod VideoInfoSetInterlacedFormatMethodInfo VideoInfo signature where
    overloadedMethod = videoInfoSetInterlacedFormat

instance O.OverloadedMethodInfo VideoInfoSetInterlacedFormatMethodInfo VideoInfo where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstVideo.Structs.VideoInfo.videoInfoSetInterlacedFormat",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.24/docs/GI-GstVideo-Structs-VideoInfo.html#v:videoInfoSetInterlacedFormat"
        }


#endif

-- method VideoInfo::to_caps
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Caps" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_info_to_caps" gst_video_info_to_caps :: 
    Ptr VideoInfo ->                        -- info : TInterface (Name {namespace = "GstVideo", name = "VideoInfo"})
    IO (Ptr Gst.Caps.Caps)

-- | Convert the values of /@info@/ into a t'GI.Gst.Structs.Caps.Caps'.
videoInfoToCaps ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoInfo
    -- ^ /@info@/: a t'GI.GstVideo.Structs.VideoInfo.VideoInfo'
    -> m Gst.Caps.Caps
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Caps.Caps' containing the info of /@info@/.
videoInfoToCaps :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoInfo -> m Caps
videoInfoToCaps VideoInfo
info = IO Caps -> m Caps
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Caps -> m Caps) -> IO Caps -> m Caps
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoInfo
info' <- VideoInfo -> IO (Ptr VideoInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoInfo
info
    Ptr Caps
result <- Ptr VideoInfo -> IO (Ptr Caps)
gst_video_info_to_caps Ptr VideoInfo
info'
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"videoInfoToCaps" Ptr Caps
result
    Caps
result' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Gst.Caps.Caps) Ptr Caps
result
    VideoInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoInfo
info
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
data VideoInfoToCapsMethodInfo
instance (signature ~ (m Gst.Caps.Caps), MonadIO m) => O.OverloadedMethod VideoInfoToCapsMethodInfo VideoInfo signature where
    overloadedMethod = videoInfoToCaps

instance O.OverloadedMethodInfo VideoInfoToCapsMethodInfo VideoInfo where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstVideo.Structs.VideoInfo.videoInfoToCaps",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.24/docs/GI-GstVideo-Structs-VideoInfo.html#v:videoInfoToCaps"
        }


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveVideoInfoMethod (t :: Symbol) (o :: *) :: * where
    ResolveVideoInfoMethod "align" o = VideoInfoAlignMethodInfo
    ResolveVideoInfoMethod "alignFull" o = VideoInfoAlignFullMethodInfo
    ResolveVideoInfoMethod "convert" o = VideoInfoConvertMethodInfo
    ResolveVideoInfoMethod "copy" o = VideoInfoCopyMethodInfo
    ResolveVideoInfoMethod "free" o = VideoInfoFreeMethodInfo
    ResolveVideoInfoMethod "fromCaps" o = VideoInfoFromCapsMethodInfo
    ResolveVideoInfoMethod "init" o = VideoInfoInitMethodInfo
    ResolveVideoInfoMethod "isEqual" o = VideoInfoIsEqualMethodInfo
    ResolveVideoInfoMethod "toCaps" o = VideoInfoToCapsMethodInfo
    ResolveVideoInfoMethod "setFormat" o = VideoInfoSetFormatMethodInfo
    ResolveVideoInfoMethod "setInterlacedFormat" o = VideoInfoSetInterlacedFormatMethodInfo
    ResolveVideoInfoMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif