{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)

Information for a video format.
-}

module GI.GstVideo.Structs.VideoFormatInfo
    ( 

-- * Exported types
    VideoFormatInfo(..)                     ,
    newZeroVideoFormatInfo                  ,
    noVideoFormatInfo                       ,


 -- * Properties
-- ** bits #attr:bits#
    getVideoFormatInfoBits                  ,
    setVideoFormatInfoBits                  ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoFormatInfo_bits                    ,
#endif


-- ** description #attr:description#
    clearVideoFormatInfoDescription         ,
    getVideoFormatInfoDescription           ,
    setVideoFormatInfoDescription           ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoFormatInfo_description             ,
#endif


-- ** flags #attr:flags#
    getVideoFormatInfoFlags                 ,
    setVideoFormatInfoFlags                 ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoFormatInfo_flags                   ,
#endif


-- ** format #attr:format#
    getVideoFormatInfoFormat                ,
    setVideoFormatInfoFormat                ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoFormatInfo_format                  ,
#endif


-- ** nComponents #attr:nComponents#
    getVideoFormatInfoNComponents           ,
    setVideoFormatInfoNComponents           ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoFormatInfo_nComponents             ,
#endif


-- ** nPlanes #attr:nPlanes#
    getVideoFormatInfoNPlanes               ,
    setVideoFormatInfoNPlanes               ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoFormatInfo_nPlanes                 ,
#endif


-- ** name #attr:name#
    clearVideoFormatInfoName                ,
    getVideoFormatInfoName                  ,
    setVideoFormatInfoName                  ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoFormatInfo_name                    ,
#endif


-- ** packFunc #attr:packFunc#
    clearVideoFormatInfoPackFunc            ,
    getVideoFormatInfoPackFunc              ,
    setVideoFormatInfoPackFunc              ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoFormatInfo_packFunc                ,
#endif


-- ** packLines #attr:packLines#
    getVideoFormatInfoPackLines             ,
    setVideoFormatInfoPackLines             ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoFormatInfo_packLines               ,
#endif


-- ** tileHs #attr:tileHs#
    getVideoFormatInfoTileHs                ,
    setVideoFormatInfoTileHs                ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoFormatInfo_tileHs                  ,
#endif


-- ** tileMode #attr:tileMode#
    getVideoFormatInfoTileMode              ,
    setVideoFormatInfoTileMode              ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoFormatInfo_tileMode                ,
#endif


-- ** tileWs #attr:tileWs#
    getVideoFormatInfoTileWs                ,
    setVideoFormatInfoTileWs                ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoFormatInfo_tileWs                  ,
#endif


-- ** unpackFormat #attr:unpackFormat#
    getVideoFormatInfoUnpackFormat          ,
    setVideoFormatInfoUnpackFormat          ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoFormatInfo_unpackFormat            ,
#endif


-- ** unpackFunc #attr:unpackFunc#
    clearVideoFormatInfoUnpackFunc          ,
    getVideoFormatInfoUnpackFunc            ,
    setVideoFormatInfoUnpackFunc            ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoFormatInfo_unpackFunc              ,
#endif




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
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 GI.GstVideo.Callbacks as GstVideo.Callbacks
import {-# SOURCE #-} qualified GI.GstVideo.Enums as GstVideo.Enums
import {-# SOURCE #-} qualified GI.GstVideo.Flags as GstVideo.Flags

newtype VideoFormatInfo = VideoFormatInfo (ManagedPtr VideoFormatInfo)
instance WrappedPtr VideoFormatInfo where
    wrappedPtrCalloc = callocBytes 232
    wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 232 >=> wrapPtr VideoFormatInfo)
    wrappedPtrFree = Just ptr_to_g_free

-- | Construct a `VideoFormatInfo` struct initialized to zero.
newZeroVideoFormatInfo :: MonadIO m => m VideoFormatInfo
newZeroVideoFormatInfo = liftIO $ wrappedPtrCalloc >>= wrapPtr VideoFormatInfo

instance tag ~ 'AttrSet => Constructible VideoFormatInfo tag where
    new _ attrs = do
        o <- newZeroVideoFormatInfo
        GI.Attributes.set o attrs
        return o


noVideoFormatInfo :: Maybe VideoFormatInfo
noVideoFormatInfo = Nothing

getVideoFormatInfoFormat :: MonadIO m => VideoFormatInfo -> m GstVideo.Enums.VideoFormat
getVideoFormatInfoFormat s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO CUInt
    let val' = (toEnum . fromIntegral) val
    return val'

setVideoFormatInfoFormat :: MonadIO m => VideoFormatInfo -> GstVideo.Enums.VideoFormat -> m ()
setVideoFormatInfoFormat s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = (fromIntegral . fromEnum) val
    poke (ptr `plusPtr` 0) (val' :: CUInt)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoFormatInfoFormatFieldInfo
instance AttrInfo VideoFormatInfoFormatFieldInfo where
    type AttrAllowedOps VideoFormatInfoFormatFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoFormatInfoFormatFieldInfo = (~) GstVideo.Enums.VideoFormat
    type AttrBaseTypeConstraint VideoFormatInfoFormatFieldInfo = (~) VideoFormatInfo
    type AttrGetType VideoFormatInfoFormatFieldInfo = GstVideo.Enums.VideoFormat
    type AttrLabel VideoFormatInfoFormatFieldInfo = "format"
    type AttrOrigin VideoFormatInfoFormatFieldInfo = VideoFormatInfo
    attrGet _ = getVideoFormatInfoFormat
    attrSet _ = setVideoFormatInfoFormat
    attrConstruct = undefined
    attrClear _ = undefined

videoFormatInfo_format :: AttrLabelProxy "format"
videoFormatInfo_format = AttrLabelProxy

#endif


getVideoFormatInfoName :: MonadIO m => VideoFormatInfo -> m (Maybe T.Text)
getVideoFormatInfoName s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO CString
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- cstringToText val'
        return val''
    return result

setVideoFormatInfoName :: MonadIO m => VideoFormatInfo -> CString -> m ()
setVideoFormatInfoName s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (val :: CString)

clearVideoFormatInfoName :: MonadIO m => VideoFormatInfo -> m ()
clearVideoFormatInfoName s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoFormatInfoNameFieldInfo
instance AttrInfo VideoFormatInfoNameFieldInfo where
    type AttrAllowedOps VideoFormatInfoNameFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint VideoFormatInfoNameFieldInfo = (~) CString
    type AttrBaseTypeConstraint VideoFormatInfoNameFieldInfo = (~) VideoFormatInfo
    type AttrGetType VideoFormatInfoNameFieldInfo = Maybe T.Text
    type AttrLabel VideoFormatInfoNameFieldInfo = "name"
    type AttrOrigin VideoFormatInfoNameFieldInfo = VideoFormatInfo
    attrGet _ = getVideoFormatInfoName
    attrSet _ = setVideoFormatInfoName
    attrConstruct = undefined
    attrClear _ = clearVideoFormatInfoName

videoFormatInfo_name :: AttrLabelProxy "name"
videoFormatInfo_name = AttrLabelProxy

#endif


getVideoFormatInfoDescription :: MonadIO m => VideoFormatInfo -> m (Maybe T.Text)
getVideoFormatInfoDescription s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 16) :: IO CString
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- cstringToText val'
        return val''
    return result

setVideoFormatInfoDescription :: MonadIO m => VideoFormatInfo -> CString -> m ()
setVideoFormatInfoDescription s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (val :: CString)

clearVideoFormatInfoDescription :: MonadIO m => VideoFormatInfo -> m ()
clearVideoFormatInfoDescription s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoFormatInfoDescriptionFieldInfo
instance AttrInfo VideoFormatInfoDescriptionFieldInfo where
    type AttrAllowedOps VideoFormatInfoDescriptionFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint VideoFormatInfoDescriptionFieldInfo = (~) CString
    type AttrBaseTypeConstraint VideoFormatInfoDescriptionFieldInfo = (~) VideoFormatInfo
    type AttrGetType VideoFormatInfoDescriptionFieldInfo = Maybe T.Text
    type AttrLabel VideoFormatInfoDescriptionFieldInfo = "description"
    type AttrOrigin VideoFormatInfoDescriptionFieldInfo = VideoFormatInfo
    attrGet _ = getVideoFormatInfoDescription
    attrSet _ = setVideoFormatInfoDescription
    attrConstruct = undefined
    attrClear _ = clearVideoFormatInfoDescription

videoFormatInfo_description :: AttrLabelProxy "description"
videoFormatInfo_description = AttrLabelProxy

#endif


getVideoFormatInfoFlags :: MonadIO m => VideoFormatInfo -> m [GstVideo.Flags.VideoFormatFlags]
getVideoFormatInfoFlags s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 24) :: IO CUInt
    let val' = wordToGFlags val
    return val'

setVideoFormatInfoFlags :: MonadIO m => VideoFormatInfo -> [GstVideo.Flags.VideoFormatFlags] -> m ()
setVideoFormatInfoFlags s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = gflagsToWord val
    poke (ptr `plusPtr` 24) (val' :: CUInt)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoFormatInfoFlagsFieldInfo
instance AttrInfo VideoFormatInfoFlagsFieldInfo where
    type AttrAllowedOps VideoFormatInfoFlagsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoFormatInfoFlagsFieldInfo = (~) [GstVideo.Flags.VideoFormatFlags]
    type AttrBaseTypeConstraint VideoFormatInfoFlagsFieldInfo = (~) VideoFormatInfo
    type AttrGetType VideoFormatInfoFlagsFieldInfo = [GstVideo.Flags.VideoFormatFlags]
    type AttrLabel VideoFormatInfoFlagsFieldInfo = "flags"
    type AttrOrigin VideoFormatInfoFlagsFieldInfo = VideoFormatInfo
    attrGet _ = getVideoFormatInfoFlags
    attrSet _ = setVideoFormatInfoFlags
    attrConstruct = undefined
    attrClear _ = undefined

videoFormatInfo_flags :: AttrLabelProxy "flags"
videoFormatInfo_flags = AttrLabelProxy

#endif


getVideoFormatInfoBits :: MonadIO m => VideoFormatInfo -> m Word32
getVideoFormatInfoBits s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 28) :: IO Word32
    return val

setVideoFormatInfoBits :: MonadIO m => VideoFormatInfo -> Word32 -> m ()
setVideoFormatInfoBits s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 28) (val :: Word32)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoFormatInfoBitsFieldInfo
instance AttrInfo VideoFormatInfoBitsFieldInfo where
    type AttrAllowedOps VideoFormatInfoBitsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoFormatInfoBitsFieldInfo = (~) Word32
    type AttrBaseTypeConstraint VideoFormatInfoBitsFieldInfo = (~) VideoFormatInfo
    type AttrGetType VideoFormatInfoBitsFieldInfo = Word32
    type AttrLabel VideoFormatInfoBitsFieldInfo = "bits"
    type AttrOrigin VideoFormatInfoBitsFieldInfo = VideoFormatInfo
    attrGet _ = getVideoFormatInfoBits
    attrSet _ = setVideoFormatInfoBits
    attrConstruct = undefined
    attrClear _ = undefined

