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

Extra buffer metadata for uploading a buffer to an OpenGL texture
ID. The caller of 'GI.GstVideo.Structs.VideoGLTextureUploadMeta.videoGLTextureUploadMetaUpload' must
have OpenGL set up and call this from a thread where it is valid
to upload something to an OpenGL texture.
-}

module GI.GstVideo.Structs.VideoGLTextureUploadMeta
    ( 

-- * Exported types
    VideoGLTextureUploadMeta(..)            ,
    newZeroVideoGLTextureUploadMeta         ,
    noVideoGLTextureUploadMeta              ,


 -- * Methods
-- ** getInfo #method:getInfo#
    videoGLTextureUploadMetaGetInfo         ,


-- ** upload #method:upload#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    VideoGLTextureUploadMetaUploadMethodInfo,
#endif
    videoGLTextureUploadMetaUpload          ,




 -- * Properties
-- ** meta #attr:meta#
    getVideoGLTextureUploadMetaMeta         ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoGLTextureUploadMeta_meta           ,
#endif


-- ** nTextures #attr:nTextures#
    getVideoGLTextureUploadMetaNTextures    ,
    setVideoGLTextureUploadMetaNTextures    ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoGLTextureUploadMeta_nTextures      ,
#endif


-- ** textureOrientation #attr:textureOrientation#
    getVideoGLTextureUploadMetaTextureOrientation,
    setVideoGLTextureUploadMetaTextureOrientation,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoGLTextureUploadMeta_textureOrientation,
#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.Meta as Gst.Meta
import qualified GI.Gst.Structs.MetaInfo as Gst.MetaInfo
import {-# SOURCE #-} qualified GI.GstVideo.Enums as GstVideo.Enums

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

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

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


noVideoGLTextureUploadMeta :: Maybe VideoGLTextureUploadMeta
noVideoGLTextureUploadMeta = Nothing

getVideoGLTextureUploadMetaMeta :: MonadIO m => VideoGLTextureUploadMeta -> m Gst.Meta.Meta
getVideoGLTextureUploadMetaMeta s = liftIO $ withManagedPtr s $ \ptr -> do
    let val = ptr `plusPtr` 0 :: (Ptr Gst.Meta.Meta)
    val' <- (newPtr Gst.Meta.Meta) val
    return val'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoGLTextureUploadMetaMetaFieldInfo
instance AttrInfo VideoGLTextureUploadMetaMetaFieldInfo where
    type AttrAllowedOps VideoGLTextureUploadMetaMetaFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint VideoGLTextureUploadMetaMetaFieldInfo = (~) (Ptr Gst.Meta.Meta)
    type AttrBaseTypeConstraint VideoGLTextureUploadMetaMetaFieldInfo = (~) VideoGLTextureUploadMeta
    type AttrGetType VideoGLTextureUploadMetaMetaFieldInfo = Gst.Meta.Meta
    type AttrLabel VideoGLTextureUploadMetaMetaFieldInfo = "meta"
    type AttrOrigin VideoGLTextureUploadMetaMetaFieldInfo = VideoGLTextureUploadMeta
    attrGet _ = getVideoGLTextureUploadMetaMeta
    attrSet _ = undefined
    attrConstruct = undefined
    attrClear _ = undefined

videoGLTextureUploadMeta_meta :: AttrLabelProxy "meta"
videoGLTextureUploadMeta_meta = AttrLabelProxy

#endif


getVideoGLTextureUploadMetaTextureOrientation :: MonadIO m => VideoGLTextureUploadMeta -> m GstVideo.Enums.VideoGLTextureOrientation
getVideoGLTextureUploadMetaTextureOrientation s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 16) :: IO CUInt
    let val' = (toEnum . fromIntegral) val
    return val'

setVideoGLTextureUploadMetaTextureOrientation :: MonadIO m => VideoGLTextureUploadMeta -> GstVideo.Enums.VideoGLTextureOrientation -> m ()
setVideoGLTextureUploadMetaTextureOrientation s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = (fromIntegral . fromEnum) val
    poke (ptr `plusPtr` 16) (val' :: CUInt)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoGLTextureUploadMetaTextureOrientationFieldInfo
instance AttrInfo VideoGLTextureUploadMetaTextureOrientationFieldInfo where
    type AttrAllowedOps VideoGLTextureUploadMetaTextureOrientationFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoGLTextureUploadMetaTextureOrientationFieldInfo = (~) GstVideo.Enums.VideoGLTextureOrientation
    type AttrBaseTypeConstraint VideoGLTextureUploadMetaTextureOrientationFieldInfo = (~) VideoGLTextureUploadMeta
    type AttrGetType VideoGLTextureUploadMetaTextureOrientationFieldInfo = GstVideo.Enums.VideoGLTextureOrientation
    type AttrLabel VideoGLTextureUploadMetaTextureOrientationFieldInfo = "texture_orientation"
    type AttrOrigin VideoGLTextureUploadMetaTextureOrientationFieldInfo = VideoGLTextureUploadMeta
    attrGet _ = getVideoGLTextureUploadMetaTextureOrientation
    attrSet _ = setVideoGLTextureUploadMetaTextureOrientation
    attrConstruct = undefined
    attrClear _ = undefined

videoGLTextureUploadMeta_textureOrientation :: AttrLabelProxy "textureOrientation"
videoGLTextureUploadMeta_textureOrientation = AttrLabelProxy

#endif


getVideoGLTextureUploadMetaNTextures :: MonadIO m => VideoGLTextureUploadMeta -> m Word32
getVideoGLTextureUploadMetaNTextures s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 20) :: IO Word32
    return val

setVideoGLTextureUploadMetaNTextures :: MonadIO m => VideoGLTextureUploadMeta -> Word32 -> m ()
setVideoGLTextureUploadMetaNTextures s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 20) (val :: Word32)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoGLTextureUploadMetaNTexturesFieldInfo
instance AttrInfo VideoGLTextureUploadMetaNTexturesFieldInfo where
    type AttrAllowedOps VideoGLTextureUploadMetaNTexturesFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoGLTextureUploadMetaNTexturesFieldInfo = (~) Word32
    type AttrBaseTypeConstraint VideoGLTextureUploadMetaNTexturesFieldInfo = (~) VideoGLTextureUploadMeta
    type AttrGetType VideoGLTextureUploadMetaNTexturesFieldInfo = Word32
    type AttrLabel VideoGLTextureUploadMetaNTexturesFieldInfo = "n_textures"
    type AttrOrigin VideoGLTextureUploadMetaNTexturesFieldInfo = VideoGLTextureUploadMeta
    attrGet _ = getVideoGLTextureUploadMetaNTextures
    attrSet _ = setVideoGLTextureUploadMetaNTextures
    attrConstruct = undefined
    attrClear _ = undefined

