{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Buffer metadata describing planar DSD contents in the buffer. This is not needed
-- for interleaved DSD data, and is required for non-interleaved (= planar) data.
-- 
-- The different channels in /@offsets@/ are always in the GStreamer channel order.
-- Zero-copy channel reordering can be implemented by swapping the values in
-- /@offsets@/.
-- 
-- It is not allowed for channels to overlap in memory,
-- i.e. for each i in [0, channels), the range
-- [/@offsets@/[i], /@offsets@/[i] + /@numBytesPerChannel@/) must not overlap
-- with any other such range.
-- 
-- It is, however, allowed to have parts of the buffer memory unused, by using
-- /@offsets@/ and /@numBytesPerChannel@/ in such a way that leave gaps on it.
-- This is used to implement zero-copy clipping in non-interleaved buffers.
-- 
-- Obviously, due to the above, it is not safe to infer the
-- number of valid bytes from the size of the buffer. You should always
-- use the /@numBytesPerChannel@/ variable of this metadata.
-- 
-- /Since: 1.24/

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

module GI.GstAudio.Structs.DsdPlaneOffsetMeta
    ( 

-- * Exported types
    DsdPlaneOffsetMeta(..)                  ,
    newZeroDsdPlaneOffsetMeta               ,


 -- * Methods

#if defined(ENABLE_OVERLOADING)
    ResolveDsdPlaneOffsetMetaMethod         ,
#endif

-- ** getInfo #method:getInfo#

    dsdPlaneOffsetMetaGetInfo               ,




 -- * Properties


-- ** meta #attr:meta#
-- | parent t'GI.Gst.Structs.Meta.Meta'

#if defined(ENABLE_OVERLOADING)
    dsdPlaneOffsetMeta_meta                 ,
#endif
    getDsdPlaneOffsetMetaMeta               ,


-- ** numBytesPerChannel #attr:numBytesPerChannel#
-- | the number of valid bytes per channel in the buffer

#if defined(ENABLE_OVERLOADING)
    dsdPlaneOffsetMeta_numBytesPerChannel   ,
#endif
    getDsdPlaneOffsetMetaNumBytesPerChannel ,
    setDsdPlaneOffsetMetaNumBytesPerChannel ,


-- ** numChannels #attr:numChannels#
-- | number of channels in the DSD data

#if defined(ENABLE_OVERLOADING)
    dsdPlaneOffsetMeta_numChannels          ,
#endif
    getDsdPlaneOffsetMetaNumChannels        ,
    setDsdPlaneOffsetMetaNumChannels        ,


-- ** offsets #attr:offsets#
-- | the offsets (in bytes) where each channel plane starts in the buffer

#if defined(ENABLE_OVERLOADING)
    dsdPlaneOffsetMeta_offsets              ,
#endif
    getDsdPlaneOffsetMetaOffsets            ,
    setDsdPlaneOffsetMetaOffsets            ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.Gst.Structs.Meta as Gst.Meta
import qualified GI.Gst.Structs.MetaInfo as Gst.MetaInfo

#else
import qualified GI.Gst.Structs.Meta as Gst.Meta
import qualified GI.Gst.Structs.MetaInfo as Gst.MetaInfo

#endif

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

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

instance BoxedPtr DsdPlaneOffsetMeta where
    boxedPtrCopy :: DsdPlaneOffsetMeta -> IO DsdPlaneOffsetMeta
boxedPtrCopy = \DsdPlaneOffsetMeta
p -> DsdPlaneOffsetMeta
-> (Ptr DsdPlaneOffsetMeta -> IO DsdPlaneOffsetMeta)
-> IO DsdPlaneOffsetMeta
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr DsdPlaneOffsetMeta
p (Int -> Ptr DsdPlaneOffsetMeta -> IO (Ptr DsdPlaneOffsetMeta)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
136 (Ptr DsdPlaneOffsetMeta -> IO (Ptr DsdPlaneOffsetMeta))
-> (Ptr DsdPlaneOffsetMeta -> IO DsdPlaneOffsetMeta)
-> Ptr DsdPlaneOffsetMeta
-> IO DsdPlaneOffsetMeta
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr DsdPlaneOffsetMeta -> DsdPlaneOffsetMeta)
-> Ptr DsdPlaneOffsetMeta -> IO DsdPlaneOffsetMeta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr DsdPlaneOffsetMeta -> DsdPlaneOffsetMeta
DsdPlaneOffsetMeta)
    boxedPtrFree :: DsdPlaneOffsetMeta -> IO ()
boxedPtrFree = \DsdPlaneOffsetMeta
x -> DsdPlaneOffsetMeta -> (Ptr DsdPlaneOffsetMeta -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr DsdPlaneOffsetMeta
x Ptr DsdPlaneOffsetMeta -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr DsdPlaneOffsetMeta where
    boxedPtrCalloc :: IO (Ptr DsdPlaneOffsetMeta)
boxedPtrCalloc = Int -> IO (Ptr DsdPlaneOffsetMeta)
forall a. Int -> IO (Ptr a)
callocBytes Int
136


-- | Construct a `DsdPlaneOffsetMeta` struct initialized to zero.
newZeroDsdPlaneOffsetMeta :: MonadIO m => m DsdPlaneOffsetMeta
newZeroDsdPlaneOffsetMeta :: forall (m :: * -> *). MonadIO m => m DsdPlaneOffsetMeta
newZeroDsdPlaneOffsetMeta = IO DsdPlaneOffsetMeta -> m DsdPlaneOffsetMeta
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DsdPlaneOffsetMeta -> m DsdPlaneOffsetMeta)
-> IO DsdPlaneOffsetMeta -> m DsdPlaneOffsetMeta
forall a b. (a -> b) -> a -> b
$ IO (Ptr DsdPlaneOffsetMeta)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr DsdPlaneOffsetMeta)
-> (Ptr DsdPlaneOffsetMeta -> IO DsdPlaneOffsetMeta)
-> IO DsdPlaneOffsetMeta
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr DsdPlaneOffsetMeta -> DsdPlaneOffsetMeta)
-> Ptr DsdPlaneOffsetMeta -> IO DsdPlaneOffsetMeta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr DsdPlaneOffsetMeta -> DsdPlaneOffsetMeta
DsdPlaneOffsetMeta

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


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