videoFormatInfo_bits :: AttrLabelProxy "bits"
videoFormatInfo_bits = AttrLabelProxy

#endif


getVideoFormatInfoNComponents :: MonadIO m => VideoFormatInfo -> m Word32
getVideoFormatInfoNComponents s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 32) :: IO Word32
    return val

setVideoFormatInfoNComponents :: MonadIO m => VideoFormatInfo -> Word32 -> m ()
setVideoFormatInfoNComponents s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 32) (val :: Word32)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoFormatInfoNComponentsFieldInfo
instance AttrInfo VideoFormatInfoNComponentsFieldInfo where
    type AttrAllowedOps VideoFormatInfoNComponentsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoFormatInfoNComponentsFieldInfo = (~) Word32
    type AttrBaseTypeConstraint VideoFormatInfoNComponentsFieldInfo = (~) VideoFormatInfo
    type AttrGetType VideoFormatInfoNComponentsFieldInfo = Word32
    type AttrLabel VideoFormatInfoNComponentsFieldInfo = "n_components"
    type AttrOrigin VideoFormatInfoNComponentsFieldInfo = VideoFormatInfo
    attrGet _ = getVideoFormatInfoNComponents
    attrSet _ = setVideoFormatInfoNComponents
    attrConstruct = undefined
    attrClear _ = undefined