videoGLTextureUploadMeta_nTextures :: AttrLabelProxy "nTextures"
videoGLTextureUploadMeta_nTextures = AttrLabelProxy

#endif


-- XXX Skipped attribute for "VideoGLTextureUploadMeta:texture_type" :: Not implemented: "Don't know how to unpack C array of type TCArray False 4 (-1) (TInterface (Name {namespace = \"GstVideo\", name = \"VideoGLTextureType\"}))"

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
instance O.HasAttributeList VideoGLTextureUploadMeta
type instance O.AttributeList VideoGLTextureUploadMeta = VideoGLTextureUploadMetaAttributeList
type VideoGLTextureUploadMetaAttributeList = ('[ '("meta", VideoGLTextureUploadMetaMetaFieldInfo), '("textureOrientation", VideoGLTextureUploadMetaTextureOrientationFieldInfo), '("nTextures", VideoGLTextureUploadMetaNTexturesFieldInfo)] :: [(Symbol, *)])
#endif

-- method VideoGLTextureUploadMeta::upload
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "meta", argType = TInterface (Name {namespace = "GstVideo", name = "VideoGLTextureUploadMeta"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstVideoGLTextureUploadMeta", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "texture_id", argType = TBasicType TUInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the texture IDs to upload to", 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_gl_texture_upload_meta_upload" gst_video_gl_texture_upload_meta_upload :: 
    Ptr VideoGLTextureUploadMeta ->         -- meta : TInterface (Name {namespace = "GstVideo", name = "VideoGLTextureUploadMeta"})
    Word32 ->                               -- texture_id : TBasicType TUInt
    IO CInt

{- |
Uploads the buffer which owns the meta to a specific texture ID.
-}
videoGLTextureUploadMetaUpload ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoGLTextureUploadMeta
    {- ^ /@meta@/: a 'GI.GstVideo.Structs.VideoGLTextureUploadMeta.VideoGLTextureUploadMeta' -}
    -> Word32
    {- ^ /@textureId@/: the texture IDs to upload to -}
    -> m Bool
    {- ^ __Returns:__ 'True' if uploading succeeded, 'False' otherwise. -}
videoGLTextureUploadMetaUpload meta textureId = liftIO $ do
    meta' <- unsafeManagedPtrGetPtr meta
    result <- gst_video_gl_texture_upload_meta_upload meta' textureId
    let result' = (/= 0) result
    touchManagedPtr meta
    return result'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoGLTextureUploadMetaUploadMethodInfo
instance (signature ~ (Word32 -> m Bool), MonadIO m) => O.MethodInfo VideoGLTextureUploadMetaUploadMethodInfo VideoGLTextureUploadMeta signature where
    overloadedMethod _ = videoGLTextureUploadMetaUpload

#endif

-- method VideoGLTextureUploadMeta::get_info
-- method type : MemberFunction
-- Args : []
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "MetaInfo"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_gl_texture_upload_meta_get_info" gst_video_gl_texture_upload_meta_get_info :: 
    IO (Ptr Gst.MetaInfo.MetaInfo)

{- |
/No description available in the introspection data./
-}
videoGLTextureUploadMetaGetInfo ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Gst.MetaInfo.MetaInfo
videoGLTextureUploadMetaGetInfo  = liftIO $ do
    result <- gst_video_gl_texture_upload_meta_get_info
    checkUnexpectedReturnNULL "videoGLTextureUploadMetaGetInfo" result
    result' <- (newPtr Gst.MetaInfo.MetaInfo) result
    return result'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
#endif

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

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

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