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

Structure representing the state of an incoming or outgoing video
stream for encoders and decoders.

Decoders and encoders will receive such a state through their
respective /@setFormat@/ vmethods.

Decoders and encoders can set the downstream state, by using the
/@gstVideoDecoderSetOutputState@/() or
/@gstVideoEncoderSetOutputState@/() methods.
-}

module GI.GstVideo.Structs.VideoCodecState
    ( 

-- * Exported types
    VideoCodecState(..)                     ,
    newZeroVideoCodecState                  ,
    noVideoCodecState                       ,


 -- * Methods
-- ** ref #method:ref#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    VideoCodecStateRefMethodInfo            ,
#endif
    videoCodecStateRef                      ,


-- ** unref #method:unref#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    VideoCodecStateUnrefMethodInfo          ,
#endif
    videoCodecStateUnref                    ,




 -- * Properties
-- ** allocationCaps #attr:allocationCaps#
    clearVideoCodecStateAllocationCaps      ,
    getVideoCodecStateAllocationCaps        ,
    setVideoCodecStateAllocationCaps        ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoCodecState_allocationCaps          ,
#endif


-- ** caps #attr:caps#
    clearVideoCodecStateCaps                ,
    getVideoCodecStateCaps                  ,
    setVideoCodecStateCaps                  ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoCodecState_caps                    ,
#endif


-- ** codecData #attr:codecData#
    clearVideoCodecStateCodecData           ,
    getVideoCodecStateCodecData             ,
    setVideoCodecStateCodecData             ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoCodecState_codecData               ,
#endif


-- ** info #attr:info#
    getVideoCodecStateInfo                  ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoCodecState_info                    ,
#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.Gst.Structs.Buffer as Gst.Buffer
import qualified GI.Gst.Structs.Caps as Gst.Caps
import {-# SOURCE #-} qualified GI.GstVideo.Structs.VideoInfo as GstVideo.VideoInfo

newtype VideoCodecState = VideoCodecState (ManagedPtr VideoCodecState)
foreign import ccall "gst_video_codec_state_get_type" c_gst_video_codec_state_get_type :: 
    IO GType

instance BoxedObject VideoCodecState where
    boxedType _ = c_gst_video_codec_state_get_type

-- | Construct a `VideoCodecState` struct initialized to zero.
newZeroVideoCodecState :: MonadIO m => m VideoCodecState
newZeroVideoCodecState = liftIO $ callocBoxedBytes 304 >>= wrapBoxed VideoCodecState

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


noVideoCodecState :: Maybe VideoCodecState
noVideoCodecState = Nothing

getVideoCodecStateInfo :: MonadIO m => VideoCodecState -> m GstVideo.VideoInfo.VideoInfo
getVideoCodecStateInfo s = liftIO $ withManagedPtr s $ \ptr -> do
    let val = ptr `plusPtr` 8 :: (Ptr GstVideo.VideoInfo.VideoInfo)
    val' <- (newBoxed GstVideo.VideoInfo.VideoInfo) val
    return val'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoCodecStateInfoFieldInfo
instance AttrInfo VideoCodecStateInfoFieldInfo where
    type AttrAllowedOps VideoCodecStateInfoFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint VideoCodecStateInfoFieldInfo = (~) (Ptr GstVideo.VideoInfo.VideoInfo)
    type AttrBaseTypeConstraint VideoCodecStateInfoFieldInfo = (~) VideoCodecState
    type AttrGetType VideoCodecStateInfoFieldInfo = GstVideo.VideoInfo.VideoInfo
    type AttrLabel VideoCodecStateInfoFieldInfo = "info"
    type AttrOrigin VideoCodecStateInfoFieldInfo = VideoCodecState
    attrGet _ = getVideoCodecStateInfo
    attrSet _ = undefined
    attrConstruct = undefined
    attrClear _ = undefined

videoCodecState_info :: AttrLabelProxy "info"
videoCodecState_info = AttrLabelProxy

#endif


getVideoCodecStateCaps :: MonadIO m => VideoCodecState -> m (Maybe Gst.Caps.Caps)
getVideoCodecStateCaps s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 128) :: IO (Ptr Gst.Caps.Caps)
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- (newBoxed Gst.Caps.Caps) val'
        return val''
    return result

setVideoCodecStateCaps :: MonadIO m => VideoCodecState -> Ptr Gst.Caps.Caps -> m ()
setVideoCodecStateCaps s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 128) (val :: Ptr Gst.Caps.Caps)