videoFormatInfo_nComponents :: AttrLabelProxy "nComponents"
videoFormatInfo_nComponents = AttrLabelProxy

#endif


-- XXX Skipped attribute for "VideoFormatInfo:shift" :: Not implemented: "Don't know how to unpack C array of type TCArray False 4 (-1) (TBasicType TUInt)"
-- XXX Skipped attribute for "VideoFormatInfo:depth" :: Not implemented: "Don't know how to unpack C array of type TCArray False 4 (-1) (TBasicType TUInt)"
-- XXX Skipped attribute for "VideoFormatInfo:pixel_stride" :: Not implemented: "Don't know how to unpack C array of type TCArray False 4 (-1) (TBasicType TInt)"
getVideoFormatInfoNPlanes :: MonadIO m => VideoFormatInfo -> m Word32
getVideoFormatInfoNPlanes s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 84) :: IO Word32
    return val

setVideoFormatInfoNPlanes :: MonadIO m => VideoFormatInfo -> Word32 -> m ()
setVideoFormatInfoNPlanes s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 84) (val :: Word32)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoFormatInfoNPlanesFieldInfo
instance AttrInfo VideoFormatInfoNPlanesFieldInfo where
    type AttrAllowedOps VideoFormatInfoNPlanesFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoFormatInfoNPlanesFieldInfo = (~) Word32
    type AttrBaseTypeConstraint VideoFormatInfoNPlanesFieldInfo = (~) VideoFormatInfo
    type AttrGetType VideoFormatInfoNPlanesFieldInfo = Word32
    type AttrLabel VideoFormatInfoNPlanesFieldInfo = "n_planes"
    type AttrOrigin VideoFormatInfoNPlanesFieldInfo = VideoFormatInfo
    attrGet _ = getVideoFormatInfoNPlanes
    attrSet _ = setVideoFormatInfoNPlanes
    attrConstruct = undefined
    attrClear _ = undefined

