{-# language CPP #-}
-- No documentation found for Chapter "Promoted_From_VK_KHR_device_groupAndVK_KHR_bind_memory2"
module Vulkan.Core11.Promoted_From_VK_KHR_device_groupAndVK_KHR_bind_memory2  ( BindBufferMemoryDeviceGroupInfo(..)
                                                                              , BindImageMemoryDeviceGroupInfo(..)
                                                                              , StructureType(..)
                                                                              , ImageCreateFlagBits(..)
                                                                              , ImageCreateFlags
                                                                              ) where

import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Data.Typeable (Typeable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import GHC.Generics (Generic)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.CStruct.Utils (advancePtrBytes)
import Vulkan.Core10.FundamentalTypes (Rect2D)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_BIND_BUFFER_MEMORY_DEVICE_GROUP_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_BIND_IMAGE_MEMORY_DEVICE_GROUP_INFO))
import Vulkan.Core10.Enums.ImageCreateFlagBits (ImageCreateFlagBits(..))
import Vulkan.Core10.Enums.ImageCreateFlagBits (ImageCreateFlags)
import Vulkan.Core10.Enums.StructureType (StructureType(..))
-- | VkBindBufferMemoryDeviceGroupInfo - Structure specifying device within a
-- group to bind to
--
-- = Description
--
-- If the @pNext@ chain of
-- 'Vulkan.Core11.Promoted_From_VK_KHR_bind_memory2.BindBufferMemoryInfo'
-- includes a 'BindBufferMemoryDeviceGroupInfo' structure, then that
-- structure determines how memory is bound to buffers across multiple
-- devices in a device group.
--
-- If @deviceIndexCount@ is greater than zero, then on device index i the
-- buffer is attached to the instance of @memory@ on the physical device
-- with device index @pDeviceIndices@[i].
--
-- If @deviceIndexCount@ is zero and @memory@ comes from a memory heap with
-- the
-- 'Vulkan.Core10.Enums.MemoryHeapFlagBits.MEMORY_HEAP_MULTI_INSTANCE_BIT'
-- bit set, then it is as if @pDeviceIndices@ contains consecutive indices
-- from zero to the number of physical devices in the logical device, minus
-- one. In other words, by default each physical device attaches to its own
-- instance of @memory@.
--
-- If @deviceIndexCount@ is zero and @memory@ comes from a memory heap
-- without the
-- 'Vulkan.Core10.Enums.MemoryHeapFlagBits.MEMORY_HEAP_MULTI_INSTANCE_BIT'
-- bit set, then it is as if @pDeviceIndices@ contains an array of zeros.
-- In other words, by default each physical device attaches to instance
-- zero.
--
-- == Valid Usage
--
-- -   #VUID-VkBindBufferMemoryDeviceGroupInfo-deviceIndexCount-01606#
--     @deviceIndexCount@ /must/ either be zero or equal to the number of
--     physical devices in the logical device
--
-- -   #VUID-VkBindBufferMemoryDeviceGroupInfo-pDeviceIndices-01607# All
--     elements of @pDeviceIndices@ /must/ be valid device indices
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkBindBufferMemoryDeviceGroupInfo-sType-sType# @sType@ /must/
--     be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_BIND_BUFFER_MEMORY_DEVICE_GROUP_INFO'
--
-- -   #VUID-VkBindBufferMemoryDeviceGroupInfo-pDeviceIndices-parameter# If
--     @deviceIndexCount@ is not @0@, @pDeviceIndices@ /must/ be a valid
--     pointer to an array of @deviceIndexCount@ @uint32_t@ values
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_1 VK_VERSION_1_1>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data BindBufferMemoryDeviceGroupInfo = BindBufferMemoryDeviceGroupInfo
  { -- | @pDeviceIndices@ is a pointer to an array of device indices.
    BindBufferMemoryDeviceGroupInfo -> Vector Word32
deviceIndices :: Vector Word32 }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (BindBufferMemoryDeviceGroupInfo)
#endif
deriving instance Show BindBufferMemoryDeviceGroupInfo

instance ToCStruct BindBufferMemoryDeviceGroupInfo where
  withCStruct :: forall b.
BindBufferMemoryDeviceGroupInfo
-> (Ptr BindBufferMemoryDeviceGroupInfo -> IO b) -> IO b
withCStruct BindBufferMemoryDeviceGroupInfo
x Ptr BindBufferMemoryDeviceGroupInfo -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \Ptr BindBufferMemoryDeviceGroupInfo
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr BindBufferMemoryDeviceGroupInfo
p BindBufferMemoryDeviceGroupInfo
x (Ptr BindBufferMemoryDeviceGroupInfo -> IO b
f Ptr BindBufferMemoryDeviceGroupInfo
p)
  pokeCStruct :: forall b.