clearVideoCodecStateCaps :: MonadIO m => VideoCodecState -> m ()
clearVideoCodecStateCaps s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 128) (FP.nullPtr :: Ptr Gst.Caps.Caps)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoCodecStateCapsFieldInfo
instance AttrInfo VideoCodecStateCapsFieldInfo where
    type AttrAllowedOps VideoCodecStateCapsFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint VideoCodecStateCapsFieldInfo = (~) (Ptr Gst.Caps.Caps)
    type AttrBaseTypeConstraint VideoCodecStateCapsFieldInfo = (~) VideoCodecState
    type AttrGetType VideoCodecStateCapsFieldInfo = Maybe Gst.Caps.Caps
    type AttrLabel VideoCodecStateCapsFieldInfo = "caps"
    type AttrOrigin VideoCodecStateCapsFieldInfo = VideoCodecState
    attrGet _ = getVideoCodecStateCaps
    attrSet _ = setVideoCodecStateCaps
    attrConstruct = undefined
    attrClear _ = clearVideoCodecStateCaps

videoCodecState_caps :: AttrLabelProxy "caps"
videoCodecState_caps = AttrLabelProxy

#endif


getVideoCodecStateCodecData :: MonadIO m => VideoCodecState -> m (Maybe Gst.Buffer.Buffer)
getVideoCodecStateCodecData s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 136) :: IO (Ptr Gst.Buffer.Buffer)
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- (newBoxed Gst.Buffer.Buffer) val'
        return val''
    return result

setVideoCodecStateCodecData :: MonadIO m => VideoCodecState -> Ptr Gst.Buffer.Buffer -> m ()
setVideoCodecStateCodecData s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 136) (val :: Ptr Gst.Buffer.Buffer)

clearVideoCodecStateCodecData :: MonadIO m => VideoCodecState -> m ()
clearVideoCodecStateCodecData s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 136) (FP.nullPtr :: Ptr Gst.Buffer.Buffer)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoCodecStateCodecDataFieldInfo
instance AttrInfo VideoCodecStateCodecDataFieldInfo where
    type AttrAllowedOps VideoCodecStateCodecDataFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint VideoCodecStateCodecDataFieldInfo = (~) (Ptr Gst.Buffer.Buffer)
    type AttrBaseTypeConstraint VideoCodecStateCodecDataFieldInfo = (~) VideoCodecState
    type AttrGetType VideoCodecStateCodecDataFieldInfo = Maybe Gst.Buffer.Buffer
    type AttrLabel VideoCodecStateCodecDataFieldInfo = "codec_data"
    type AttrOrigin VideoCodecStateCodecDataFieldInfo = VideoCodecState
    attrGet _ = getVideoCodecStateCodecData
    attrSet _ = setVideoCodecStateCodecData
    attrConstruct = undefined
    attrClear _ = clearVideoCodecStateCodecData

videoCodecState_codecData :: AttrLabelProxy "codecData"
videoCodecState_codecData = AttrLabelProxy

#endif


getVideoCodecStateAllocationCaps :: MonadIO m => VideoCodecState -> m (Maybe Gst.Caps.Caps)
getVideoCodecStateAllocationCaps s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 144) :: IO (Ptr Gst.Caps.Caps)
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- (newBoxed Gst.Caps.Caps) val'
        return val''
    return result

setVideoCodecStateAllocationCaps :: MonadIO m => VideoCodecState -> Ptr Gst.Caps.Caps -> m ()
setVideoCodecStateAllocationCaps s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 144) (val :: Ptr Gst.Caps.Caps)