videoFormatInfo_nPlanes :: AttrLabelProxy "nPlanes"
videoFormatInfo_nPlanes = AttrLabelProxy

#endif


-- XXX Skipped attribute for "VideoFormatInfo:plane" :: Not implemented: "Don't know how to unpack C array of type TCArray False 4 (-1) (TBasicType TUInt)"
-- XXX Skipped attribute for "VideoFormatInfo:poffset" :: Not implemented: "Don't know how to unpack C array of type TCArray False 4 (-1) (TBasicType TUInt)"
-- XXX Skipped attribute for "VideoFormatInfo:w_sub" :: Not implemented: "Don't know how to unpack C array of type TCArray False 4 (-1) (TBasicType TUInt)"
-- XXX Skipped attribute for "VideoFormatInfo:h_sub" :: Not implemented: "Don't know how to unpack C array of type TCArray False 4 (-1) (TBasicType TUInt)"
getVideoFormatInfoUnpackFormat :: MonadIO m => VideoFormatInfo -> m GstVideo.Enums.VideoFormat
getVideoFormatInfoUnpackFormat s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 152) :: IO CUInt
    let val' = (toEnum . fromIntegral) val
    return val'

setVideoFormatInfoUnpackFormat :: MonadIO m => VideoFormatInfo -> GstVideo.Enums.VideoFormat -> m ()
setVideoFormatInfoUnpackFormat s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = (fromIntegral . fromEnum) val
    poke (ptr `plusPtr` 152) (val' :: CUInt)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoFormatInfoUnpackFormatFieldInfo
instance AttrInfo VideoFormatInfoUnpackFormatFieldInfo where
    type AttrAllowedOps VideoFormatInfoUnpackFormatFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoFormatInfoUnpackFormatFieldInfo = (~) GstVideo.Enums.VideoFormat
    type AttrBaseTypeConstraint VideoFormatInfoUnpackFormatFieldInfo = (~) VideoFormatInfo
    type AttrGetType VideoFormatInfoUnpackFormatFieldInfo = GstVideo.Enums.VideoFormat
    type AttrLabel VideoFormatInfoUnpackFormatFieldInfo = "unpack_format"
    type AttrOrigin VideoFormatInfoUnpackFormatFieldInfo = VideoFormatInfo
    attrGet _ = getVideoFormatInfoUnpackFormat
    attrSet _ = setVideoFormatInfoUnpackFormat
    attrConstruct = undefined
    attrClear _ = undefined

videoFormatInfo_unpackFormat :: AttrLabelProxy "unpackFormat"
videoFormatInfo_unpackFormat = AttrLabelProxy

#endif


getVideoFormatInfoUnpackFunc :: MonadIO m => VideoFormatInfo -> m (Maybe GstVideo.Callbacks.VideoFormatUnpack)
getVideoFormatInfoUnpackFunc s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 160) :: IO (FunPtr GstVideo.Callbacks.C_VideoFormatUnpack)
    result <- SP.convertFunPtrIfNonNull val $ \val' -> do
        let val'' = GstVideo.Callbacks.dynamic_VideoFormatUnpack val'
        return val''
    return result

