-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria

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

module GI.GstVideo.Callbacks
    ( 

 -- * Signals
-- ** VideoAffineTransformationGetMatrix #signal:VideoAffineTransformationGetMatrix#

    C_VideoAffineTransformationGetMatrix    ,
    VideoAffineTransformationGetMatrix      ,
    dynamic_VideoAffineTransformationGetMatrix,
    genClosure_VideoAffineTransformationGetMatrix,
    mk_VideoAffineTransformationGetMatrix   ,
    noVideoAffineTransformationGetMatrix    ,
    wrap_VideoAffineTransformationGetMatrix ,


-- ** VideoConvertSampleCallback #signal:VideoConvertSampleCallback#

    C_VideoConvertSampleCallback            ,
    VideoConvertSampleCallback              ,
    VideoConvertSampleCallback_WithClosures ,
    drop_closures_VideoConvertSampleCallback,
    dynamic_VideoConvertSampleCallback      ,
    genClosure_VideoConvertSampleCallback   ,
    mk_VideoConvertSampleCallback           ,
    noVideoConvertSampleCallback            ,
    noVideoConvertSampleCallback_WithClosures,
    wrap_VideoConvertSampleCallback         ,


-- ** VideoFormatPack #signal:VideoFormatPack#

    C_VideoFormatPack                       ,
    VideoFormatPack                         ,
    dynamic_VideoFormatPack                 ,
    genClosure_VideoFormatPack              ,
    mk_VideoFormatPack                      ,
    noVideoFormatPack                       ,
    wrap_VideoFormatPack                    ,


-- ** VideoFormatUnpack #signal:VideoFormatUnpack#

    C_VideoFormatUnpack                     ,
    VideoFormatUnpack                       ,
    dynamic_VideoFormatUnpack               ,
    genClosure_VideoFormatUnpack            ,
    mk_VideoFormatUnpack                    ,
    noVideoFormatUnpack                     ,
    wrap_VideoFormatUnpack                  ,


-- ** VideoGLTextureUpload #signal:VideoGLTextureUpload#

    C_VideoGLTextureUpload                  ,
    VideoGLTextureUpload                    ,
    dynamic_VideoGLTextureUpload            ,
    genClosure_VideoGLTextureUpload         ,
    mk_VideoGLTextureUpload                 ,
    noVideoGLTextureUpload                  ,
    wrap_VideoGLTextureUpload               ,


-- ** VideoMetaMapFieldCallback #signal:VideoMetaMapFieldCallback#

    C_VideoMetaMapFieldCallback             ,
    VideoMetaMapFieldCallback               ,
    dynamic_VideoMetaMapFieldCallback       ,
    genClosure_VideoMetaMapFieldCallback    ,
    mk_VideoMetaMapFieldCallback            ,
    noVideoMetaMapFieldCallback             ,
    wrap_VideoMetaMapFieldCallback          ,


-- ** VideoMetaUnmapFieldCallback #signal:VideoMetaUnmapFieldCallback#

    C_VideoMetaUnmapFieldCallback           ,
    VideoMetaUnmapFieldCallback             ,
    dynamic_VideoMetaUnmapFieldCallback     ,
    genClosure_VideoMetaUnmapFieldCallback  ,
    mk_VideoMetaUnmapFieldCallback          ,
    noVideoMetaUnmapFieldCallback           ,
    wrap_VideoMetaUnmapFieldCallback        ,




    ) 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.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 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 GI.Gst.Flags as Gst.Flags