Ptr BindBufferMemoryDeviceGroupInfo
-> BindBufferMemoryDeviceGroupInfo -> IO b -> IO b
pokeCStruct Ptr BindBufferMemoryDeviceGroupInfo
p BindBufferMemoryDeviceGroupInfo{Vector Word32
deviceIndices :: Vector Word32
$sel:deviceIndices:BindBufferMemoryDeviceGroupInfo :: BindBufferMemoryDeviceGroupInfo -> Vector Word32
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindBufferMemoryDeviceGroupInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_BIND_BUFFER_MEMORY_DEVICE_GROUP_INFO)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindBufferMemoryDeviceGroupInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindBufferMemoryDeviceGroupInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector Word32
deviceIndices)) :: Word32))
    Ptr Word32
pPDeviceIndices' <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @Word32 ((forall a. Vector a -> Int
Data.Vector.length (Vector Word32
deviceIndices)) forall a. Num a => a -> a -> a
* Int
4)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Word32
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word32
pPDeviceIndices' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
4 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32) (Word32
e)) (Vector Word32
deviceIndices)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindBufferMemoryDeviceGroupInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr Word32))) (Ptr Word32
pPDeviceIndices')
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr BindBufferMemoryDeviceGroupInfo -> IO b -> IO b
pokeZeroCStruct Ptr BindBufferMemoryDeviceGroupInfo
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindBufferMemoryDeviceGroupInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_BIND_BUFFER_MEMORY_DEVICE_GROUP_INFO)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindBufferMemoryDeviceGroupInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    IO b
f

instance FromCStruct BindBufferMemoryDeviceGroupInfo where
  peekCStruct :: Ptr BindBufferMemoryDeviceGroupInfo
-> IO BindBufferMemoryDeviceGroupInfo
peekCStruct Ptr BindBufferMemoryDeviceGroupInfo
p = do
    Word32
deviceIndexCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr BindBufferMemoryDeviceGroupInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    Ptr Word32
pDeviceIndices <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr Word32) ((Ptr BindBufferMemoryDeviceGroupInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr Word32)))
    Vector Word32
pDeviceIndices' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
deviceIndexCount) (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr Word32
pDeviceIndices forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
4 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32)))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Vector Word32 -> BindBufferMemoryDeviceGroupInfo
BindBufferMemoryDeviceGroupInfo
             Vector Word32
pDeviceIndices'

instance Zero BindBufferMemoryDeviceGroupInfo where
  zero :: BindBufferMemoryDeviceGroupInfo
zero = Vector Word32 -> BindBufferMemoryDeviceGroupInfo
BindBufferMemoryDeviceGroupInfo
           forall a. Monoid a => a
mempty