setVideoFormatInfoUnpackFunc :: MonadIO m => VideoFormatInfo -> FunPtr GstVideo.Callbacks.C_VideoFormatUnpack -> m ()
setVideoFormatInfoUnpackFunc s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 160) (val :: FunPtr GstVideo.Callbacks.C_VideoFormatUnpack)

clearVideoFormatInfoUnpackFunc :: MonadIO m => VideoFormatInfo -> m ()
clearVideoFormatInfoUnpackFunc s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 160) (FP.nullFunPtr :: FunPtr GstVideo.Callbacks.C_VideoFormatUnpack)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoFormatInfoUnpackFuncFieldInfo
instance AttrInfo VideoFormatInfoUnpackFuncFieldInfo where
    type AttrAllowedOps VideoFormatInfoUnpackFuncFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint VideoFormatInfoUnpackFuncFieldInfo = (~) (FunPtr GstVideo.Callbacks.C_VideoFormatUnpack)
    type AttrBaseTypeConstraint VideoFormatInfoUnpackFuncFieldInfo = (~) VideoFormatInfo
    type AttrGetType VideoFormatInfoUnpackFuncFieldInfo = Maybe GstVideo.Callbacks.VideoFormatUnpack
    type AttrLabel VideoFormatInfoUnpackFuncFieldInfo = "unpack_func"
    type AttrOrigin VideoFormatInfoUnpackFuncFieldInfo = VideoFormatInfo
    attrGet _ = getVideoFormatInfoUnpackFunc
    attrSet _ = setVideoFormatInfoUnpackFunc
    attrConstruct = undefined
    attrClear _ = clearVideoFormatInfoUnpackFunc

videoFormatInfo_unpackFunc :: AttrLabelProxy "unpackFunc"
videoFormatInfo_unpackFunc = AttrLabelProxy

#endif


getVideoFormatInfoPackLines :: MonadIO m => VideoFormatInfo -> m Int32
getVideoFormatInfoPackLines s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 168) :: IO Int32
    return val

setVideoFormatInfoPackLines :: MonadIO m => VideoFormatInfo -> Int32 -> m ()
setVideoFormatInfoPackLines s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 168) (val :: Int32)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoFormatInfoPackLinesFieldInfo
instance AttrInfo VideoFormatInfoPackLinesFieldInfo where
    type AttrAllowedOps VideoFormatInfoPackLinesFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoFormatInfoPackLinesFieldInfo = (~) Int32
    type AttrBaseTypeConstraint VideoFormatInfoPackLinesFieldInfo = (~) VideoFormatInfo
    type AttrGetType VideoFormatInfoPackLinesFieldInfo = Int32
    type AttrLabel VideoFormatInfoPackLinesFieldInfo = "pack_lines"
    type AttrOrigin VideoFormatInfoPackLinesFieldInfo = VideoFormatInfo
    attrGet _ = getVideoFormatInfoPackLines
    attrSet _ = setVideoFormatInfoPackLines
    attrConstruct = undefined
    attrClear _ = undefined