clearVideoCodecStateAllocationCaps :: MonadIO m => VideoCodecState -> m ()
clearVideoCodecStateAllocationCaps s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 144) (FP.nullPtr :: Ptr Gst.Caps.Caps)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoCodecStateAllocationCapsFieldInfo
instance AttrInfo VideoCodecStateAllocationCapsFieldInfo where
    type AttrAllowedOps VideoCodecStateAllocationCapsFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint VideoCodecStateAllocationCapsFieldInfo = (~) (Ptr Gst.Caps.Caps)
    type AttrBaseTypeConstraint VideoCodecStateAllocationCapsFieldInfo = (~) VideoCodecState
    type AttrGetType VideoCodecStateAllocationCapsFieldInfo = Maybe Gst.Caps.Caps
    type AttrLabel VideoCodecStateAllocationCapsFieldInfo = "allocation_caps"
    type AttrOrigin VideoCodecStateAllocationCapsFieldInfo = VideoCodecState
    attrGet _ = getVideoCodecStateAllocationCaps
    attrSet _ = setVideoCodecStateAllocationCaps
    attrConstruct = undefined
    attrClear _ = clearVideoCodecStateAllocationCaps

videoCodecState_allocationCaps :: AttrLabelProxy "allocationCaps"
videoCodecState_allocationCaps = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
instance O.HasAttributeList VideoCodecState
type instance O.AttributeList VideoCodecState = VideoCodecStateAttributeList
type VideoCodecStateAttributeList = ('[ '("info", VideoCodecStateInfoFieldInfo), '("caps", VideoCodecStateCapsFieldInfo), '("codecData", VideoCodecStateCodecDataFieldInfo), '("allocationCaps", VideoCodecStateAllocationCapsFieldInfo)] :: [(Symbol, *)])
#endif

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

foreign import ccall "gst_video_codec_state_ref" gst_video_codec_state_ref :: 
    Ptr VideoCodecState ->                  -- state : TInterface (Name {namespace = "GstVideo", name = "VideoCodecState"})
    IO (Ptr VideoCodecState)

{- |
Increases the refcount of the given state by one.
-}
videoCodecStateRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoCodecState
    {- ^ /@state@/: a 'GI.GstVideo.Structs.VideoCodecState.VideoCodecState' -}
    -> m VideoCodecState
    {- ^ __Returns:__ /@buf@/ -}
videoCodecStateRef state = liftIO $ do
    state' <- unsafeManagedPtrGetPtr state
    result <- gst_video_codec_state_ref state'
    checkUnexpectedReturnNULL "videoCodecStateRef" result
    result' <- (wrapBoxed VideoCodecState) result
    touchManagedPtr state
    return result'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoCodecStateRefMethodInfo
instance (signature ~ (m VideoCodecState), MonadIO m) => O.MethodInfo VideoCodecStateRefMethodInfo VideoCodecState signature where
    overloadedMethod _ = videoCodecStateRef

#endif

-- method VideoCodecState::unref
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "state", argType = TInterface (Name {namespace = "GstVideo", name = "VideoCodecState"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstVideoCodecState", 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_codec_state_unref" gst_video_codec_state_unref :: 
    Ptr VideoCodecState ->                  -- state : TInterface (Name {namespace = "GstVideo", name = "VideoCodecState"})
    IO ()

{- |
Decreases the refcount of the state. If the refcount reaches 0, the state
will be freed.
-}
videoCodecStateUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoCodecState
    {- ^ /@state@/: a 'GI.GstVideo.Structs.VideoCodecState.VideoCodecState' -}
    -> m ()
videoCodecStateUnref state = liftIO $ do
    state' <- unsafeManagedPtrGetPtr state
    gst_video_codec_state_unref state'
    touchManagedPtr state
    return ()

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoCodecStateUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo VideoCodecStateUnrefMethodInfo VideoCodecState signature where
    overloadedMethod _ = videoCodecStateUnref

#endif

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
type family ResolveVideoCodecStateMethod (t :: Symbol) (o :: *) :: * where
    ResolveVideoCodecStateMethod "ref" o = VideoCodecStateRefMethodInfo
    ResolveVideoCodecStateMethod "unref" o = VideoCodecStateUnrefMethodInfo
    ResolveVideoCodecStateMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolveVideoCodecStateMethod t VideoCodecState, O.MethodInfo info VideoCodecState p) => O.IsLabel t (VideoCodecState -> 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