{-# language CPP #-}
module Vulkan.Core11.Promoted_From_VK_KHR_device_groupAndVK_KHR_bind_memory2  ( BindBufferMemoryDeviceGroupInfo(..)
                                                                              , BindImageMemoryDeviceGroupInfo(..)
                                                                              , StructureType(..)
                                                                              , ImageCreateFlagBits(..)
                                                                              , ImageCreateFlags
                                                                              ) where

import Foreign.Marshal.Alloc (allocaBytesAligned)
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 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.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.Core10.FundamentalTypes (Rect2D)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
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
--
-- = Members
--
-- If the @pNext@ list 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.
--
-- = Description
--
-- The 'BindBufferMemoryDeviceGroupInfo' structure is defined as:
--
-- -   @sType@ is the type of this structure.
--
-- -   @pNext@ is @NULL@ or a pointer to a structure extending this
--     structure.
--
-- -   @deviceIndexCount@ is the number of elements in @pDeviceIndices@.
--
-- -   @pDeviceIndices@ is a pointer to an array of device indices.
--
-- 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
--
-- -   @deviceIndexCount@ /must/ either be zero or equal to the number of
--     physical devices in the logical device
--
-- -   All elements of @pDeviceIndices@ /must/ be valid device indices
--
-- == Valid Usage (Implicit)
--
-- -   @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_BIND_BUFFER_MEMORY_DEVICE_GROUP_INFO'
--
-- -   If @deviceIndexCount@ is not @0@, @pDeviceIndices@ /must/ be a valid
--     pointer to an array of @deviceIndexCount@ @uint32_t@ values
--
-- = See Also
--
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data BindBufferMemoryDeviceGroupInfo = BindBufferMemoryDeviceGroupInfo
  { -- No documentation found for Nested "VkBindBufferMemoryDeviceGroupInfo" "pDeviceIndices"
    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 :: BindBufferMemoryDeviceGroupInfo
-> (Ptr BindBufferMemoryDeviceGroupInfo -> IO b) -> IO b
withCStruct x :: BindBufferMemoryDeviceGroupInfo
x f :: Ptr BindBufferMemoryDeviceGroupInfo -> IO b
f = Int -> Int -> (Ptr BindBufferMemoryDeviceGroupInfo -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr BindBufferMemoryDeviceGroupInfo -> IO b) -> IO b)
-> (Ptr BindBufferMemoryDeviceGroupInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr BindBufferMemoryDeviceGroupInfo
p -> Ptr BindBufferMemoryDeviceGroupInfo
-> BindBufferMemoryDeviceGroupInfo -> IO b -> IO b
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 :: Ptr BindBufferMemoryDeviceGroupInfo
-> BindBufferMemoryDeviceGroupInfo -> IO b -> IO b
pokeCStruct p :: Ptr BindBufferMemoryDeviceGroupInfo
p BindBufferMemoryDeviceGroupInfo{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindBufferMemoryDeviceGroupInfo
p Ptr BindBufferMemoryDeviceGroupInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_BIND_BUFFER_MEMORY_DEVICE_GROUP_INFO)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindBufferMemoryDeviceGroupInfo
p Ptr BindBufferMemoryDeviceGroupInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindBufferMemoryDeviceGroupInfo
p Ptr BindBufferMemoryDeviceGroupInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word32 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Word32 -> Int) -> Vector Word32 -> Int
forall a b. (a -> b) -> a -> b
$ (Vector Word32
deviceIndices)) :: Word32))
    Ptr Word32