videoFormatInfo_packLines :: AttrLabelProxy "packLines"
videoFormatInfo_packLines = AttrLabelProxy

#endif


getVideoFormatInfoPackFunc :: MonadIO m => VideoFormatInfo -> m (Maybe GstVideo.Callbacks.VideoFormatPack)
getVideoFormatInfoPackFunc s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 176) :: IO (FunPtr GstVideo.Callbacks.C_VideoFormatPack)
    result <- SP.convertFunPtrIfNonNull val $ \val' -> do
        let val'' = GstVideo.Callbacks.dynamic_VideoFormatPack val'
        return val''
    return result

setVideoFormatInfoPackFunc :: MonadIO m => VideoFormatInfo -> FunPtr GstVideo.Callbacks.C_VideoFormatPack -> m ()
setVideoFormatInfoPackFunc s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 176) (val :: FunPtr GstVideo.Callbacks.C_VideoFormatPack)

clearVideoFormatInfoPackFunc :: MonadIO m => VideoFormatInfo -> m ()
clearVideoFormatInfoPackFunc s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 176) (FP.nullFunPtr :: FunPtr GstVideo.Callbacks.C_VideoFormatPack)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoFormatInfoPackFuncFieldInfo
instance AttrInfo VideoFormatInfoPackFuncFieldInfo where
    type AttrAllowedOps VideoFormatInfoPackFuncFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint VideoFormatInfoPackFuncFieldInfo = (~) (FunPtr GstVideo.Callbacks.C_VideoFormatPack)
    type AttrBaseTypeConstraint VideoFormatInfoPackFuncFieldInfo = (~) VideoFormatInfo
    type AttrGetType VideoFormatInfoPackFuncFieldInfo = Maybe GstVideo.Callbacks.VideoFormatPack
    type AttrLabel VideoFormatInfoPackFuncFieldInfo = "pack_func"
    type AttrOrigin VideoFormatInfoPackFuncFieldInfo = VideoFormatInfo
    attrGet _ = getVideoFormatInfoPackFunc
    attrSet _ = setVideoFormatInfoPackFunc
    attrConstruct = undefined
    attrClear _ = clearVideoFormatInfoPackFunc

videoFormatInfo_packFunc :: AttrLabelProxy "packFunc"
videoFormatInfo_packFunc = AttrLabelProxy

#endif


getVideoFormatInfoTileMode :: MonadIO m => VideoFormatInfo -> m GstVideo.Enums.VideoTileMode
getVideoFormatInfoTileMode s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 184) :: IO CUInt
    let val' = (toEnum . fromIntegral) val
    return val'

setVideoFormatInfoTileMode :: MonadIO m => VideoFormatInfo -> GstVideo.Enums.VideoTileMode -> m ()
setVideoFormatInfoTileMode s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = (fromIntegral . fromEnum) val
    poke (ptr `plusPtr` 184) (val' :: CUInt)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoFormatInfoTileModeFieldInfo
instance AttrInfo VideoFormatInfoTileModeFieldInfo where
    type AttrAllowedOps VideoFormatInfoTileModeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoFormatInfoTileModeFieldInfo = (~) GstVideo.Enums.VideoTileMode
    type AttrBaseTypeConstraint VideoFormatInfoTileModeFieldInfo = (~) VideoFormatInfo
    type AttrGetType VideoFormatInfoTileModeFieldInfo = GstVideo.Enums.VideoTileMode
    type AttrLabel VideoFormatInfoTileModeFieldInfo = "tile_mode"
    type AttrOrigin VideoFormatInfoTileModeFieldInfo = VideoFormatInfo
    attrGet _ = getVideoFormatInfoTileMode
    attrSet _ = setVideoFormatInfoTileMode
    attrConstruct = undefined
    attrClear _ = undefined

videoFormatInfo_tileMode :: AttrLabelProxy "tileMode"
videoFormatInfo_tileMode = AttrLabelProxy

#endif


getVideoFormatInfoTileWs :: MonadIO m => VideoFormatInfo -> m Word32
getVideoFormatInfoTileWs s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 188) :: IO Word32
    return val