import qualified GI.Gst.Structs.MapInfo as Gst.MapInfo
import qualified GI.Gst.Structs.Sample as Gst.Sample
import {-# SOURCE #-} qualified GI.GstVideo.Flags as GstVideo.Flags
import {-# SOURCE #-} qualified GI.GstVideo.Structs.VideoAffineTransformationMeta as GstVideo.VideoAffineTransformationMeta
import {-# SOURCE #-} qualified GI.GstVideo.Structs.VideoFormatInfo as GstVideo.VideoFormatInfo
import {-# SOURCE #-} qualified GI.GstVideo.Structs.VideoGLTextureUploadMeta as GstVideo.VideoGLTextureUploadMeta
import {-# SOURCE #-} qualified GI.GstVideo.Structs.VideoMeta as GstVideo.VideoMeta

-- callback VideoMetaUnmapFieldCallback
--          -> Callable {returnType = Just (TBasicType TBoolean), returnMayBeNull = False, returnTransfer = TransferNothing, returnDocumentation = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, args = [Arg {argCName = "meta", argType = TInterface (Name {namespace = "GstVideo", name = "VideoMeta"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "plane", argType = TBasicType TUInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "info", argType = TInterface (Name {namespace = "Gst", name = "MapInfo"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}], skipReturn = False, callableThrows = False, callableDeprecated = Nothing, callableDocumentation = Documentation {rawDocText = Nothing, sinceVersion = Nothing}}
-- | Type for the callback on the (unwrapped) C side.
type C_VideoMetaUnmapFieldCallback =
    Ptr GstVideo.VideoMeta.VideoMeta ->
    Word32 ->
    Ptr Gst.MapInfo.MapInfo ->
    IO CInt

-- Args: [ Arg
--           { argCName = "meta"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoMeta" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "plane"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MapInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 "dynamic" __dynamic_C_VideoMetaUnmapFieldCallback :: FunPtr C_VideoMetaUnmapFieldCallback -> C_VideoMetaUnmapFieldCallback

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_VideoMetaUnmapFieldCallback ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FunPtr C_VideoMetaUnmapFieldCallback
    -> GstVideo.VideoMeta.VideoMeta
    -> Word32
    -> Gst.MapInfo.MapInfo
    -> m Bool
dynamic_VideoMetaUnmapFieldCallback :: FunPtr C_VideoMetaUnmapFieldCallback
-> VideoMeta -> Word32 -> MapInfo -> m Bool
dynamic_VideoMetaUnmapFieldCallback __funPtr :: FunPtr C_VideoMetaUnmapFieldCallback
__funPtr meta :: VideoMeta
meta plane :: Word32
plane info :: MapInfo
info = 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 VideoMeta
meta' <- VideoMeta -> IO (Ptr VideoMeta)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoMeta
meta
    Ptr MapInfo
info' <- MapInfo -> IO (Ptr MapInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MapInfo
info
    CInt
result <- (FunPtr C_VideoMetaUnmapFieldCallback
-> C_VideoMetaUnmapFieldCallback
__dynamic_C_VideoMetaUnmapFieldCallback FunPtr C_VideoMetaUnmapFieldCallback
__funPtr) Ptr VideoMeta
meta' Word32
plane Ptr MapInfo
info'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    VideoMeta -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoMeta
meta
    MapInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MapInfo
info
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

-- | Generate a function pointer callable from C code, from a `C_VideoMetaUnmapFieldCallback`.
foreign import ccall "wrapper"
    mk_VideoMetaUnmapFieldCallback :: C_VideoMetaUnmapFieldCallback -> IO (FunPtr C_VideoMetaUnmapFieldCallback)

-- | /No description available in the introspection data./
type VideoMetaUnmapFieldCallback =
    GstVideo.VideoMeta.VideoMeta
    -> Word32
    -> Gst.MapInfo.MapInfo
    -> IO Bool

-- | A convenience synonym for @`Nothing` :: `Maybe` `VideoMetaUnmapFieldCallback`@.
noVideoMetaUnmapFieldCallback :: Maybe VideoMetaUnmapFieldCallback
noVideoMetaUnmapFieldCallback :: Maybe VideoMetaUnmapFieldCallback
noVideoMetaUnmapFieldCallback = Maybe VideoMetaUnmapFieldCallback
forall a. Maybe a
Nothing

-- | Wrap the callback into a `GClosure`.
genClosure_VideoMetaUnmapFieldCallback :: MonadIO m => VideoMetaUnmapFieldCallback -> m (GClosure C_VideoMetaUnmapFieldCallback)
genClosure_VideoMetaUnmapFieldCallback :: VideoMetaUnmapFieldCallback
-> m (GClosure C_VideoMetaUnmapFieldCallback)
genClosure_VideoMetaUnmapFieldCallback cb :: VideoMetaUnmapFieldCallback
cb = IO (GClosure C_VideoMetaUnmapFieldCallback)
-> m (GClosure C_VideoMetaUnmapFieldCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_VideoMetaUnmapFieldCallback)
 -> m (GClosure C_VideoMetaUnmapFieldCallback))
-> IO (GClosure C_VideoMetaUnmapFieldCallback)
-> m (GClosure C_VideoMetaUnmapFieldCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_VideoMetaUnmapFieldCallback
cb' = Maybe (Ptr (FunPtr C_VideoMetaUnmapFieldCallback))
-> VideoMetaUnmapFieldCallback -> C_VideoMetaUnmapFieldCallback
wrap_VideoMetaUnmapFieldCallback Maybe (Ptr (FunPtr C_VideoMetaUnmapFieldCallback))
forall a. Maybe a
Nothing VideoMetaUnmapFieldCallback
cb
    C_VideoMetaUnmapFieldCallback
-> IO (FunPtr C_VideoMetaUnmapFieldCallback)
mk_VideoMetaUnmapFieldCallback C_VideoMetaUnmapFieldCallback
cb' IO (FunPtr C_VideoMetaUnmapFieldCallback)
-> (FunPtr C_VideoMetaUnmapFieldCallback
    -> IO (GClosure C_VideoMetaUnmapFieldCallback))
-> IO (GClosure C_VideoMetaUnmapFieldCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_VideoMetaUnmapFieldCallback
-> IO (GClosure C_VideoMetaUnmapFieldCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `VideoMetaUnmapFieldCallback` into a `C_VideoMetaUnmapFieldCallback`.
wrap_VideoMetaUnmapFieldCallback ::
    Maybe (Ptr (FunPtr C_VideoMetaUnmapFieldCallback)) ->
    VideoMetaUnmapFieldCallback ->
    C_VideoMetaUnmapFieldCallback
wrap_VideoMetaUnmapFieldCallback :: Maybe (Ptr (FunPtr C_VideoMetaUnmapFieldCallback))
-> VideoMetaUnmapFieldCallback -> C_VideoMetaUnmapFieldCallback
wrap_VideoMetaUnmapFieldCallback funptrptr :: Maybe (Ptr (FunPtr C_VideoMetaUnmapFieldCallback))
funptrptr _cb :: VideoMetaUnmapFieldCallback
_cb meta :: Ptr VideoMeta
meta plane :: Word32
plane info :: Ptr MapInfo
info = do
    VideoMeta
meta' <- ((ManagedPtr VideoMeta -> VideoMeta)
-> Ptr VideoMeta -> IO VideoMeta
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr VideoMeta -> VideoMeta
GstVideo.VideoMeta.VideoMeta) Ptr VideoMeta
meta
    MapInfo
info' <- ((ManagedPtr MapInfo -> MapInfo) -> Ptr MapInfo -> IO MapInfo
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr MapInfo -> MapInfo
Gst.MapInfo.MapInfo) Ptr MapInfo
info
    Bool
result <- VideoMetaUnmapFieldCallback
_cb  VideoMeta
meta' Word32
plane MapInfo
info'
    Maybe (Ptr (FunPtr C_VideoMetaUnmapFieldCallback)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_VideoMetaUnmapFieldCallback))
funptrptr
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- callback VideoMetaMapFieldCallback
--          -> Callable {returnType = Just (TBasicType TBoolean), returnMayBeNull = False, returnTransfer = TransferNothing, returnDocumentation = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, args = [Arg {argCName = "meta", argType = TInterface (Name {namespace = "GstVideo", name = "VideoMeta"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "plane", argType = TBasicType TUInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "info", argType = TInterface (Name {namespace = "Gst", name = "MapInfo"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "data", argType = TBasicType TPtr, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "stride", argType = TBasicType TInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "flags", argType = TInterface (Name {namespace = "Gst", name = "MapFlags"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}], skipReturn = False, callableThrows = False, callableDeprecated = Nothing, callableDocumentation = Documentation {rawDocText = Nothing, sinceVersion = Nothing}}
-- | Type for the callback on the (unwrapped) C side.
type C_VideoMetaMapFieldCallback =
    Ptr GstVideo.VideoMeta.VideoMeta ->
    Word32 ->
    Ptr Gst.MapInfo.MapInfo ->
    Ptr () ->
    Int32 ->
    CUInt ->
    IO CInt

-- Args: [ Arg
--           { argCName = "meta"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoMeta" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "plane"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MapInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stride"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MapFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 "dynamic" __dynamic_C_VideoMetaMapFieldCallback :: FunPtr C_VideoMetaMapFieldCallback -> C_VideoMetaMapFieldCallback

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_VideoMetaMapFieldCallback ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FunPtr C_VideoMetaMapFieldCallback
    -> GstVideo.VideoMeta.VideoMeta
    -> Word32
    -> Gst.MapInfo.MapInfo
    -> Ptr ()
    -> Int32
    -> [Gst.Flags.MapFlags]
    -> m Bool
dynamic_VideoMetaMapFieldCallback :: FunPtr C_VideoMetaMapFieldCallback
-> VideoMeta
-> Word32
-> MapInfo
-> Ptr ()
-> Int32
-> [MapFlags]
-> m Bool
dynamic_VideoMetaMapFieldCallback __funPtr :: FunPtr C_VideoMetaMapFieldCallback
__funPtr meta :: VideoMeta
meta plane :: Word32
plane info :: MapInfo
info data_ :: Ptr ()
data_ stride :: Int32
stride flags :: [MapFlags]
flags = 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 VideoMeta
meta' <- VideoMeta -> IO (Ptr VideoMeta)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoMeta
meta
    Ptr MapInfo
info' <- MapInfo -> IO (Ptr MapInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MapInfo
info
    let flags' :: CUInt
flags' = [MapFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MapFlags]
flags
    CInt
result <- (FunPtr C_VideoMetaMapFieldCallback -> C_VideoMetaMapFieldCallback
__dynamic_C_VideoMetaMapFieldCallback FunPtr C_VideoMetaMapFieldCallback
__funPtr) Ptr VideoMeta
meta' Word32
plane Ptr MapInfo
info' Ptr ()
data_ Int32
stride CUInt
flags'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    VideoMeta -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoMeta
meta
    MapInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MapInfo
info
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

-- | Generate a function pointer callable from C code, from a `C_VideoMetaMapFieldCallback`.
foreign import ccall "wrapper"
    mk_VideoMetaMapFieldCallback :: C_VideoMetaMapFieldCallback -> IO (FunPtr C_VideoMetaMapFieldCallback)

-- | /No description available in the introspection data./
type VideoMetaMapFieldCallback =
    GstVideo.VideoMeta.VideoMeta
    -> Word32
    -> Gst.MapInfo.MapInfo
    -> Ptr ()
    -> Int32
    -> [Gst.Flags.MapFlags]
    -> IO Bool

-- | A convenience synonym for @`Nothing` :: `Maybe` `VideoMetaMapFieldCallback`@.
noVideoMetaMapFieldCallback :: Maybe VideoMetaMapFieldCallback
noVideoMetaMapFieldCallback :: Maybe VideoMetaMapFieldCallback
noVideoMetaMapFieldCallback = Maybe VideoMetaMapFieldCallback
forall a. Maybe a
Nothing

-- | Wrap the callback into a `GClosure`.
genClosure_VideoMetaMapFieldCallback :: MonadIO m => VideoMetaMapFieldCallback -> m (GClosure C_VideoMetaMapFieldCallback)
genClosure_VideoMetaMapFieldCallback :: VideoMetaMapFieldCallback
-> m (GClosure C_VideoMetaMapFieldCallback)
genClosure_VideoMetaMapFieldCallback cb :: VideoMetaMapFieldCallback
cb = IO (GClosure C_VideoMetaMapFieldCallback)
-> m (GClosure C_VideoMetaMapFieldCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_VideoMetaMapFieldCallback)
 -> m (GClosure C_VideoMetaMapFieldCallback))
-> IO (GClosure C_VideoMetaMapFieldCallback)
-> m (GClosure C_VideoMetaMapFieldCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_VideoMetaMapFieldCallback
cb' = Maybe (Ptr (FunPtr C_VideoMetaMapFieldCallback))
-> VideoMetaMapFieldCallback -> C_VideoMetaMapFieldCallback
wrap_VideoMetaMapFieldCallback Maybe (Ptr (FunPtr C_VideoMetaMapFieldCallback))
forall a. Maybe a
Nothing VideoMetaMapFieldCallback
cb
    C_VideoMetaMapFieldCallback
-> IO (FunPtr C_VideoMetaMapFieldCallback)
mk_VideoMetaMapFieldCallback C_VideoMetaMapFieldCallback
cb' IO (FunPtr C_VideoMetaMapFieldCallback)
-> (FunPtr C_VideoMetaMapFieldCallback
    -> IO (GClosure C_VideoMetaMapFieldCallback))
-> IO (GClosure C_VideoMetaMapFieldCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_VideoMetaMapFieldCallback
-> IO (GClosure C_VideoMetaMapFieldCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `VideoMetaMapFieldCallback` into a `C_VideoMetaMapFieldCallback`.
wrap_VideoMetaMapFieldCallback ::
    Maybe (Ptr (FunPtr C_VideoMetaMapFieldCallback)) ->
    VideoMetaMapFieldCallback ->
    C_VideoMetaMapFieldCallback
wrap_VideoMetaMapFieldCallback :: Maybe (Ptr (FunPtr C_VideoMetaMapFieldCallback))
-> VideoMetaMapFieldCallback -> C_VideoMetaMapFieldCallback
wrap_VideoMetaMapFieldCallback funptrptr :: Maybe (Ptr (FunPtr C_VideoMetaMapFieldCallback))
funptrptr _cb :: VideoMetaMapFieldCallback
_cb meta :: Ptr VideoMeta
meta plane :: Word32
plane info :: Ptr MapInfo
info data_ :: Ptr ()
data_ stride :: Int32
stride flags :: CUInt
flags = do
    VideoMeta
meta' <- ((ManagedPtr VideoMeta -> VideoMeta)
-> Ptr VideoMeta -> IO VideoMeta
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr VideoMeta -> VideoMeta
GstVideo.VideoMeta.VideoMeta) Ptr VideoMeta
meta
    MapInfo
info' <- ((ManagedPtr MapInfo -> MapInfo) -> Ptr MapInfo -> IO MapInfo
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr MapInfo -> MapInfo
Gst.MapInfo.MapInfo) Ptr MapInfo
info
    let flags' :: [MapFlags]
flags' = CUInt -> [MapFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
flags
    Bool
result <- VideoMetaMapFieldCallback
_cb  VideoMeta
meta' Word32
plane MapInfo
info' Ptr ()
data_ Int32
stride [MapFlags]
flags'
    Maybe (Ptr (FunPtr C_VideoMetaMapFieldCallback)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_VideoMetaMapFieldCallback))
funptrptr
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- callback VideoGLTextureUpload
--          -> Callable {returnType = Just (TBasicType TBoolean), returnMayBeNull = False, returnTransfer = TransferNothing, returnDocumentation = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, args = [Arg {argCName = "meta", argType = TInterface (Name {namespace = "GstVideo", name = "VideoGLTextureUploadMeta"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Nothing, 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 = Nothing, sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}], skipReturn = False, callableThrows = False, callableDeprecated = Nothing, callableDocumentation = Documentation {rawDocText = Nothing, sinceVersion = Nothing}}
-- | Type for the callback on the (unwrapped) C side.
type C_VideoGLTextureUpload =
    Ptr GstVideo.VideoGLTextureUploadMeta.VideoGLTextureUploadMeta ->
    Word32 ->
    IO CInt

-- Args: [ Arg
--           { argCName = "meta"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoGLTextureUploadMeta" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 = Nothing , 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 "dynamic" __dynamic_C_VideoGLTextureUpload :: FunPtr C_VideoGLTextureUpload -> C_VideoGLTextureUpload

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_VideoGLTextureUpload ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FunPtr C_VideoGLTextureUpload
    -> GstVideo.VideoGLTextureUploadMeta.VideoGLTextureUploadMeta
    -> Word32
    -> m Bool
dynamic_VideoGLTextureUpload :: FunPtr C_VideoGLTextureUpload
-> VideoGLTextureUploadMeta -> Word32 -> m Bool
dynamic_VideoGLTextureUpload __funPtr :: FunPtr C_VideoGLTextureUpload
__funPtr meta :: VideoGLTextureUploadMeta
meta textureId :: Word32
textureId = 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 VideoGLTextureUploadMeta
meta' <- VideoGLTextureUploadMeta -> IO (Ptr VideoGLTextureUploadMeta)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoGLTextureUploadMeta
meta
    CInt
result <- (FunPtr C_VideoGLTextureUpload -> C_VideoGLTextureUpload
__dynamic_C_VideoGLTextureUpload FunPtr C_VideoGLTextureUpload
__funPtr) Ptr VideoGLTextureUploadMeta
meta' Word32
textureId
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    VideoGLTextureUploadMeta -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoGLTextureUploadMeta
meta
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

-- | Generate a function pointer callable from C code, from a `C_VideoGLTextureUpload`.
foreign import ccall "wrapper"
    mk_VideoGLTextureUpload :: C_VideoGLTextureUpload -> IO (FunPtr C_VideoGLTextureUpload)

-- | /No description available in the introspection data./
type VideoGLTextureUpload =
    GstVideo.VideoGLTextureUploadMeta.VideoGLTextureUploadMeta
    -> Word32
    -> IO Bool

-- | A convenience synonym for @`Nothing` :: `Maybe` `VideoGLTextureUpload`@.
noVideoGLTextureUpload :: Maybe VideoGLTextureUpload
noVideoGLTextureUpload :: Maybe VideoGLTextureUpload
noVideoGLTextureUpload = Maybe VideoGLTextureUpload
forall a. Maybe a
Nothing

-- | Wrap the callback into a `GClosure`.
genClosure_VideoGLTextureUpload :: MonadIO m => VideoGLTextureUpload -> m (GClosure C_VideoGLTextureUpload)
genClosure_VideoGLTextureUpload :: VideoGLTextureUpload -> m (GClosure C_VideoGLTextureUpload)
genClosure_VideoGLTextureUpload cb :: VideoGLTextureUpload
cb = IO (GClosure C_VideoGLTextureUpload)
-> m (GClosure C_VideoGLTextureUpload)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_VideoGLTextureUpload)
 -> m (GClosure C_VideoGLTextureUpload))
-> IO (GClosure C_VideoGLTextureUpload)
-> m (GClosure C_VideoGLTextureUpload)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_VideoGLTextureUpload
cb' = Maybe (Ptr (FunPtr C_VideoGLTextureUpload))
-> VideoGLTextureUpload -> C_VideoGLTextureUpload
wrap_VideoGLTextureUpload Maybe (Ptr (FunPtr C_VideoGLTextureUpload))
forall a. Maybe a
Nothing VideoGLTextureUpload
cb
    C_VideoGLTextureUpload -> IO (FunPtr C_VideoGLTextureUpload)
mk_VideoGLTextureUpload C_VideoGLTextureUpload
cb' IO (FunPtr C_VideoGLTextureUpload)
-> (FunPtr C_VideoGLTextureUpload
    -> IO (GClosure C_VideoGLTextureUpload))
-> IO (GClosure C_VideoGLTextureUpload)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_VideoGLTextureUpload
-> IO (GClosure C_VideoGLTextureUpload)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `VideoGLTextureUpload` into a `C_VideoGLTextureUpload`.
wrap_VideoGLTextureUpload ::
    Maybe (Ptr (FunPtr C_VideoGLTextureUpload)) ->
    VideoGLTextureUpload ->
    C_VideoGLTextureUpload
wrap_VideoGLTextureUpload :: Maybe (Ptr (FunPtr C_VideoGLTextureUpload))
-> VideoGLTextureUpload -> C_VideoGLTextureUpload
wrap_VideoGLTextureUpload funptrptr :: Maybe (Ptr (FunPtr C_VideoGLTextureUpload))
funptrptr _cb :: VideoGLTextureUpload
_cb meta :: Ptr VideoGLTextureUploadMeta
meta textureId :: Word32
textureId = do
    VideoGLTextureUploadMeta
meta' <- ((ManagedPtr VideoGLTextureUploadMeta -> VideoGLTextureUploadMeta)
-> Ptr VideoGLTextureUploadMeta -> IO VideoGLTextureUploadMeta
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr VideoGLTextureUploadMeta -> VideoGLTextureUploadMeta
GstVideo.VideoGLTextureUploadMeta.VideoGLTextureUploadMeta) Ptr VideoGLTextureUploadMeta
meta
    Bool
result <- VideoGLTextureUpload
_cb  VideoGLTextureUploadMeta
meta' Word32
textureId
    Maybe (Ptr (FunPtr C_VideoGLTextureUpload)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_VideoGLTextureUpload))
funptrptr
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- callback VideoFormatUnpack
--          -> Callable {returnType = Nothing, returnMayBeNull = False, returnTransfer = TransferNothing, returnDocumentation = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, args = [Arg {argCName = "info", argType = TInterface (Name {namespace = "GstVideo", name = "VideoFormatInfo"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstVideoFormatInfo", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "flags", argType = TInterface (Name {namespace = "GstVideo", name = "VideoPackFlags"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "flags to control the unpacking", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "dest", argType = TBasicType TPtr, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "a destination array", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "data", argType = TBasicType TPtr, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "pointers to the data planes", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "stride", argType = TBasicType TInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "strides of the planes", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "x", argType = TBasicType TInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the x position in the image to start from", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "y", argType = TBasicType TInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the y position in the image to start from", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "width", argType = TBasicType TInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the amount of pixels to unpack.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}], skipReturn = False, callableThrows = False, callableDeprecated = Nothing, callableDocumentation = Documentation {rawDocText = Just "Unpacks @width pixels from the given planes and strides containing data of\nformat @info. The pixels will be unpacked into @dest with each component\ninterleaved as per @info's unpack_format, which will usually be one of\n#GST_VIDEO_FORMAT_ARGB, #GST_VIDEO_FORMAT_AYUV, #GST_VIDEO_FORMAT_ARGB64 or\n#GST_VIDEO_FORMAT_AYUV64 depending on the format to unpack.\n@dest should at least be big enough to hold @width * bytes_per_pixel bytes\nwhere bytes_per_pixel relates to the unpack format and will usually be\neither 4 or 8 depending on the unpack format. bytes_per_pixel will be\nthe same as the pixel stride for plane 0 for the above formats.\n\nFor subsampled formats, the components will be duplicated in the destination\narray. Reconstruction of the missing components can be performed in a\nseparate step after unpacking.", sinceVersion = Nothing}}
-- | Type for the callback on the (unwrapped) C side.
type C_VideoFormatUnpack =
    Ptr GstVideo.VideoFormatInfo.VideoFormatInfo ->
    CUInt ->
    Ptr () ->
    Ptr () ->
    Int32 ->
    Int32 ->
    Int32 ->
    Int32 ->
    IO ()

-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoFormatInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoFormatInfo"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoPackFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags to control the unpacking"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a destination array"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pointers to the data planes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stride"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "strides of the planes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the x position in the image to start from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the y position in the image to start from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the amount of pixels to unpack."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_VideoFormatUnpack :: FunPtr C_VideoFormatUnpack -> C_VideoFormatUnpack

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_VideoFormatUnpack ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FunPtr C_VideoFormatUnpack
    -> GstVideo.VideoFormatInfo.VideoFormatInfo
    -- ^ /@info@/: a t'GI.GstVideo.Structs.VideoFormatInfo.VideoFormatInfo'
    -> [GstVideo.Flags.VideoPackFlags]
    -- ^ /@flags@/: flags to control the unpacking
    -> Ptr ()
    -- ^ /@dest@/: a destination array
    -> Ptr ()
    -- ^ /@data@/: pointers to the data planes
    -> Int32
    -- ^ /@stride@/: strides of the planes
    -> Int32
    -- ^ /@x@/: the x position in the image to start from
    -> Int32
    -- ^ /@y@/: the y position in the image to start from
    -> Int32
    -- ^ /@width@/: the amount of pixels to unpack.
    -> m ()
dynamic_VideoFormatUnpack :: FunPtr C_VideoFormatUnpack
-> VideoFormatInfo
-> [VideoPackFlags]
-> Ptr ()
-> Ptr ()
-> Int32
-> Int32
-> Int32
-> Int32
-> m ()
dynamic_VideoFormatUnpack __funPtr :: FunPtr C_VideoFormatUnpack
__funPtr info :: VideoFormatInfo
info flags :: [VideoPackFlags]
flags dest :: Ptr ()
dest data_ :: Ptr ()
data_ stride :: Int32
stride x :: Int32
x y :: Int32
y width :: Int32
width = 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 VideoFormatInfo
info' <- VideoFormatInfo -> IO (Ptr VideoFormatInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoFormatInfo
info
    let flags' :: CUInt
flags' = [VideoPackFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [VideoPackFlags]
flags
    (FunPtr C_VideoFormatUnpack -> C_VideoFormatUnpack
__dynamic_C_VideoFormatUnpack FunPtr C_VideoFormatUnpack
__funPtr) Ptr VideoFormatInfo
info' CUInt
flags' Ptr ()
dest Ptr ()
data_ Int32
stride Int32
x Int32
y Int32
width
    VideoFormatInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoFormatInfo
info
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Generate a function pointer callable from C code, from a `C_VideoFormatUnpack`.
foreign import ccall "wrapper"
    mk_VideoFormatUnpack :: C_VideoFormatUnpack -> IO (FunPtr C_VideoFormatUnpack)

-- | Unpacks /@width@/ pixels from the given planes and strides containing data of
-- format /@info@/. The pixels will be unpacked into /@dest@/ with each component
-- interleaved as per /@info@/\'s unpack_format, which will usually be one of
-- @/GST_VIDEO_FORMAT_ARGB/@, @/GST_VIDEO_FORMAT_AYUV/@, @/GST_VIDEO_FORMAT_ARGB64/@ or
-- @/GST_VIDEO_FORMAT_AYUV64/@ depending on the format to unpack.
-- /@dest@/ should at least be big enough to hold /@width@/ * bytes_per_pixel bytes
-- where bytes_per_pixel relates to the unpack format and will usually be
-- either 4 or 8 depending on the unpack format. bytes_per_pixel will be
-- the same as the pixel stride for plane 0 for the above formats.
-- 
-- For subsampled formats, the components will be duplicated in the destination
-- array. Reconstruction of the missing components can be performed in a
-- separate step after unpacking.
type VideoFormatUnpack =
    GstVideo.VideoFormatInfo.VideoFormatInfo
    -- ^ /@info@/: a t'GI.GstVideo.Structs.VideoFormatInfo.VideoFormatInfo'
    -> [GstVideo.Flags.VideoPackFlags]
    -- ^ /@flags@/: flags to control the unpacking
    -> Ptr ()
    -- ^ /@dest@/: a destination array
    -> Ptr ()
    -- ^ /@data@/: pointers to the data planes
    -> Int32
    -- ^ /@stride@/: strides of the planes
    -> Int32
    -- ^ /@x@/: the x position in the image to start from
    -> Int32
    -- ^ /@y@/: the y position in the image to start from
    -> Int32
    -- ^ /@width@/: the amount of pixels to unpack.
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `VideoFormatUnpack`@.
noVideoFormatUnpack :: Maybe VideoFormatUnpack
noVideoFormatUnpack :: Maybe VideoFormatUnpack
noVideoFormatUnpack = Maybe VideoFormatUnpack
forall a. Maybe a
Nothing

-- | Wrap the callback into a `GClosure`.
genClosure_VideoFormatUnpack :: MonadIO m => VideoFormatUnpack -> m (GClosure C_VideoFormatUnpack)
genClosure_VideoFormatUnpack :: VideoFormatUnpack -> m (GClosure C_VideoFormatUnpack)
genClosure_VideoFormatUnpack cb :: VideoFormatUnpack
cb = IO (GClosure C_VideoFormatUnpack)
-> m (GClosure C_VideoFormatUnpack)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_VideoFormatUnpack)
 -> m (GClosure C_VideoFormatUnpack))
-> IO (GClosure C_VideoFormatUnpack)
-> m (GClosure C_VideoFormatUnpack)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_VideoFormatUnpack
cb' = Maybe (Ptr (FunPtr C_VideoFormatUnpack))
-> VideoFormatUnpack -> C_VideoFormatUnpack
wrap_VideoFormatUnpack Maybe (Ptr (FunPtr C_VideoFormatUnpack))
forall a. Maybe a
Nothing VideoFormatUnpack
cb
    C_VideoFormatUnpack -> IO (FunPtr C_VideoFormatUnpack)
mk_VideoFormatUnpack C_VideoFormatUnpack
cb' IO (FunPtr C_VideoFormatUnpack)
-> (FunPtr C_VideoFormatUnpack
    -> IO (GClosure C_VideoFormatUnpack))
-> IO (GClosure C_VideoFormatUnpack)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_VideoFormatUnpack -> IO (GClosure C_VideoFormatUnpack)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `VideoFormatUnpack` into a `C_VideoFormatUnpack`.
wrap_VideoFormatUnpack ::
    Maybe (Ptr (FunPtr C_VideoFormatUnpack)) ->
    VideoFormatUnpack ->
    C_VideoFormatUnpack
wrap_VideoFormatUnpack :: Maybe (Ptr (FunPtr C_VideoFormatUnpack))
-> VideoFormatUnpack -> C_VideoFormatUnpack
wrap_VideoFormatUnpack funptrptr :: Maybe (Ptr (FunPtr C_VideoFormatUnpack))
funptrptr _cb :: VideoFormatUnpack
_cb info :: Ptr VideoFormatInfo
info flags :: CUInt
flags dest :: Ptr ()
dest data_ :: Ptr ()
data_ stride :: Int32
stride x :: Int32
x y :: Int32
y width :: Int32
width = do
    VideoFormatInfo
info' <- ((ManagedPtr VideoFormatInfo -> VideoFormatInfo)
-> Ptr VideoFormatInfo -> IO VideoFormatInfo
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr VideoFormatInfo -> VideoFormatInfo
GstVideo.VideoFormatInfo.VideoFormatInfo) Ptr VideoFormatInfo
info
    let flags' :: [VideoPackFlags]
flags' = CUInt -> [VideoPackFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
flags
    VideoFormatUnpack
_cb  VideoFormatInfo
info' [VideoPackFlags]
flags' Ptr ()
dest Ptr ()
data_ Int32
stride Int32
x Int32
y Int32
width
    Maybe (Ptr (FunPtr C_VideoFormatUnpack)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_VideoFormatUnpack))
funptrptr


-- callback VideoFormatPack
--          -> Callable {returnType = Nothing, returnMayBeNull = False, returnTransfer = TransferNothing, returnDocumentation = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, args = [Arg {argCName = "info", argType = TInterface (Name {namespace = "GstVideo", name = "VideoFormatInfo"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstVideoFormatInfo", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "flags", argType = TInterface (Name {namespace = "GstVideo", name = "VideoPackFlags"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "flags to control the packing", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "src", argType = TBasicType TPtr, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "a source array", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "sstride", argType = TBasicType TInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the source array stride", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "data", argType = TBasicType TPtr, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "pointers to the destination data planes", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "stride", argType = TBasicType TInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "strides of the destination planes", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "chroma_site", argType = TInterface (Name {namespace = "GstVideo", name = "VideoChromaSite"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the chroma siting of the target when subsampled (not used)", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "y", argType = TBasicType TInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the y position in the image to pack to", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "width", argType = TBasicType TInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the amount of pixels to pack.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}], skipReturn = False, callableThrows = False, callableDeprecated = Nothing, callableDocumentation = Documentation {rawDocText = Just "Packs @width pixels from @src to the given planes and strides in the\nformat @info. The pixels from source have each component interleaved\nand will be packed into the planes in @data.\n\nThis function operates on pack_lines lines, meaning that @src should\ncontain at least pack_lines lines with a stride of @sstride and @y\nshould be a multiple of pack_lines.\n\nSubsampled formats will use the horizontally and vertically cosited\ncomponent from the source. Subsampling should be performed before\npacking.\n\nBecause this function does not have a x coordinate, it is not possible to\npack pixels starting from an unaligned position. For tiled images this\nmeans that packing should start from a tile coordinate. For subsampled\nformats this means that a complete pixel needs to be packed.", sinceVersion = Nothing}}
-- | Type for the callback on the (unwrapped) C side.
type C_VideoFormatPack =
    Ptr GstVideo.VideoFormatInfo.VideoFormatInfo ->
    CUInt ->
    Ptr () ->
    Int32 ->
    Ptr () ->
    Int32 ->
    CUInt ->
    Int32 ->
    Int32 ->
    IO ()

-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoFormatInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoFormatInfo"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoPackFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags to control the packing"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a source array" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sstride"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the source array stride"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pointers to the destination data planes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stride"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "strides of the destination planes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "chroma_site"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoChromaSite" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the chroma siting of the target when subsampled (not used)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the y position in the image to pack to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the amount of pixels to pack."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_VideoFormatPack :: FunPtr C_VideoFormatPack -> C_VideoFormatPack

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_VideoFormatPack ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FunPtr C_VideoFormatPack
    -> GstVideo.VideoFormatInfo.VideoFormatInfo
    -- ^ /@info@/: a t'GI.GstVideo.Structs.VideoFormatInfo.VideoFormatInfo'
    -> [GstVideo.Flags.VideoPackFlags]
    -- ^ /@flags@/: flags to control the packing
    -> Ptr ()
    -- ^ /@src@/: a source array
    -> Int32
    -- ^ /@sstride@/: the source array stride
    -> Ptr ()
    -- ^ /@data@/: pointers to the destination data planes
    -> Int32
    -- ^ /@stride@/: strides of the destination planes
    -> [GstVideo.Flags.VideoChromaSite]
    -- ^ /@chromaSite@/: the chroma siting of the target when subsampled (not used)
    -> Int32
    -- ^ /@y@/: the y position in the image to pack to
    -> Int32
    -- ^ /@width@/: the amount of pixels to pack.
    -> m ()
dynamic_VideoFormatPack :: FunPtr C_VideoFormatPack
-> VideoFormatInfo
-> [VideoPackFlags]
-> Ptr ()
-> Int32
-> Ptr ()
-> Int32
-> [VideoChromaSite]
-> Int32
-> Int32
-> m ()
dynamic_VideoFormatPack __funPtr :: FunPtr C_VideoFormatPack
__funPtr info :: VideoFormatInfo
info flags :: [VideoPackFlags]
flags src :: Ptr ()
src sstride :: Int32
sstride data_ :: Ptr ()
data_ stride :: Int32
stride chromaSite :: [VideoChromaSite]
chromaSite y :: Int32
y width :: Int32
width = 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 VideoFormatInfo
info' <- VideoFormatInfo -> IO (Ptr VideoFormatInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoFormatInfo
info
    let flags' :: CUInt
flags' = [VideoPackFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [VideoPackFlags]
flags
    let chromaSite' :: CUInt
chromaSite' = [VideoChromaSite] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [VideoChromaSite]
chromaSite
    (FunPtr C_VideoFormatPack -> C_VideoFormatPack
__dynamic_C_VideoFormatPack FunPtr C_VideoFormatPack
__funPtr) Ptr VideoFormatInfo
info' CUInt
flags' Ptr ()
src Int32
sstride Ptr ()
data_ Int32
stride CUInt
chromaSite' Int32
y Int32
width
    VideoFormatInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoFormatInfo
info
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Generate a function pointer callable from C code, from a `C_VideoFormatPack`.
foreign import ccall "wrapper"
    mk_VideoFormatPack :: C_VideoFormatPack -> IO (FunPtr C_VideoFormatPack)

-- | Packs /@width@/ pixels from /@src@/ to the given planes and strides in the
-- format /@info@/. The pixels from source have each component interleaved
-- and will be packed into the planes in /@data@/.
-- 
-- This function operates on pack_lines lines, meaning that /@src@/ should
-- contain at least pack_lines lines with a stride of /@sstride@/ and /@y@/
-- should be a multiple of pack_lines.
-- 
-- Subsampled formats will use the horizontally and vertically cosited
-- component from the source. Subsampling should be performed before
-- packing.
-- 
-- Because this function does not have a x coordinate, it is not possible to
-- pack pixels starting from an unaligned position. For tiled images this
-- means that packing should start from a tile coordinate. For subsampled
-- formats this means that a complete pixel needs to be packed.
type VideoFormatPack =
    GstVideo.VideoFormatInfo.VideoFormatInfo
    -- ^ /@info@/: a t'GI.GstVideo.Structs.VideoFormatInfo.VideoFormatInfo'
    -> [GstVideo.Flags.VideoPackFlags]
    -- ^ /@flags@/: flags to control the packing
    -> Ptr ()
    -- ^ /@src@/: a source array
    -> Int32
    -- ^ /@sstride@/: the source array stride
    -> Ptr ()
    -- ^ /@data@/: pointers to the destination data planes
    -> Int32
    -- ^ /@stride@/: strides of the destination planes
    -> [GstVideo.Flags.VideoChromaSite]
    -- ^ /@chromaSite@/: the chroma siting of the target when subsampled (not used)
    -> Int32
    -- ^ /@y@/: the y position in the image to pack to
    -> Int32
    -- ^ /@width@/: the amount of pixels to pack.
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `VideoFormatPack`@.
noVideoFormatPack :: Maybe VideoFormatPack
noVideoFormatPack :: Maybe VideoFormatPack
noVideoFormatPack = Maybe VideoFormatPack
forall a. Maybe a
Nothing

-- | Wrap the callback into a `GClosure`.
genClosure_VideoFormatPack :: MonadIO m => VideoFormatPack -> m (GClosure C_VideoFormatPack)
genClosure_VideoFormatPack :: VideoFormatPack -> m (GClosure C_VideoFormatPack)
genClosure_VideoFormatPack cb :: VideoFormatPack
cb = IO (GClosure C_VideoFormatPack) -> m (GClosure C_VideoFormatPack)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_VideoFormatPack) -> m (GClosure C_VideoFormatPack))
-> IO (GClosure C_VideoFormatPack)
-> m (GClosure C_VideoFormatPack)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_VideoFormatPack
cb' = Maybe (Ptr (FunPtr C_VideoFormatPack))
-> VideoFormatPack -> C_VideoFormatPack
wrap_VideoFormatPack Maybe (Ptr (FunPtr C_VideoFormatPack))
forall a. Maybe a
Nothing VideoFormatPack
cb
    C_VideoFormatPack -> IO (FunPtr C_VideoFormatPack)
mk_VideoFormatPack C_VideoFormatPack
cb' IO (FunPtr C_VideoFormatPack)
-> (FunPtr C_VideoFormatPack -> IO (GClosure C_VideoFormatPack))
-> IO (GClosure C_VideoFormatPack)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_VideoFormatPack -> IO (GClosure C_VideoFormatPack)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `VideoFormatPack` into a `C_VideoFormatPack`.
wrap_VideoFormatPack ::
    Maybe (Ptr (FunPtr C_VideoFormatPack)) ->
    VideoFormatPack ->
    C_VideoFormatPack
wrap_VideoFormatPack :: Maybe (Ptr (FunPtr C_VideoFormatPack))
-> VideoFormatPack -> C_VideoFormatPack
wrap_VideoFormatPack funptrptr :: Maybe (Ptr (FunPtr C_VideoFormatPack))
funptrptr _cb :: VideoFormatPack
_cb info :: Ptr VideoFormatInfo
info flags :: CUInt
flags src :: Ptr ()
src sstride :: Int32
sstride data_ :: Ptr ()
data_ stride :: Int32
stride chromaSite :: CUInt
chromaSite y :: Int32
y width :: Int32
width = do
    VideoFormatInfo
info' <- ((ManagedPtr VideoFormatInfo -> VideoFormatInfo)
-> Ptr VideoFormatInfo -> IO VideoFormatInfo
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr VideoFormatInfo -> VideoFormatInfo
GstVideo.VideoFormatInfo.VideoFormatInfo) Ptr VideoFormatInfo
info
    let flags' :: [VideoPackFlags]
flags' = CUInt -> [VideoPackFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
flags
    let chromaSite' :: [VideoChromaSite]
chromaSite' = CUInt -> [VideoChromaSite]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
chromaSite
    VideoFormatPack
_cb  VideoFormatInfo
info' [VideoPackFlags]
flags' Ptr ()
src Int32
sstride Ptr ()
data_ Int32
stride [VideoChromaSite]
chromaSite' Int32
y Int32
width
    Maybe (Ptr (FunPtr C_VideoFormatPack)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_VideoFormatPack))
funptrptr


-- callback VideoConvertSampleCallback
--          -> Callable {returnType = Nothing, returnMayBeNull = False, returnTransfer = TransferNothing, returnDocumentation = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, args = [Arg {argCName = "sample", argType = TInterface (Name {namespace = "Gst", name = "Sample"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "error", argType = TError, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "user_data", argType = TBasicType TPtr, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = 2, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}], skipReturn = False, callableThrows = False, callableDeprecated = Nothing, callableDocumentation = Documentation {rawDocText = Nothing, sinceVersion = Nothing}}
-- | Type for the callback on the (unwrapped) C side.
type C_VideoConvertSampleCallback =
    Ptr Gst.Sample.Sample ->
    Ptr GError ->
    Ptr () ->
    IO ()

-- Args: [ Arg
--           { argCName = "sample"
--           , argType = TInterface Name { namespace = "Gst" , name = "Sample" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "error"
--           , argType = TError
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_VideoConvertSampleCallback :: FunPtr C_VideoConvertSampleCallback -> C_VideoConvertSampleCallback

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_VideoConvertSampleCallback ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FunPtr C_VideoConvertSampleCallback
    -> Gst.Sample.Sample
    -> GError
    -> Ptr ()
    -> m ()
dynamic_VideoConvertSampleCallback :: FunPtr C_VideoConvertSampleCallback
-> Sample -> GError -> Ptr () -> m ()
dynamic_VideoConvertSampleCallback __funPtr :: FunPtr C_VideoConvertSampleCallback
__funPtr sample :: Sample
sample error_ :: GError
error_ userData :: Ptr ()
userData = 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 Sample
sample' <- Sample -> IO (Ptr Sample)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Sample
sample
    Ptr GError
error_' <- GError -> IO (Ptr GError)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GError
error_
    (FunPtr C_VideoConvertSampleCallback -> C_VideoConvertSampleCallback
__dynamic_C_VideoConvertSampleCallback FunPtr C_VideoConvertSampleCallback
__funPtr) Ptr Sample
sample' Ptr GError
error_' Ptr ()
userData
    Sample -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Sample
sample
    GError -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GError
error_
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Generate a function pointer callable from C code, from a `C_VideoConvertSampleCallback`.
foreign import ccall "wrapper"
    mk_VideoConvertSampleCallback :: C_VideoConvertSampleCallback -> IO (FunPtr C_VideoConvertSampleCallback)

-- | /No description available in the introspection data./
type VideoConvertSampleCallback =
    Gst.Sample.Sample
    -> GError
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `VideoConvertSampleCallback`@.
noVideoConvertSampleCallback :: Maybe VideoConvertSampleCallback
noVideoConvertSampleCallback :: Maybe VideoConvertSampleCallback
noVideoConvertSampleCallback = Maybe VideoConvertSampleCallback
forall a. Maybe a
Nothing

-- | /No description available in the introspection data./
type VideoConvertSampleCallback_WithClosures =
    Gst.Sample.Sample
    -> GError
    -> Ptr ()
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `VideoConvertSampleCallback_WithClosures`@.
noVideoConvertSampleCallback_WithClosures :: Maybe VideoConvertSampleCallback_WithClosures
noVideoConvertSampleCallback_WithClosures :: Maybe VideoConvertSampleCallback_WithClosures
noVideoConvertSampleCallback_WithClosures = Maybe VideoConvertSampleCallback_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_VideoConvertSampleCallback :: VideoConvertSampleCallback -> VideoConvertSampleCallback_WithClosures
drop_closures_VideoConvertSampleCallback :: VideoConvertSampleCallback
-> VideoConvertSampleCallback_WithClosures
drop_closures_VideoConvertSampleCallback _f :: VideoConvertSampleCallback
_f sample :: Sample
sample error_ :: GError
error_ _ = VideoConvertSampleCallback
_f Sample
sample GError
error_

-- | Wrap the callback into a `GClosure`.
genClosure_VideoConvertSampleCallback :: MonadIO m => VideoConvertSampleCallback -> m (GClosure C_VideoConvertSampleCallback)
genClosure_VideoConvertSampleCallback :: VideoConvertSampleCallback
-> m (GClosure C_VideoConvertSampleCallback)
genClosure_VideoConvertSampleCallback cb :: VideoConvertSampleCallback
cb = IO (GClosure C_VideoConvertSampleCallback)
-> m (GClosure C_VideoConvertSampleCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_VideoConvertSampleCallback)
 -> m (GClosure C_VideoConvertSampleCallback))
-> IO (GClosure C_VideoConvertSampleCallback)
-> m (GClosure C_VideoConvertSampleCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: VideoConvertSampleCallback_WithClosures
cb' = VideoConvertSampleCallback
-> VideoConvertSampleCallback_WithClosures
drop_closures_VideoConvertSampleCallback VideoConvertSampleCallback
cb
    let cb'' :: C_VideoConvertSampleCallback
cb'' = Maybe (Ptr (FunPtr C_VideoConvertSampleCallback))
-> VideoConvertSampleCallback_WithClosures
-> C_VideoConvertSampleCallback
wrap_VideoConvertSampleCallback Maybe (Ptr (FunPtr C_VideoConvertSampleCallback))
forall a. Maybe a
Nothing VideoConvertSampleCallback_WithClosures
cb'
    C_VideoConvertSampleCallback
-> IO (FunPtr C_VideoConvertSampleCallback)
mk_VideoConvertSampleCallback C_VideoConvertSampleCallback
cb'' IO (FunPtr C_VideoConvertSampleCallback)
-> (FunPtr C_VideoConvertSampleCallback
    -> IO (GClosure C_VideoConvertSampleCallback))
-> IO (GClosure C_VideoConvertSampleCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_VideoConvertSampleCallback
-> IO (GClosure C_VideoConvertSampleCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `VideoConvertSampleCallback` into a `C_VideoConvertSampleCallback`.
wrap_VideoConvertSampleCallback ::
    Maybe (Ptr (FunPtr C_VideoConvertSampleCallback)) ->
    VideoConvertSampleCallback_WithClosures ->
    C_VideoConvertSampleCallback
wrap_VideoConvertSampleCallback :: Maybe (Ptr (FunPtr C_VideoConvertSampleCallback))
-> VideoConvertSampleCallback_WithClosures
-> C_VideoConvertSampleCallback
wrap_VideoConvertSampleCallback funptrptr :: Maybe (Ptr (FunPtr C_VideoConvertSampleCallback))
funptrptr _cb :: VideoConvertSampleCallback_WithClosures
_cb sample :: Ptr Sample
sample error_ :: Ptr GError
error_ userData :: Ptr ()
userData = do
    (ManagedPtr Sample -> Sample)
-> Ptr Sample -> (Sample -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
(ManagedPtr a -> a) -> Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient ManagedPtr Sample -> Sample
Gst.Sample.Sample Ptr Sample
sample ((Sample -> IO ()) -> IO ()) -> (Sample -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \sample' :: Sample
sample' -> do
        GError
error_' <- ((ManagedPtr GError -> GError) -> Ptr GError -> IO GError
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr GError -> GError
GError) Ptr GError
error_
        VideoConvertSampleCallback_WithClosures
_cb  Sample
sample' GError
error_' Ptr ()
userData
        Maybe (Ptr (FunPtr C_VideoConvertSampleCallback)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_VideoConvertSampleCallback))
funptrptr


-- callback VideoAffineTransformationGetMatrix
--          -> Callable {returnType = Just (TBasicType TBoolean), returnMayBeNull = False, returnTransfer = TransferNothing, returnDocumentation = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, args = [Arg {argCName = "meta", argType = TInterface (Name {namespace = "GstVideo", name = "VideoAffineTransformationMeta"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "matrix", argType = TBasicType TFloat, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}], skipReturn = False, callableThrows = False, callableDeprecated = Nothing, callableDocumentation = Documentation {rawDocText = Nothing, sinceVersion = Nothing}}
-- | Type for the callback on the (unwrapped) C side.
type C_VideoAffineTransformationGetMatrix =
    Ptr GstVideo.VideoAffineTransformationMeta.VideoAffineTransformationMeta ->
    CFloat ->
    IO CInt

-- Args: [ Arg
--           { argCName = "meta"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "GstVideo" , name = "VideoAffineTransformationMeta" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "matrix"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 "dynamic" __dynamic_C_VideoAffineTransformationGetMatrix :: FunPtr C_VideoAffineTransformationGetMatrix -> C_VideoAffineTransformationGetMatrix

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_VideoAffineTransformationGetMatrix ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FunPtr C_VideoAffineTransformationGetMatrix
    -> GstVideo.VideoAffineTransformationMeta.VideoAffineTransformationMeta
    -> Float
    -> m Bool
dynamic_VideoAffineTransformationGetMatrix :: FunPtr C_VideoAffineTransformationGetMatrix
-> VideoAffineTransformationMeta -> Float -> m Bool
dynamic_VideoAffineTransformationGetMatrix __funPtr :: FunPtr C_VideoAffineTransformationGetMatrix
__funPtr meta :: VideoAffineTransformationMeta
meta matrix :: Float
matrix = 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 VideoAffineTransformationMeta
meta' <- VideoAffineTransformationMeta
-> IO (Ptr VideoAffineTransformationMeta)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoAffineTransformationMeta
meta
    let matrix' :: CFloat
matrix' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
matrix
    CInt
result <- (FunPtr C_VideoAffineTransformationGetMatrix
-> C_VideoAffineTransformationGetMatrix
__dynamic_C_VideoAffineTransformationGetMatrix FunPtr C_VideoAffineTransformationGetMatrix
__funPtr) Ptr VideoAffineTransformationMeta
meta' CFloat
matrix'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    VideoAffineTransformationMeta -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoAffineTransformationMeta
meta
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

-- | Generate a function pointer callable from C code, from a `C_VideoAffineTransformationGetMatrix`.
foreign import ccall "wrapper"
    mk_VideoAffineTransformationGetMatrix :: C_VideoAffineTransformationGetMatrix -> IO (FunPtr C_VideoAffineTransformationGetMatrix)

-- | /No description available in the introspection data./
type VideoAffineTransformationGetMatrix =
    GstVideo.VideoAffineTransformationMeta.VideoAffineTransformationMeta
    -> Float
    -> IO Bool

-- | A convenience synonym for @`Nothing` :: `Maybe` `VideoAffineTransformationGetMatrix`@.
noVideoAffineTransformationGetMatrix :: Maybe VideoAffineTransformationGetMatrix
noVideoAffineTransformationGetMatrix :: Maybe VideoAffineTransformationGetMatrix
noVideoAffineTransformationGetMatrix = Maybe VideoAffineTransformationGetMatrix
forall a. Maybe a
Nothing

-- | Wrap the callback into a `GClosure`.
genClosure_VideoAffineTransformationGetMatrix :: MonadIO m => VideoAffineTransformationGetMatrix -> m (GClosure C_VideoAffineTransformationGetMatrix)
genClosure_VideoAffineTransformationGetMatrix :: VideoAffineTransformationGetMatrix
-> m (GClosure C_VideoAffineTransformationGetMatrix)
genClosure_VideoAffineTransformationGetMatrix cb :: VideoAffineTransformationGetMatrix
cb = IO (GClosure C_VideoAffineTransformationGetMatrix)
-> m (GClosure C_VideoAffineTransformationGetMatrix)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_VideoAffineTransformationGetMatrix)
 -> m (GClosure C_VideoAffineTransformationGetMatrix))
-> IO (GClosure C_VideoAffineTransformationGetMatrix)
-> m (GClosure C_VideoAffineTransformationGetMatrix)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_VideoAffineTransformationGetMatrix
cb' = Maybe (Ptr (FunPtr C_VideoAffineTransformationGetMatrix))
-> VideoAffineTransformationGetMatrix
-> C_VideoAffineTransformationGetMatrix
wrap_VideoAffineTransformationGetMatrix Maybe (Ptr (FunPtr C_VideoAffineTransformationGetMatrix))
forall a. Maybe a
Nothing VideoAffineTransformationGetMatrix
cb
    C_VideoAffineTransformationGetMatrix
-> IO (FunPtr C_VideoAffineTransformationGetMatrix)
mk_VideoAffineTransformationGetMatrix C_VideoAffineTransformationGetMatrix
cb' IO (FunPtr C_VideoAffineTransformationGetMatrix)
-> (FunPtr C_VideoAffineTransformationGetMatrix
    -> IO (GClosure C_VideoAffineTransformationGetMatrix))
-> IO (GClosure C_VideoAffineTransformationGetMatrix)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_VideoAffineTransformationGetMatrix
-> IO (GClosure C_VideoAffineTransformationGetMatrix)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `VideoAffineTransformationGetMatrix` into a `C_VideoAffineTransformationGetMatrix`.
wrap_VideoAffineTransformationGetMatrix ::
    Maybe (Ptr (FunPtr C_VideoAffineTransformationGetMatrix)) ->
    VideoAffineTransformationGetMatrix ->
    C_VideoAffineTransformationGetMatrix
wrap_VideoAffineTransformationGetMatrix :: Maybe (Ptr (FunPtr C_VideoAffineTransformationGetMatrix))
-> VideoAffineTransformationGetMatrix
-> C_VideoAffineTransformationGetMatrix
wrap_VideoAffineTransformationGetMatrix funptrptr :: Maybe (Ptr (FunPtr C_VideoAffineTransformationGetMatrix))
funptrptr _cb :: VideoAffineTransformationGetMatrix
_cb meta :: Ptr VideoAffineTransformationMeta
meta matrix :: CFloat
matrix = do
    VideoAffineTransformationMeta
meta' <- ((ManagedPtr VideoAffineTransformationMeta
 -> VideoAffineTransformationMeta)
-> Ptr VideoAffineTransformationMeta
-> IO VideoAffineTransformationMeta
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr VideoAffineTransformationMeta
-> VideoAffineTransformationMeta
GstVideo.VideoAffineTransformationMeta.VideoAffineTransformationMeta) Ptr VideoAffineTransformationMeta
meta
    let matrix' :: Float
matrix' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
matrix
    Bool
result <- VideoAffineTransformationGetMatrix
_cb  VideoAffineTransformationMeta
meta' Float
matrix'
    Maybe (Ptr (FunPtr C_VideoAffineTransformationGetMatrix)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_VideoAffineTransformationGetMatrix))
funptrptr
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'