pPDeviceIndices' <- ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32))
-> ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Word32 -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Word32 ((Vector Word32 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Word32
deviceIndices)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 4) 4
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> Word32 -> IO ()) -> Vector Word32 -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Word32
e -> Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word32
pPDeviceIndices' Ptr Word32 -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32) (Word32
e)) (Vector Word32
deviceIndices)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr Word32) -> Ptr Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindBufferMemoryDeviceGroupInfo
p Ptr BindBufferMemoryDeviceGroupInfo -> Int -> Ptr (Ptr Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr Word32))) (Ptr Word32
pPDeviceIndices')
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = 32
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr BindBufferMemoryDeviceGroupInfo -> IO b -> IO b
pokeZeroCStruct p :: Ptr BindBufferMemoryDeviceGroupInfo
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindBufferMemoryDeviceGroupInfo
p Ptr BindBufferMemoryDeviceGroupInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_BIND_BUFFER_MEMORY_DEVICE_GROUP_INFO)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindBufferMemoryDeviceGroupInfo
p Ptr BindBufferMemoryDeviceGroupInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word32
pPDeviceIndices' <- ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32))
-> ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Word32 -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Word32 ((Vector Any -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Any
forall a. Monoid a => a
mempty)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 4) 4
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> Word32 -> IO ()) -> Vector Word32 -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Word32
e -> Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word32
pPDeviceIndices' Ptr Word32 -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32) (Word32
e)) (Vector Word32
forall a. Monoid a => a
mempty)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr Word32) -> Ptr Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindBufferMemoryDeviceGroupInfo
p Ptr BindBufferMemoryDeviceGroupInfo -> Int -> Ptr (Ptr Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr Word32))) (Ptr Word32
pPDeviceIndices')
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

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


-- | VkBindImageMemoryDeviceGroupInfo - Structure specifying device within a
-- group to bind to
--
-- = Members
--
-- If the @pNext@ list 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.
--
-- = Description
--
-- The 'BindImageMemoryDeviceGroupInfo' structure is defined as:
--
-- -   @sType@ is the type of this structure.
--
-- -   @pNext@ is @NULL@ or a pointer to a structure extending this
--     structure.
--
-- -   @deviceIndexCount@ is the number of elements in @pDeviceIndices@.
--
-- -   @pDeviceIndices@ is a pointer to an array of device indices.
--
-- -   @splitInstanceBindRegionCount@ is the number of elements in
--     @pSplitInstanceBindRegions@.
--
-- -   @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.
--
-- 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 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 were
-- 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
--
-- -   At least one of @deviceIndexCount@ and
--     @splitInstanceBindRegionCount@ /must/ be zero
--
-- -   @deviceIndexCount@ /must/ either be zero or equal to the number of
--     physical devices in the logical device
--
-- -   All elements of @pDeviceIndices@ /must/ be valid device indices
--
-- -   @splitInstanceBindRegionCount@ /must/ either be zero or equal to the
--     number of physical devices in the logical device squared
--
-- -   Elements of @pSplitInstanceBindRegions@ that correspond to the same
--     instance of an image /must/ not overlap
--
-- -   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
--
-- -   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
--
-- -   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
--
-- -   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 width of the
--     image subresource
--
-- == Valid Usage (Implicit)
--
-- -   @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_BIND_IMAGE_MEMORY_DEVICE_GROUP_INFO'
--
-- -   If @deviceIndexCount@ is not @0@, @pDeviceIndices@ /must/ be a valid
--     pointer to an array of @deviceIndexCount@ @uint32_t@ values
--
-- -   If @splitInstanceBindRegionCount@ is not @0@,
--     @pSplitInstanceBindRegions@ /must/ be a valid pointer to an array of
--     @splitInstanceBindRegionCount@
--     'Vulkan.Core10.FundamentalTypes.Rect2D' structures
--
-- = See Also
--
-- 'Vulkan.Core10.FundamentalTypes.Rect2D',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data BindImageMemoryDeviceGroupInfo = BindImageMemoryDeviceGroupInfo
  { -- No documentation found for Nested "VkBindImageMemoryDeviceGroupInfo" "pDeviceIndices"
    BindImageMemoryDeviceGroupInfo -> Vector Word32
deviceIndices :: Vector Word32
  , -- No documentation found for Nested "VkBindImageMemoryDeviceGroupInfo" "pSplitInstanceBindRegions"
    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 :: BindImageMemoryDeviceGroupInfo
-> (Ptr BindImageMemoryDeviceGroupInfo -> IO b) -> IO b
withCStruct x :: BindImageMemoryDeviceGroupInfo
x f :: Ptr BindImageMemoryDeviceGroupInfo -> IO b
f = Int -> Int -> (Ptr BindImageMemoryDeviceGroupInfo -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 48 8 ((Ptr BindImageMemoryDeviceGroupInfo -> IO b) -> IO b)
-> (Ptr BindImageMemoryDeviceGroupInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr BindImageMemoryDeviceGroupInfo
p -> Ptr BindImageMemoryDeviceGroupInfo
-> BindImageMemoryDeviceGroupInfo -> IO b -> IO b
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 :: Ptr BindImageMemoryDeviceGroupInfo
-> BindImageMemoryDeviceGroupInfo -> IO b -> IO b
pokeCStruct p :: Ptr BindImageMemoryDeviceGroupInfo
p BindImageMemoryDeviceGroupInfo{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindImageMemoryDeviceGroupInfo
p Ptr BindImageMemoryDeviceGroupInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_BIND_IMAGE_MEMORY_DEVICE_GROUP_INFO)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindImageMemoryDeviceGroupInfo
p Ptr BindImageMemoryDeviceGroupInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindImageMemoryDeviceGroupInfo
p Ptr BindImageMemoryDeviceGroupInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word32 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Word32 -> Int) -> Vector Word32 -> Int
forall a b. (a -> b) -> a -> b
$ (Vector Word32
deviceIndices)) :: Word32))
    Ptr Word32