setVideoFormatInfoTileWs :: MonadIO m => VideoFormatInfo -> Word32 -> m ()
setVideoFormatInfoTileWs s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 188) (val :: Word32)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoFormatInfoTileWsFieldInfo
instance AttrInfo VideoFormatInfoTileWsFieldInfo where
    type AttrAllowedOps VideoFormatInfoTileWsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoFormatInfoTileWsFieldInfo = (~) Word32
    type AttrBaseTypeConstraint VideoFormatInfoTileWsFieldInfo = (~) VideoFormatInfo
    type AttrGetType VideoFormatInfoTileWsFieldInfo = Word32
    type AttrLabel VideoFormatInfoTileWsFieldInfo = "tile_ws"
    type AttrOrigin VideoFormatInfoTileWsFieldInfo = VideoFormatInfo
    attrGet _ = getVideoFormatInfoTileWs
    attrSet _ = setVideoFormatInfoTileWs
    attrConstruct = undefined
    attrClear _ = undefined

videoFormatInfo_tileWs :: AttrLabelProxy "tileWs"
videoFormatInfo_tileWs = AttrLabelProxy

#endif


getVideoFormatInfoTileHs :: MonadIO m => VideoFormatInfo -> m Word32
getVideoFormatInfoTileHs s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 192) :: IO Word32
    return val

setVideoFormatInfoTileHs :: MonadIO m => VideoFormatInfo -> Word32 -> m ()
setVideoFormatInfoTileHs s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 192) (val :: Word32)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoFormatInfoTileHsFieldInfo
instance AttrInfo VideoFormatInfoTileHsFieldInfo where
    type AttrAllowedOps VideoFormatInfoTileHsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoFormatInfoTileHsFieldInfo = (~) Word32
    type AttrBaseTypeConstraint VideoFormatInfoTileHsFieldInfo = (~) VideoFormatInfo
    type AttrGetType VideoFormatInfoTileHsFieldInfo = Word32
    type AttrLabel VideoFormatInfoTileHsFieldInfo = "tile_hs"
    type AttrOrigin VideoFormatInfoTileHsFieldInfo = VideoFormatInfo
    attrGet _ = getVideoFormatInfoTileHs
    attrSet _ = setVideoFormatInfoTileHs
    attrConstruct = undefined
    attrClear _ = undefined

videoFormatInfo_tileHs :: AttrLabelProxy "tileHs"
videoFormatInfo_tileHs = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
instance O.HasAttributeList VideoFormatInfo
type instance O.AttributeList VideoFormatInfo = VideoFormatInfoAttributeList
type VideoFormatInfoAttributeList = ('[ '("format", VideoFormatInfoFormatFieldInfo), '("name", VideoFormatInfoNameFieldInfo), '("description", VideoFormatInfoDescriptionFieldInfo), '("flags", VideoFormatInfoFlagsFieldInfo), '("bits", VideoFormatInfoBitsFieldInfo), '("nComponents", VideoFormatInfoNComponentsFieldInfo), '("nPlanes", VideoFormatInfoNPlanesFieldInfo), '("unpackFormat", VideoFormatInfoUnpackFormatFieldInfo), '("unpackFunc", VideoFormatInfoUnpackFuncFieldInfo), '("packLines", VideoFormatInfoPackLinesFieldInfo), '("packFunc", VideoFormatInfoPackFuncFieldInfo), '("tileMode", VideoFormatInfoTileModeFieldInfo), '("tileWs", VideoFormatInfoTileWsFieldInfo), '("tileHs", VideoFormatInfoTileHsFieldInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
type family ResolveVideoFormatInfoMethod (t :: Symbol) (o :: *) :: * where
    ResolveVideoFormatInfoMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveVideoFormatInfoMethod t VideoFormatInfo, O.MethodInfo info VideoFormatInfo p) => O.IsLabelProxy t (VideoFormatInfo -> p) where
    fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)

#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolveVideoFormatInfoMethod t VideoFormatInfo, O.MethodInfo info VideoFormatInfo p) => O.IsLabel t (VideoFormatInfo -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#else
    fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#endif
#endif

#endif