-- | VkBindImageMemoryDeviceGroupInfo - Structure specifying device within a
-- group to bind to
--
-- = Description
--
-- If the @pNext@ chain of
-- 'Vulkan.Core11.Promoted_From_VK_KHR_bind_memory2.BindImageMemoryInfo'
-- includes a 'BindImageMemoryDeviceGroupInfo' structure, then that
-- structure determines how memory is bound to images across multiple
-- devices in a device group.
--
-- If @deviceIndexCount@ is greater than zero, then on device index i
-- @image@ is attached to the instance of the memory on the physical device
-- with device index @pDeviceIndices@[i].
--
-- Let N be the number of physical devices in the logical device. If
-- @splitInstanceBindRegionCount@ is greater than zero, then
-- @pSplitInstanceBindRegions@ is a pointer to an array of N2 rectangles,
-- where the image region specified by the rectangle at element i*N+j in
-- resource instance i is bound to the memory instance j. The blocks of the
-- memory that are bound to each sparse image block region use an offset in
-- memory, relative to @memoryOffset@, computed as if the whole image was
-- being bound to a contiguous range of memory. In other words,
-- horizontally adjacent image blocks use consecutive blocks of memory,
-- vertically adjacent image blocks are separated by the number of bytes
-- per block multiplied by the width in blocks of @image@, and the block at
-- (0,0) corresponds to memory starting at @memoryOffset@.
--
-- If @splitInstanceBindRegionCount@ and @deviceIndexCount@ are zero and
-- the memory comes from a memory heap with the
-- 'Vulkan.Core10.Enums.MemoryHeapFlagBits.MEMORY_HEAP_MULTI_INSTANCE_BIT'
-- bit set, then it is as if @pDeviceIndices@ contains consecutive indices
-- from zero to the number of physical devices in the logical device, minus
-- one. In other words, by default each physical device attaches to its own
-- instance of the memory.
--
-- If @splitInstanceBindRegionCount@ and @deviceIndexCount@ are zero and
-- the memory comes from a memory heap without the
-- 'Vulkan.Core10.Enums.MemoryHeapFlagBits.MEMORY_HEAP_MULTI_INSTANCE_BIT'
-- bit set, then it is as if @pDeviceIndices@ contains an array of zeros.
-- In other words, by default each physical device attaches to instance
-- zero.
--
-- == Valid Usage
--
-- -   #VUID-VkBindImageMemoryDeviceGroupInfo-deviceIndexCount-01633# At
--     least one of @deviceIndexCount@ and @splitInstanceBindRegionCount@
--     /must/ be zero
--
-- -   #VUID-VkBindImageMemoryDeviceGroupInfo-deviceIndexCount-01634#
--     @deviceIndexCount@ /must/ either be zero or equal to the number of
--     physical devices in the logical device
--
-- -   #VUID-VkBindImageMemoryDeviceGroupInfo-pDeviceIndices-01635# All
--     elements of @pDeviceIndices@ /must/ be valid device indices
--
-- -   #VUID-VkBindImageMemoryDeviceGroupInfo-splitInstanceBindRegionCount-01636#
--     @splitInstanceBindRegionCount@ /must/ either be zero or equal to the
--     number of physical devices in the logical device squared
--
-- -   #VUID-VkBindImageMemoryDeviceGroupInfo-pSplitInstanceBindRegions-01637#
--     Elements of @pSplitInstanceBindRegions@ that correspond to the same
--     instance of an image /must/ not overlap
--
-- -   #VUID-VkBindImageMemoryDeviceGroupInfo-offset-01638# The @offset.x@
--     member of any element of @pSplitInstanceBindRegions@ /must/ be a
--     multiple of the sparse image block width
--     ('Vulkan.Core10.SparseResourceMemoryManagement.SparseImageFormatProperties'::@imageGranularity.width@)
--     of all non-metadata aspects of the image
--
-- -   #VUID-VkBindImageMemoryDeviceGroupInfo-offset-01639# The @offset.y@
--     member of any element of @pSplitInstanceBindRegions@ /must/ be a
--     multiple of the sparse image block height
--     ('Vulkan.Core10.SparseResourceMemoryManagement.SparseImageFormatProperties'::@imageGranularity.height@)
--     of all non-metadata aspects of the image
--
-- -   #VUID-VkBindImageMemoryDeviceGroupInfo-extent-01640# The
--     @extent.width@ member of any element of @pSplitInstanceBindRegions@
--     /must/ either be a multiple of the sparse image block width of all
--     non-metadata aspects of the image, or else @extent.width@ +
--     @offset.x@ /must/ equal the width of the image subresource
--
-- -   #VUID-VkBindImageMemoryDeviceGroupInfo-extent-01641# The
--     @extent.height@ member of any element of @pSplitInstanceBindRegions@
--     /must/ either be a multiple of the sparse image block height of all
--     non-metadata aspects of the image, or else @extent.height@ +
--     @offset.y@ /must/ equal the height of the image subresource
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkBindImageMemoryDeviceGroupInfo-sType-sType# @sType@ /must/
--     be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_BIND_IMAGE_MEMORY_DEVICE_GROUP_INFO'
--
-- -   #VUID-VkBindImageMemoryDeviceGroupInfo-pDeviceIndices-parameter# If
--     @deviceIndexCount@ is not @0@, @pDeviceIndices@ /must/ be a valid
--     pointer to an array of @deviceIndexCount@ @uint32_t@ values
--
-- -   #VUID-VkBindImageMemoryDeviceGroupInfo-pSplitInstanceBindRegions-parameter#
--     If @splitInstanceBindRegionCount@ is not @0@,
--     @pSplitInstanceBindRegions@ /must/ be a valid pointer to an array of
--     @splitInstanceBindRegionCount@
--     'Vulkan.Core10.FundamentalTypes.Rect2D' structures
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_1 VK_VERSION_1_1>,
-- 'Vulkan.Core10.FundamentalTypes.Rect2D',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data BindImageMemoryDeviceGroupInfo = BindImageMemoryDeviceGroupInfo
  { -- | @pDeviceIndices@ is a pointer to an array of device indices.
    BindImageMemoryDeviceGroupInfo -> Vector Word32
deviceIndices :: Vector Word32
  , -- | @pSplitInstanceBindRegions@ is a pointer to an array of
    -- 'Vulkan.Core10.FundamentalTypes.Rect2D' structures describing which
    -- regions of the image are attached to each instance of memory.
    BindImageMemoryDeviceGroupInfo -> Vector Rect2D
splitInstanceBindRegions :: Vector Rect2D
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (BindImageMemoryDeviceGroupInfo)
#endif
deriving instance Show BindImageMemoryDeviceGroupInfo

instance ToCStruct BindImageMemoryDeviceGroupInfo where
  withCStruct :: forall b.
BindImageMemoryDeviceGroupInfo
-> (Ptr BindImageMemoryDeviceGroupInfo -> IO b) -> IO b
withCStruct BindImageMemoryDeviceGroupInfo
x Ptr BindImageMemoryDeviceGroupInfo -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
48 forall a b. (a -> b) -> a -> b
$ \Ptr BindImageMemoryDeviceGroupInfo
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr BindImageMemoryDeviceGroupInfo
p BindImageMemoryDeviceGroupInfo
x (Ptr BindImageMemoryDeviceGroupInfo -> IO b
f Ptr BindImageMemoryDeviceGroupInfo
p)
  pokeCStruct :: forall b.
Ptr BindImageMemoryDeviceGroupInfo
-> BindImageMemoryDeviceGroupInfo -> IO b -> IO b
pokeCStruct Ptr BindImageMemoryDeviceGroupInfo
p BindImageMemoryDeviceGroupInfo{Vector Word32
Vector Rect2D
splitInstanceBindRegions :: Vector Rect2D
deviceIndices :: Vector Word32
$sel:splitInstanceBindRegions:BindImageMemoryDeviceGroupInfo :: BindImageMemoryDeviceGroupInfo -> Vector Rect2D
$sel:deviceIndices:BindImageMemoryDeviceGroupInfo :: BindImageMemoryDeviceGroupInfo -> Vector Word32
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindImageMemoryDeviceGroupInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_BIND_IMAGE_MEMORY_DEVICE_GROUP_INFO)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindImageMemoryDeviceGroupInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindImageMemoryDeviceGroupInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector Word32
deviceIndices)) :: Word32))
    Ptr Word32