#if defined(ENABLE_OVERLOADING)
data DsdPlaneOffsetMetaMetaFieldInfo
instance AttrInfo DsdPlaneOffsetMetaMetaFieldInfo where
    type AttrBaseTypeConstraint DsdPlaneOffsetMetaMetaFieldInfo = (~) DsdPlaneOffsetMeta
    type AttrAllowedOps DsdPlaneOffsetMetaMetaFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint DsdPlaneOffsetMetaMetaFieldInfo = (~) (Ptr Gst.Meta.Meta)
    type AttrTransferTypeConstraint DsdPlaneOffsetMetaMetaFieldInfo = (~)(Ptr Gst.Meta.Meta)
    type AttrTransferType DsdPlaneOffsetMetaMetaFieldInfo = (Ptr Gst.Meta.Meta)
    type AttrGetType DsdPlaneOffsetMetaMetaFieldInfo = Gst.Meta.Meta
    type AttrLabel DsdPlaneOffsetMetaMetaFieldInfo = "meta"
    type AttrOrigin DsdPlaneOffsetMetaMetaFieldInfo = DsdPlaneOffsetMeta
    attrGet = getDsdPlaneOffsetMetaMeta
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstAudio.Structs.DsdPlaneOffsetMeta.meta"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstaudio-1.0.28/docs/GI-GstAudio-Structs-DsdPlaneOffsetMeta.html#g:attr:meta"
        })

dsdPlaneOffsetMeta_meta :: AttrLabelProxy "meta"
dsdPlaneOffsetMeta_meta = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data DsdPlaneOffsetMetaNumChannelsFieldInfo
instance AttrInfo DsdPlaneOffsetMetaNumChannelsFieldInfo where
    type AttrBaseTypeConstraint DsdPlaneOffsetMetaNumChannelsFieldInfo = (~) DsdPlaneOffsetMeta
    type AttrAllowedOps DsdPlaneOffsetMetaNumChannelsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DsdPlaneOffsetMetaNumChannelsFieldInfo = (~) Int32
    type AttrTransferTypeConstraint DsdPlaneOffsetMetaNumChannelsFieldInfo = (~)Int32
    type AttrTransferType DsdPlaneOffsetMetaNumChannelsFieldInfo = Int32
    type AttrGetType DsdPlaneOffsetMetaNumChannelsFieldInfo = Int32
    type AttrLabel DsdPlaneOffsetMetaNumChannelsFieldInfo = "num_channels"
    type AttrOrigin DsdPlaneOffsetMetaNumChannelsFieldInfo = DsdPlaneOffsetMeta
    attrGet = getDsdPlaneOffsetMetaNumChannels
    attrSet = setDsdPlaneOffsetMetaNumChannels
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstAudio.Structs.DsdPlaneOffsetMeta.numChannels"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstaudio-1.0.28/docs/GI-GstAudio-Structs-DsdPlaneOffsetMeta.html#g:attr:numChannels"
        })