pPDeviceIndices' <- ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32))
-> ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Word32 -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Word32 ((Vector Word32 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Word32
deviceIndices)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 4) 4
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> Word32 -> IO ()) -> Vector Word32 -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Word32
e -> Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word32
pPDeviceIndices' Ptr Word32 -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32) (Word32
e)) (Vector Word32
deviceIndices)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr Word32) -> Ptr Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindImageMemoryDeviceGroupInfo
p Ptr BindImageMemoryDeviceGroupInfo -> Int -> Ptr (Ptr Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr Word32))) (Ptr Word32
pPDeviceIndices')
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindImageMemoryDeviceGroupInfo
p Ptr BindImageMemoryDeviceGroupInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Rect2D -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Rect2D -> Int) -> Vector Rect2D -> Int
forall a b. (a -> b) -> a -> b
$ (Vector Rect2D
splitInstanceBindRegions)) :: Word32))
    Ptr Rect2D
pPSplitInstanceBindRegions' <- ((Ptr Rect2D -> IO b) -> IO b) -> ContT b IO (Ptr Rect2D)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Rect2D -> IO b) -> IO b) -> ContT b IO (Ptr Rect2D))
-> ((Ptr Rect2D -> IO b) -> IO b) -> ContT b IO (Ptr Rect2D)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Rect2D -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Rect2D ((Vector Rect2D -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Rect2D
splitInstanceBindRegions)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 16) 4
    (Int -> Rect2D -> ContT b IO ()) -> Vector Rect2D -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Rect2D
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Rect2D -> Rect2D -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (Ptr Rect2D
pPSplitInstanceBindRegions' Ptr Rect2D -> Int -> Ptr Rect2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Rect2D) (Rect2D
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector Rect2D
splitInstanceBindRegions)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr Rect2D) -> Ptr Rect2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindImageMemoryDeviceGroupInfo
p Ptr BindImageMemoryDeviceGroupInfo -> Int -> Ptr (Ptr Rect2D)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr (Ptr Rect2D))) (Ptr Rect2D
pPSplitInstanceBindRegions')
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = 48
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr BindImageMemoryDeviceGroupInfo -> IO b -> IO b
pokeZeroCStruct p :: Ptr BindImageMemoryDeviceGroupInfo
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindImageMemoryDeviceGroupInfo
p Ptr BindImageMemoryDeviceGroupInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_BIND_IMAGE_MEMORY_DEVICE_GROUP_INFO)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindImageMemoryDeviceGroupInfo
p Ptr BindImageMemoryDeviceGroupInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word32
pPDeviceIndices' <- ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32))
-> ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Word32 -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Word32 ((Vector Any -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Any
forall a. Monoid a => a
mempty)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 4) 4
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> Word32 -> IO ()) -> Vector Word32 -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Word32
e -> Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word32
pPDeviceIndices' Ptr Word32 -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32) (Word32
e)) (Vector Word32
forall a. Monoid a => a
mempty)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr Word32) -> Ptr Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindImageMemoryDeviceGroupInfo
p Ptr BindImageMemoryDeviceGroupInfo -> Int -> Ptr (Ptr Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr Word32))) (Ptr Word32
pPDeviceIndices')
    Ptr Rect2D
pPSplitInstanceBindRegions' <- ((Ptr Rect2D -> IO b) -> IO b) -> ContT b IO (Ptr Rect2D)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Rect2D -> IO b) -> IO b) -> ContT b IO (Ptr Rect2D))
-> ((Ptr Rect2D -> IO b) -> IO b) -> ContT b IO (Ptr Rect2D)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Rect2D -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Rect2D ((Vector Any -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Any
forall a. Monoid a => a
mempty)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 16) 4
    (Int -> Rect2D -> ContT b IO ()) -> Vector Rect2D -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Rect2D
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Rect2D -> Rect2D -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (Ptr Rect2D
pPSplitInstanceBindRegions' Ptr Rect2D -> Int -> Ptr Rect2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Rect2D) (Rect2D
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector Rect2D
forall a. Monoid a => a
mempty)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr Rect2D) -> Ptr Rect2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindImageMemoryDeviceGroupInfo
p Ptr BindImageMemoryDeviceGroupInfo -> Int -> Ptr (Ptr Rect2D)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr (Ptr Rect2D))) (Ptr Rect2D
pPSplitInstanceBindRegions')
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

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