pPDeviceIndices' <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @Word32 ((forall a. Vector a -> Int
Data.Vector.length (Vector Word32
deviceIndices)) forall a. Num a => a -> a -> a
* Int
4)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Word32
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word32
pPDeviceIndices' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
4 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32) (Word32
e)) (Vector Word32
deviceIndices)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindImageMemoryDeviceGroupInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr Word32))) (Ptr Word32
pPDeviceIndices')
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindImageMemoryDeviceGroupInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector Rect2D
splitInstanceBindRegions)) :: Word32))
    Ptr Rect2D
pPSplitInstanceBindRegions' <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @Rect2D ((forall a. Vector a -> Int
Data.Vector.length (Vector Rect2D
splitInstanceBindRegions)) forall a. Num a => a -> a -> a
* Int
16)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Rect2D
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Rect2D
pPSplitInstanceBindRegions' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
16 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Rect2D) (Rect2D
e)) (Vector Rect2D
splitInstanceBindRegions)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindImageMemoryDeviceGroupInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr Rect2D))) (Ptr Rect2D
pPSplitInstanceBindRegions')
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = Int
48
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr BindImageMemoryDeviceGroupInfo -> IO b -> IO b
pokeZeroCStruct Ptr BindImageMemoryDeviceGroupInfo
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindImageMemoryDeviceGroupInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_BIND_IMAGE_MEMORY_DEVICE_GROUP_INFO)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindImageMemoryDeviceGroupInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    IO b
f

instance FromCStruct BindImageMemoryDeviceGroupInfo where
  peekCStruct :: Ptr BindImageMemoryDeviceGroupInfo
-> IO BindImageMemoryDeviceGroupInfo
peekCStruct Ptr BindImageMemoryDeviceGroupInfo
p = do
    Word32
deviceIndexCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr BindImageMemoryDeviceGroupInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    Ptr Word32
pDeviceIndices <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr Word32) ((Ptr BindImageMemoryDeviceGroupInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr Word32)))
    Vector Word32
pDeviceIndices' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
deviceIndexCount) (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr Word32
pDeviceIndices forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
4 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32)))
    Word32
splitInstanceBindRegionCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr BindImageMemoryDeviceGroupInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32))
    Ptr Rect2D
pSplitInstanceBindRegions <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr Rect2D) ((Ptr BindImageMemoryDeviceGroupInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr Rect2D)))
    Vector Rect2D
pSplitInstanceBindRegions' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
splitInstanceBindRegionCount) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Rect2D ((Ptr Rect2D
pSplitInstanceBindRegions forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
16 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Rect2D)))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Vector Word32 -> Vector Rect2D -> BindImageMemoryDeviceGroupInfo
BindImageMemoryDeviceGroupInfo
             Vector Word32
pDeviceIndices' Vector Rect2D
pSplitInstanceBindRegions'

instance Zero BindImageMemoryDeviceGroupInfo where
  zero :: BindImageMemoryDeviceGroupInfo
zero = Vector Word32 -> Vector Rect2D -> BindImageMemoryDeviceGroupInfo
BindImageMemoryDeviceGroupInfo
           forall a. Monoid a => a
mempty
           forall a. Monoid a => a
mempty