dsdPlaneOffsetMeta_numChannels :: AttrLabelProxy "numChannels"
dsdPlaneOffsetMeta_numChannels = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data DsdPlaneOffsetMetaNumBytesPerChannelFieldInfo
instance AttrInfo DsdPlaneOffsetMetaNumBytesPerChannelFieldInfo where
    type AttrBaseTypeConstraint DsdPlaneOffsetMetaNumBytesPerChannelFieldInfo = (~) DsdPlaneOffsetMeta
    type AttrAllowedOps DsdPlaneOffsetMetaNumBytesPerChannelFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DsdPlaneOffsetMetaNumBytesPerChannelFieldInfo = (~) FCT.CSize
    type AttrTransferTypeConstraint DsdPlaneOffsetMetaNumBytesPerChannelFieldInfo = (~)FCT.CSize
    type AttrTransferType DsdPlaneOffsetMetaNumBytesPerChannelFieldInfo = FCT.CSize
    type AttrGetType DsdPlaneOffsetMetaNumBytesPerChannelFieldInfo = FCT.CSize
    type AttrLabel DsdPlaneOffsetMetaNumBytesPerChannelFieldInfo = "num_bytes_per_channel"
    type AttrOrigin DsdPlaneOffsetMetaNumBytesPerChannelFieldInfo = DsdPlaneOffsetMeta
    attrGet = getDsdPlaneOffsetMetaNumBytesPerChannel
    attrSet = setDsdPlaneOffsetMetaNumBytesPerChannel
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstAudio.Structs.DsdPlaneOffsetMeta.numBytesPerChannel"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstaudio-1.0.28/docs/GI-GstAudio-Structs-DsdPlaneOffsetMeta.html#g:attr:numBytesPerChannel"
        })

dsdPlaneOffsetMeta_numBytesPerChannel :: AttrLabelProxy "numBytesPerChannel"
dsdPlaneOffsetMeta_numBytesPerChannel = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data DsdPlaneOffsetMetaOffsetsFieldInfo
instance AttrInfo DsdPlaneOffsetMetaOffsetsFieldInfo where
    type AttrBaseTypeConstraint DsdPlaneOffsetMetaOffsetsFieldInfo = (~) DsdPlaneOffsetMeta
    type AttrAllowedOps DsdPlaneOffsetMetaOffsetsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint DsdPlaneOffsetMetaOffsetsFieldInfo = (~) FCT.CSize
    type AttrTransferTypeConstraint DsdPlaneOffsetMetaOffsetsFieldInfo = (~)FCT.CSize
    type AttrTransferType DsdPlaneOffsetMetaOffsetsFieldInfo = FCT.CSize
    type AttrGetType DsdPlaneOffsetMetaOffsetsFieldInfo = FCT.CSize
    type AttrLabel DsdPlaneOffsetMetaOffsetsFieldInfo = "offsets"
    type AttrOrigin DsdPlaneOffsetMetaOffsetsFieldInfo = DsdPlaneOffsetMeta
    attrGet = getDsdPlaneOffsetMetaOffsets
    attrSet = setDsdPlaneOffsetMetaOffsets
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstAudio.Structs.DsdPlaneOffsetMeta.offsets"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstaudio-1.0.28/docs/GI-GstAudio-Structs-DsdPlaneOffsetMeta.html#g:attr:offsets"
        })

dsdPlaneOffsetMeta_offsets :: AttrLabelProxy "offsets"
dsdPlaneOffsetMeta_offsets = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DsdPlaneOffsetMeta
type instance O.AttributeList DsdPlaneOffsetMeta = DsdPlaneOffsetMetaAttributeList
type DsdPlaneOffsetMetaAttributeList = ('[ '("meta", DsdPlaneOffsetMetaMetaFieldInfo), '("numChannels", DsdPlaneOffsetMetaNumChannelsFieldInfo), '("numBytesPerChannel", DsdPlaneOffsetMetaNumBytesPerChannelFieldInfo), '("offsets", DsdPlaneOffsetMetaOffsetsFieldInfo)] :: [(Symbol, DK.Type)])
#endif

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

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

-- | /No description available in the introspection data./
dsdPlaneOffsetMetaGetInfo ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Gst.MetaInfo.MetaInfo
dsdPlaneOffsetMetaGetInfo :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m MetaInfo
dsdPlaneOffsetMetaGetInfo  = IO MetaInfo -> m MetaInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MetaInfo -> m MetaInfo) -> IO MetaInfo -> m MetaInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaInfo
result <- IO (Ptr MetaInfo)
gst_dsd_plane_offset_meta_get_info
    Text -> Ptr MetaInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dsdPlaneOffsetMetaGetInfo" Ptr MetaInfo
result
    MetaInfo
result' <- ((ManagedPtr MetaInfo -> MetaInfo) -> Ptr MetaInfo -> IO MetaInfo
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr MetaInfo -> MetaInfo
Gst.MetaInfo.MetaInfo) Ptr MetaInfo
result
    MetaInfo -> IO MetaInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MetaInfo
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveDsdPlaneOffsetMetaMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveDsdPlaneOffsetMetaMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveDsdPlaneOffsetMetaMethod t DsdPlaneOffsetMeta, O.OverloadedMethod info DsdPlaneOffsetMeta p) => OL.IsLabel t (DsdPlaneOffsetMeta -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveDsdPlaneOffsetMetaMethod t DsdPlaneOffsetMeta, O.OverloadedMethod info DsdPlaneOffsetMeta p, R.HasField t DsdPlaneOffsetMeta p) => R.HasField t DsdPlaneOffsetMeta p where
    getField = O.overloadedMethod @info

#endif

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

#endif