{-# language CPP #-}
-- No documentation found for Chapter "SparseResourceMemoryManagement"
module Vulkan.Core10.SparseResourceMemoryManagement  ( getImageSparseMemoryRequirements
                                                     , getPhysicalDeviceSparseImageFormatProperties
                                                     , queueBindSparse
                                                     , SparseImageFormatProperties(..)
                                                     , SparseImageMemoryRequirements(..)
                                                     , ImageSubresource(..)
                                                     , SparseMemoryBind(..)
                                                     , SparseImageMemoryBind(..)
                                                     , SparseBufferMemoryBindInfo(..)
                                                     , SparseImageOpaqueMemoryBindInfo(..)
                                                     , SparseImageMemoryBindInfo(..)
                                                     , BindSparseInfo(..)
                                                     , ImageAspectFlagBits(..)
                                                     , ImageAspectFlags
                                                     , SparseImageFormatFlagBits(..)
                                                     , SparseImageFormatFlags
                                                     , SparseMemoryBindFlagBits(..)
                                                     , SparseMemoryBindFlags
                                                     ) where

import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (castPtr)
import GHC.Ptr (nullFunPtr)
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 Control.Monad.IO.Class (MonadIO)
import Data.Type.Equality ((:~:)(Refl))
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
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.Extends (forgetExtensions)
import Vulkan.CStruct.Extends (pokeSomeCStruct)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.Handles (Buffer)
import Vulkan.CStruct.Extends (Chain)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkGetImageSparseMemoryRequirements))
import Vulkan.Dynamic (DeviceCmds(pVkQueueBindSparse))
import {-# SOURCE #-} Vulkan.Core11.Promoted_From_VK_KHR_device_group (DeviceGroupBindSparseInfo)
import Vulkan.Core10.Handles (DeviceMemory)
import Vulkan.Core10.FundamentalTypes (DeviceSize)
import Vulkan.Core10.Handles (Device_T)
import Vulkan.CStruct.Extends (Extends)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (Extensible(..))
import Vulkan.Core10.FundamentalTypes (Extent3D)
import Vulkan.Core10.Handles (Fence)
import Vulkan.Core10.Handles (Fence(..))
import Vulkan.Core10.Enums.Format (Format)
import Vulkan.Core10.Enums.Format (Format(..))
import Vulkan.Core10.Handles (Image)
import Vulkan.Core10.Handles (Image(..))
import Vulkan.Core10.Enums.ImageAspectFlagBits (ImageAspectFlags)
import Vulkan.Core10.Enums.ImageTiling (ImageTiling)
import Vulkan.Core10.Enums.ImageTiling (ImageTiling(..))
import Vulkan.Core10.Enums.ImageType (ImageType)
import Vulkan.Core10.Enums.ImageType (ImageType(..))
import Vulkan.Core10.Enums.ImageUsageFlagBits (ImageUsageFlagBits(..))
import Vulkan.Core10.Enums.ImageUsageFlagBits (ImageUsageFlags)
import Vulkan.Dynamic (InstanceCmds(pVkGetPhysicalDeviceSparseImageFormatProperties))
import Vulkan.Core10.FundamentalTypes (Offset3D)
import Vulkan.CStruct.Extends (PeekChain)
import Vulkan.CStruct.Extends (PeekChain(..))
import Vulkan.Core10.Handles (PhysicalDevice)
import Vulkan.Core10.Handles (PhysicalDevice(..))
import Vulkan.Core10.Handles (PhysicalDevice(PhysicalDevice))
import Vulkan.Core10.Handles (PhysicalDevice_T)
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (PokeChain(..))
import Vulkan.Core10.Handles (Queue)
import Vulkan.Core10.Handles (Queue(..))
import Vulkan.Core10.Handles (Queue(Queue))
import Vulkan.Core10.Handles (Queue_T)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.SampleCountFlagBits (SampleCountFlagBits)
import Vulkan.Core10.Enums.SampleCountFlagBits (SampleCountFlagBits(..))
import Vulkan.Core10.Handles (Semaphore)
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.Enums.SparseImageFormatFlagBits (SparseImageFormatFlags)
import Vulkan.Core10.Enums.SparseMemoryBindFlagBits (SparseMemoryBindFlags)
import Vulkan.Core10.Enums.StructureType (StructureType)
import {-# SOURCE #-} Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore (TimelineSemaphoreSubmitInfo)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_BIND_SPARSE_INFO))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Core10.Enums.ImageAspectFlagBits (ImageAspectFlagBits(..))
import Vulkan.Core10.Enums.ImageAspectFlagBits (ImageAspectFlags)
import Vulkan.Core10.Enums.SparseImageFormatFlagBits (SparseImageFormatFlagBits(..))
import Vulkan.Core10.Enums.SparseImageFormatFlagBits (SparseImageFormatFlags)
import Vulkan.Core10.Enums.SparseMemoryBindFlagBits (SparseMemoryBindFlagBits(..))
import Vulkan.Core10.Enums.SparseMemoryBindFlagBits (SparseMemoryBindFlags)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetImageSparseMemoryRequirements
  :: FunPtr (Ptr Device_T -> Image -> Ptr Word32 -> Ptr SparseImageMemoryRequirements -> IO ()) -> Ptr Device_T -> Image -> Ptr Word32 -> Ptr SparseImageMemoryRequirements -> IO ()

-- | vkGetImageSparseMemoryRequirements - Query the memory requirements for a
-- sparse image
--
-- = Description
--
-- If @pSparseMemoryRequirements@ is @NULL@, then the number of sparse
-- memory requirements available is returned in
-- @pSparseMemoryRequirementCount@. Otherwise,
-- @pSparseMemoryRequirementCount@ /must/ point to a variable set by the
-- user to the number of elements in the @pSparseMemoryRequirements@ array,
-- and on return the variable is overwritten with the number of structures
-- actually written to @pSparseMemoryRequirements@. If
-- @pSparseMemoryRequirementCount@ is less than the number of sparse memory
-- requirements available, at most @pSparseMemoryRequirementCount@
-- structures will be written.
--
-- If the image was not created with
-- 'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SPARSE_RESIDENCY_BIT'
-- then @pSparseMemoryRequirementCount@ will be set to zero and
-- @pSparseMemoryRequirements@ will not be written to.
--
-- Note
--
-- It is legal for an implementation to report a larger value in
-- 'Vulkan.Core10.MemoryManagement.MemoryRequirements'::@size@ than would
-- be obtained by adding together memory sizes for all
-- 'SparseImageMemoryRequirements' returned by
-- 'getImageSparseMemoryRequirements'. This /may/ occur when the
-- implementation requires unused padding in the address range describing
-- the resource.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkGetImageSparseMemoryRequirements-device-parameter# @device@
--     /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkGetImageSparseMemoryRequirements-image-parameter# @image@
--     /must/ be a valid 'Vulkan.Core10.Handles.Image' handle
--
-- -   #VUID-vkGetImageSparseMemoryRequirements-pSparseMemoryRequirementCount-parameter#
--     @pSparseMemoryRequirementCount@ /must/ be a valid pointer to a
--     @uint32_t@ value
--
-- -   #VUID-vkGetImageSparseMemoryRequirements-pSparseMemoryRequirements-parameter#
--     If the value referenced by @pSparseMemoryRequirementCount@ is not
--     @0@, and @pSparseMemoryRequirements@ is not @NULL@,
--     @pSparseMemoryRequirements@ /must/ be a valid pointer to an array of
--     @pSparseMemoryRequirementCount@ 'SparseImageMemoryRequirements'
--     structures
--
-- -   #VUID-vkGetImageSparseMemoryRequirements-image-parent# @image@
--     /must/ have been created, allocated, or retrieved from @device@
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'Vulkan.Core10.Handles.Device', 'Vulkan.Core10.Handles.Image',
-- 'SparseImageMemoryRequirements'
getImageSparseMemoryRequirements :: forall io
                                  . (MonadIO io)
                                 => -- | @device@ is the logical device that owns the image.
                                    Device
                                 -> -- | @image@ is the 'Vulkan.Core10.Handles.Image' object to get the memory
                                    -- requirements for.
                                    Image
                                 -> io (("sparseMemoryRequirements" ::: Vector SparseImageMemoryRequirements))
getImageSparseMemoryRequirements :: forall (io :: * -> *).
MonadIO io =>
Device
-> Image
-> io
     ("sparseMemoryRequirements"
      ::: Vector SparseImageMemoryRequirements)
getImageSparseMemoryRequirements Device
device Image
image = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
  let vkGetImageSparseMemoryRequirementsPtr :: FunPtr
  (Ptr Device_T
   -> Image
   -> ("pSparseMemoryRequirementCount" ::: Ptr Word32)
   -> ("pSparseMemoryRequirements"
       ::: Ptr SparseImageMemoryRequirements)
   -> IO ())
vkGetImageSparseMemoryRequirementsPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> Image
      -> ("pSparseMemoryRequirementCount" ::: Ptr Word32)
      -> ("pSparseMemoryRequirements"
          ::: Ptr SparseImageMemoryRequirements)
      -> IO ())
pVkGetImageSparseMemoryRequirements (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> Image
   -> ("pSparseMemoryRequirementCount" ::: Ptr Word32)
   -> ("pSparseMemoryRequirements"
       ::: Ptr SparseImageMemoryRequirements)
   -> IO ())
vkGetImageSparseMemoryRequirementsPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetImageSparseMemoryRequirements is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkGetImageSparseMemoryRequirements' :: Ptr Device_T
-> Image
-> ("pSparseMemoryRequirementCount" ::: Ptr Word32)
-> ("pSparseMemoryRequirements"
    ::: Ptr SparseImageMemoryRequirements)
-> IO ()
vkGetImageSparseMemoryRequirements' = FunPtr
  (Ptr Device_T
   -> Image
   -> ("pSparseMemoryRequirementCount" ::: Ptr Word32)
   -> ("pSparseMemoryRequirements"
       ::: Ptr SparseImageMemoryRequirements)
   -> IO ())
-> Ptr Device_T
-> Image
-> ("pSparseMemoryRequirementCount" ::: Ptr Word32)
-> ("pSparseMemoryRequirements"
    ::: Ptr SparseImageMemoryRequirements)
-> IO ()
mkVkGetImageSparseMemoryRequirements FunPtr
  (Ptr Device_T
   -> Image
   -> ("pSparseMemoryRequirementCount" ::: Ptr Word32)
   -> ("pSparseMemoryRequirements"
       ::: Ptr SparseImageMemoryRequirements)
   -> IO ())
vkGetImageSparseMemoryRequirementsPtr
  let device' :: Ptr Device_T
device' = Device -> Ptr Device_T
deviceHandle (Device
device)
  "pSparseMemoryRequirementCount" ::: Ptr Word32
pPSparseMemoryRequirementCount <- 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 c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @Word32 Int
4) forall a. Ptr a -> IO ()
free
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetImageSparseMemoryRequirements" (Ptr Device_T
-> Image
-> ("pSparseMemoryRequirementCount" ::: Ptr Word32)
-> ("pSparseMemoryRequirements"
    ::: Ptr SparseImageMemoryRequirements)
-> IO ()
vkGetImageSparseMemoryRequirements'
                                                                  Ptr Device_T
device'
                                                                  (Image
image)
                                                                  ("pSparseMemoryRequirementCount" ::: Ptr Word32
pPSparseMemoryRequirementCount)
                                                                  (forall a. Ptr a
nullPtr))
  Word32
pSparseMemoryRequirementCount <- 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 -> IO a
peek @Word32 "pSparseMemoryRequirementCount" ::: Ptr Word32
pPSparseMemoryRequirementCount
  "pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
pPSparseMemoryRequirements <- 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 c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @SparseImageMemoryRequirements ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pSparseMemoryRequirementCount)) forall a. Num a => a -> a -> a
* Int
48)) forall a. Ptr a -> IO ()
free
  [()]
_ <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Int
i -> 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. ToCStruct a => Ptr a -> IO b -> IO b
pokeZeroCStruct ("pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
pPSparseMemoryRequirements forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i forall a. Num a => a -> a -> a
* Int
48) :: Ptr SparseImageMemoryRequirements) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())) [Int
0..(forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pSparseMemoryRequirementCount)) forall a. Num a => a -> a -> a
- Int
1]
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetImageSparseMemoryRequirements" (Ptr Device_T
-> Image
-> ("pSparseMemoryRequirementCount" ::: Ptr Word32)
-> ("pSparseMemoryRequirements"
    ::: Ptr SparseImageMemoryRequirements)
-> IO ()
vkGetImageSparseMemoryRequirements'
                                                                  Ptr Device_T
device'
                                                                  (Image
image)
                                                                  ("pSparseMemoryRequirementCount" ::: Ptr Word32
pPSparseMemoryRequirementCount)
                                                                  (("pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
pPSparseMemoryRequirements)))
  Word32
pSparseMemoryRequirementCount' <- 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 -> IO a
peek @Word32 "pSparseMemoryRequirementCount" ::: Ptr Word32
pPSparseMemoryRequirementCount
  "sparseMemoryRequirements" ::: Vector SparseImageMemoryRequirements
pSparseMemoryRequirements' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pSparseMemoryRequirementCount')) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @SparseImageMemoryRequirements ((("pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
pPSparseMemoryRequirements) forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
48 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SparseImageMemoryRequirements)))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ("sparseMemoryRequirements" ::: Vector SparseImageMemoryRequirements
pSparseMemoryRequirements')


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetPhysicalDeviceSparseImageFormatProperties
  :: FunPtr (Ptr PhysicalDevice_T -> Format -> ImageType -> SampleCountFlagBits -> ImageUsageFlags -> ImageTiling -> Ptr Word32 -> Ptr SparseImageFormatProperties -> IO ()) -> Ptr PhysicalDevice_T -> Format -> ImageType -> SampleCountFlagBits -> ImageUsageFlags -> ImageTiling -> Ptr Word32 -> Ptr SparseImageFormatProperties -> IO ()

-- | vkGetPhysicalDeviceSparseImageFormatProperties - Retrieve properties of
-- an image format applied to sparse images
--
-- = Description
--
-- If @pProperties@ is @NULL@, then the number of sparse format properties
-- available is returned in @pPropertyCount@. Otherwise, @pPropertyCount@
-- /must/ point to a variable set by the user to the number of elements in
-- the @pProperties@ array, and on return the variable is overwritten with
-- the number of structures actually written to @pProperties@. If
-- @pPropertyCount@ is less than the number of sparse format properties
-- available, at most @pPropertyCount@ structures will be written.
--
-- If
-- 'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SPARSE_RESIDENCY_BIT'
-- is not supported for the given arguments, @pPropertyCount@ will be set
-- to zero upon return, and no data will be written to @pProperties@.
--
-- Multiple aspects are returned for depth\/stencil images that are
-- implemented as separate planes by the implementation. The depth and
-- stencil data planes each have unique 'SparseImageFormatProperties' data.
--
-- Depth\/stencil images with depth and stencil data interleaved into a
-- single plane will return a single 'SparseImageFormatProperties'
-- structure with the @aspectMask@ set to
-- 'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_DEPTH_BIT' |
-- 'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_STENCIL_BIT'.
--
-- == Valid Usage
--
-- -   #VUID-vkGetPhysicalDeviceSparseImageFormatProperties-samples-01094#
--     @samples@ /must/ be a bit value that is set in
--     'Vulkan.Core10.DeviceInitialization.ImageFormatProperties'::@sampleCounts@
--     returned by
--     'Vulkan.Core10.DeviceInitialization.getPhysicalDeviceImageFormatProperties'
--     with @format@, @type@, @tiling@, and @usage@ equal to those in this
--     command and @flags@ equal to the value that is set in
--     'Vulkan.Core10.Image.ImageCreateInfo'::@flags@ when the image is
--     created
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkGetPhysicalDeviceSparseImageFormatProperties-physicalDevice-parameter#
--     @physicalDevice@ /must/ be a valid
--     'Vulkan.Core10.Handles.PhysicalDevice' handle
--
-- -   #VUID-vkGetPhysicalDeviceSparseImageFormatProperties-format-parameter#
--     @format@ /must/ be a valid 'Vulkan.Core10.Enums.Format.Format' value
--
-- -   #VUID-vkGetPhysicalDeviceSparseImageFormatProperties-type-parameter#
--     @type@ /must/ be a valid 'Vulkan.Core10.Enums.ImageType.ImageType'
--     value
--
-- -   #VUID-vkGetPhysicalDeviceSparseImageFormatProperties-samples-parameter#
--     @samples@ /must/ be a valid
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits' value
--
-- -   #VUID-vkGetPhysicalDeviceSparseImageFormatProperties-usage-parameter#
--     @usage@ /must/ be a valid combination of
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.ImageUsageFlagBits' values
--
-- -   #VUID-vkGetPhysicalDeviceSparseImageFormatProperties-usage-requiredbitmask#
--     @usage@ /must/ not be @0@
--
-- -   #VUID-vkGetPhysicalDeviceSparseImageFormatProperties-tiling-parameter#
--     @tiling@ /must/ be a valid
--     'Vulkan.Core10.Enums.ImageTiling.ImageTiling' value
--
-- -   #VUID-vkGetPhysicalDeviceSparseImageFormatProperties-pPropertyCount-parameter#
--     @pPropertyCount@ /must/ be a valid pointer to a @uint32_t@ value
--
-- -   #VUID-vkGetPhysicalDeviceSparseImageFormatProperties-pProperties-parameter#
--     If the value referenced by @pPropertyCount@ is not @0@, and
--     @pProperties@ is not @NULL@, @pProperties@ /must/ be a valid pointer
--     to an array of @pPropertyCount@ 'SparseImageFormatProperties'
--     structures
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'Vulkan.Core10.Enums.Format.Format',
-- 'Vulkan.Core10.Enums.ImageTiling.ImageTiling',
-- 'Vulkan.Core10.Enums.ImageType.ImageType',
-- 'Vulkan.Core10.Enums.ImageUsageFlagBits.ImageUsageFlags',
-- 'Vulkan.Core10.Handles.PhysicalDevice',
-- 'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits',
-- 'SparseImageFormatProperties'
getPhysicalDeviceSparseImageFormatProperties :: forall io
                                              . (MonadIO io)
                                             => -- | @physicalDevice@ is the physical device from which to query the sparse
                                                -- image format properties.
                                                PhysicalDevice
                                             -> -- | @format@ is the image format.
                                                Format
                                             -> -- | @type@ is the dimensionality of image.
                                                ImageType
                                             -> -- | @samples@ is a
                                                -- 'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits' value
                                                -- specifying the number of samples per texel.
                                                ("samples" ::: SampleCountFlagBits)
                                             -> -- | @usage@ is a bitmask describing the intended usage of the image.
                                                ImageUsageFlags
                                             -> -- | @tiling@ is the tiling arrangement of the texel blocks in memory.
                                                ImageTiling
                                             -> io (("properties" ::: Vector SparseImageFormatProperties))
getPhysicalDeviceSparseImageFormatProperties :: forall (io :: * -> *).
MonadIO io =>
PhysicalDevice
-> Format
-> ImageType
-> ("samples" ::: SampleCountFlagBits)
-> ImageUsageFlags
-> ImageTiling
-> io ("properties" ::: Vector SparseImageFormatProperties)
getPhysicalDeviceSparseImageFormatProperties PhysicalDevice
physicalDevice
                                               Format
format
                                               ImageType
type'
                                               "samples" ::: SampleCountFlagBits
samples
                                               ImageUsageFlags
usage
                                               ImageTiling
tiling = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
  let vkGetPhysicalDeviceSparseImageFormatPropertiesPtr :: FunPtr
  (Ptr PhysicalDevice_T
   -> Format
   -> ImageType
   -> ("samples" ::: SampleCountFlagBits)
   -> ImageUsageFlags
   -> ImageTiling
   -> ("pSparseMemoryRequirementCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr SparseImageFormatProperties)
   -> IO ())
vkGetPhysicalDeviceSparseImageFormatPropertiesPtr = InstanceCmds
-> FunPtr
     (Ptr PhysicalDevice_T
      -> Format
      -> ImageType
      -> ("samples" ::: SampleCountFlagBits)
      -> ImageUsageFlags
      -> ImageTiling
      -> ("pSparseMemoryRequirementCount" ::: Ptr Word32)
      -> ("pProperties" ::: Ptr SparseImageFormatProperties)
      -> IO ())
pVkGetPhysicalDeviceSparseImageFormatProperties (case PhysicalDevice
physicalDevice of PhysicalDevice{InstanceCmds
$sel:instanceCmds:PhysicalDevice :: PhysicalDevice -> InstanceCmds
instanceCmds :: InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr PhysicalDevice_T
   -> Format
   -> ImageType
   -> ("samples" ::: SampleCountFlagBits)
   -> ImageUsageFlags
   -> ImageTiling
   -> ("pSparseMemoryRequirementCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr SparseImageFormatProperties)
   -> IO ())
vkGetPhysicalDeviceSparseImageFormatPropertiesPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetPhysicalDeviceSparseImageFormatProperties is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkGetPhysicalDeviceSparseImageFormatProperties' :: Ptr PhysicalDevice_T
-> Format
-> ImageType
-> ("samples" ::: SampleCountFlagBits)
-> ImageUsageFlags
-> ImageTiling
-> ("pSparseMemoryRequirementCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr SparseImageFormatProperties)
-> IO ()
vkGetPhysicalDeviceSparseImageFormatProperties' = FunPtr
  (Ptr PhysicalDevice_T
   -> Format
   -> ImageType
   -> ("samples" ::: SampleCountFlagBits)
   -> ImageUsageFlags
   -> ImageTiling
   -> ("pSparseMemoryRequirementCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr SparseImageFormatProperties)
   -> IO ())
-> Ptr PhysicalDevice_T
-> Format
-> ImageType
-> ("samples" ::: SampleCountFlagBits)
-> ImageUsageFlags
-> ImageTiling
-> ("pSparseMemoryRequirementCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr SparseImageFormatProperties)
-> IO ()
mkVkGetPhysicalDeviceSparseImageFormatProperties FunPtr
  (Ptr PhysicalDevice_T
   -> Format
   -> ImageType
   -> ("samples" ::: SampleCountFlagBits)
   -> ImageUsageFlags
   -> ImageTiling
   -> ("pSparseMemoryRequirementCount" ::: Ptr Word32)
   -> ("pProperties" ::: Ptr SparseImageFormatProperties)
   -> IO ())
vkGetPhysicalDeviceSparseImageFormatPropertiesPtr
  let physicalDevice' :: Ptr PhysicalDevice_T
physicalDevice' = PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)
  "pSparseMemoryRequirementCount" ::: Ptr Word32
pPPropertyCount <- 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 c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @Word32 Int
4) forall a. Ptr a -> IO ()
free
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPhysicalDeviceSparseImageFormatProperties" (Ptr PhysicalDevice_T
-> Format
-> ImageType
-> ("samples" ::: SampleCountFlagBits)
-> ImageUsageFlags
-> ImageTiling
-> ("pSparseMemoryRequirementCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr SparseImageFormatProperties)
-> IO ()
vkGetPhysicalDeviceSparseImageFormatProperties'
                                                                              Ptr PhysicalDevice_T
physicalDevice'
                                                                              (Format
format)
                                                                              (ImageType
type')
                                                                              ("samples" ::: SampleCountFlagBits
samples)
                                                                              (ImageUsageFlags
usage)
                                                                              (ImageTiling
tiling)
                                                                              ("pSparseMemoryRequirementCount" ::: Ptr Word32
pPPropertyCount)
                                                                              (forall a. Ptr a
nullPtr))
  Word32
pPropertyCount <- 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 -> IO a
peek @Word32 "pSparseMemoryRequirementCount" ::: Ptr Word32
pPPropertyCount
  "pProperties" ::: Ptr SparseImageFormatProperties
pPProperties <- 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 c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @SparseImageFormatProperties ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertyCount)) forall a. Num a => a -> a -> a
* Int
20)) forall a. Ptr a -> IO ()
free
  [()]
_ <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Int
i -> 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. ToCStruct a => Ptr a -> IO b -> IO b
pokeZeroCStruct ("pProperties" ::: Ptr SparseImageFormatProperties
pPProperties forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i forall a. Num a => a -> a -> a
* Int
20) :: Ptr SparseImageFormatProperties) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())) [Int
0..(forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertyCount)) forall a. Num a => a -> a -> a
- Int
1]
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPhysicalDeviceSparseImageFormatProperties" (Ptr PhysicalDevice_T
-> Format
-> ImageType
-> ("samples" ::: SampleCountFlagBits)
-> ImageUsageFlags
-> ImageTiling
-> ("pSparseMemoryRequirementCount" ::: Ptr Word32)
-> ("pProperties" ::: Ptr SparseImageFormatProperties)
-> IO ()
vkGetPhysicalDeviceSparseImageFormatProperties'
                                                                              Ptr PhysicalDevice_T
physicalDevice'
                                                                              (Format
format)
                                                                              (ImageType
type')
                                                                              ("samples" ::: SampleCountFlagBits
samples)
                                                                              (ImageUsageFlags
usage)
                                                                              (ImageTiling
tiling)
                                                                              ("pSparseMemoryRequirementCount" ::: Ptr Word32
pPPropertyCount)
                                                                              (("pProperties" ::: Ptr SparseImageFormatProperties
pPProperties)))
  Word32
pPropertyCount' <- 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 -> IO a
peek @Word32 "pSparseMemoryRequirementCount" ::: Ptr Word32
pPPropertyCount
  "properties" ::: Vector SparseImageFormatProperties
pProperties' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPropertyCount')) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @SparseImageFormatProperties ((("pProperties" ::: Ptr SparseImageFormatProperties
pPProperties) forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
20 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SparseImageFormatProperties)))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ("properties" ::: Vector SparseImageFormatProperties
pProperties')


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkQueueBindSparse
  :: FunPtr (Ptr Queue_T -> Word32 -> Ptr (SomeStruct BindSparseInfo) -> Fence -> IO Result) -> Ptr Queue_T -> Word32 -> Ptr (SomeStruct BindSparseInfo) -> Fence -> IO Result

-- | vkQueueBindSparse - Bind device memory to a sparse resource object
--
-- = Description
--
-- 'queueBindSparse' is a
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#devsandqueues-submission queue submission command>,
-- with each batch defined by an element of @pBindInfo@ as a
-- 'BindSparseInfo' structure. Batches begin execution in the order they
-- appear in @pBindInfo@, but /may/ complete out of order.
--
-- Within a batch, a given range of a resource /must/ not be bound more
-- than once. Across batches, if a range is to be bound to one allocation
-- and offset and then to another allocation and offset, then the
-- application /must/ guarantee (usually using semaphores) that the binding
-- operations are executed in the correct order, as well as to order
-- binding operations against the execution of command buffer submissions.
--
-- As no operation to 'queueBindSparse' causes any pipeline stage to access
-- memory, synchronization primitives used in this command effectively only
-- define execution dependencies.
--
-- Additional information about fence and semaphore operation is described
-- in
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization the synchronization chapter>.
--
-- == Valid Usage
--
-- -   #VUID-vkQueueBindSparse-fence-01113# If @fence@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', @fence@ /must/ be
--     unsignaled
--
-- -   #VUID-vkQueueBindSparse-fence-01114# If @fence@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', @fence@ /must/ not be
--     associated with any other queue command that has not yet completed
--     execution on that queue
--
-- -   #VUID-vkQueueBindSparse-pSignalSemaphores-01115# Each element of the
--     @pSignalSemaphores@ member of each element of @pBindInfo@ /must/ be
--     unsignaled when the semaphore signal operation it defines is
--     executed on the device
--
-- -   #VUID-vkQueueBindSparse-pWaitSemaphores-01116# When a semaphore wait
--     operation referring to a binary semaphore defined by any element of
--     the @pWaitSemaphores@ member of any element of @pBindInfo@ executes
--     on @queue@, there /must/ be no other queues waiting on the same
--     semaphore
--
-- -   #VUID-vkQueueBindSparse-pWaitSemaphores-01117# All elements of the
--     @pWaitSemaphores@ member of all elements of the @pBindInfo@
--     parameter referring to a binary semaphore /must/ be semaphores that
--     are signaled, or have
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-semaphores-signaling semaphore signal operations>
--     previously submitted for execution
--
-- -   #VUID-vkQueueBindSparse-pWaitSemaphores-03245# All elements of the
--     @pWaitSemaphores@ member of all elements of @pBindInfo@ created with
--     a 'Vulkan.Core12.Enums.SemaphoreType.SemaphoreType' of
--     'Vulkan.Core12.Enums.SemaphoreType.SEMAPHORE_TYPE_BINARY' /must/
--     reference a semaphore signal operation that has been submitted for
--     execution and any semaphore signal operations on which it depends
--     (if any) /must/ have also been submitted for execution
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkQueueBindSparse-queue-parameter# @queue@ /must/ be a valid
--     'Vulkan.Core10.Handles.Queue' handle
--
-- -   #VUID-vkQueueBindSparse-pBindInfo-parameter# If @bindInfoCount@ is
--     not @0@, @pBindInfo@ /must/ be a valid pointer to an array of
--     @bindInfoCount@ valid 'BindSparseInfo' structures
--
-- -   #VUID-vkQueueBindSparse-fence-parameter# If @fence@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', @fence@ /must/ be a valid
--     'Vulkan.Core10.Handles.Fence' handle
--
-- -   #VUID-vkQueueBindSparse-queuetype# The @queue@ /must/ support sparse
--     binding operations
--
-- -   #VUID-vkQueueBindSparse-commonparent# Both of @fence@, and @queue@
--     that are valid handles of non-ignored parameters /must/ have been
--     created, allocated, or retrieved from the same
--     'Vulkan.Core10.Handles.Device'
--
-- == Host Synchronization
--
-- -   Host access to @queue@ /must/ be externally synchronized
--
-- -   Host access to @fence@ /must/ be externally synchronized
--
-- == Command Properties
--
-- \'
--
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
-- | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkCommandBufferLevel Command Buffer Levels> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginRenderPass Render Pass Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginVideoCodingKHR Video Coding Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkQueueFlagBits Supported Queue Types> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-queueoperation-command-types Command Type> |
-- +============================================================================================================================+========================================================================================================================+=============================================================================================================================+=======================================================================================================================+========================================================================================================================================+
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_DEVICE_LOST'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'BindSparseInfo', 'Vulkan.Core10.Handles.Fence',
-- 'Vulkan.Core10.Handles.Queue'
queueBindSparse :: forall io
                 . (MonadIO io)
                => -- | @queue@ is the queue that the sparse binding operations will be
                   -- submitted to.
                   Queue
                -> -- | @pBindInfo@ is a pointer to an array of 'BindSparseInfo' structures,
                   -- each specifying a sparse binding submission batch.
                   ("bindInfo" ::: Vector (SomeStruct BindSparseInfo))
                -> -- | @fence@ is an /optional/ handle to a fence to be signaled. If @fence@ is
                   -- not 'Vulkan.Core10.APIConstants.NULL_HANDLE', it defines a
                   -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-fences-signaling fence signal operation>.
                   Fence
                -> io ()
queueBindSparse :: forall (io :: * -> *).
MonadIO io =>
Queue
-> ("bindInfo" ::: Vector (SomeStruct BindSparseInfo))
-> Fence
-> io ()
queueBindSparse Queue
queue "bindInfo" ::: Vector (SomeStruct BindSparseInfo)
bindInfo Fence
fence = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
  let vkQueueBindSparsePtr :: FunPtr
  (Ptr Queue_T
   -> Word32
   -> ("pBindInfo" ::: Ptr (SomeStruct BindSparseInfo))
   -> Fence
   -> IO Result)
vkQueueBindSparsePtr = DeviceCmds
-> FunPtr
     (Ptr Queue_T
      -> Word32
      -> ("pBindInfo" ::: Ptr (SomeStruct BindSparseInfo))
      -> Fence
      -> IO Result)
pVkQueueBindSparse (case Queue
queue of Queue{DeviceCmds
$sel:deviceCmds:Queue :: Queue -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Queue_T
   -> Word32
   -> ("pBindInfo" ::: Ptr (SomeStruct BindSparseInfo))
   -> Fence
   -> IO Result)
vkQueueBindSparsePtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkQueueBindSparse is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkQueueBindSparse' :: Ptr Queue_T
-> Word32
-> ("pBindInfo" ::: Ptr (SomeStruct BindSparseInfo))
-> Fence
-> IO Result
vkQueueBindSparse' = FunPtr
  (Ptr Queue_T
   -> Word32
   -> ("pBindInfo" ::: Ptr (SomeStruct BindSparseInfo))
   -> Fence
   -> IO Result)
-> Ptr Queue_T
-> Word32
-> ("pBindInfo" ::: Ptr (SomeStruct BindSparseInfo))
-> Fence
-> IO Result
mkVkQueueBindSparse FunPtr
  (Ptr Queue_T
   -> Word32
   -> ("pBindInfo" ::: Ptr (SomeStruct BindSparseInfo))
   -> Fence
   -> IO Result)
vkQueueBindSparsePtr
  Ptr (BindSparseInfo Any)
pPBindInfo <- 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 @(BindSparseInfo _) ((forall a. Vector a -> Int
Data.Vector.length ("bindInfo" ::: Vector (SomeStruct BindSparseInfo)
bindInfo)) forall a. Num a => a -> a -> a
* Int
96)
  forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i SomeStruct BindSparseInfo
e -> 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.
(forall (es :: [*]).
 (Extendss a es, PokeChain es) =>
 ToCStruct (a es)) =>
Ptr (SomeStruct a) -> SomeStruct a -> IO b -> IO b
pokeSomeCStruct (forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (BindSparseInfo Any)
pPBindInfo forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
96 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (BindSparseInfo _))) (SomeStruct BindSparseInfo
e) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())) ("bindInfo" ::: Vector (SomeStruct BindSparseInfo)
bindInfo)
  Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkQueueBindSparse" (Ptr Queue_T
-> Word32
-> ("pBindInfo" ::: Ptr (SomeStruct BindSparseInfo))
-> Fence
-> IO Result
vkQueueBindSparse'
                                                      (Queue -> Ptr Queue_T
queueHandle (Queue
queue))
                                                      ((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
$ ("bindInfo" ::: Vector (SomeStruct BindSparseInfo)
bindInfo)) :: Word32))
                                                      (forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (BindSparseInfo Any)
pPBindInfo))
                                                      (Fence
fence))
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))


-- | VkSparseImageFormatProperties - Structure specifying sparse image format
-- properties
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'Vulkan.Core10.FundamentalTypes.Extent3D',
-- 'Vulkan.Core10.Enums.ImageAspectFlagBits.ImageAspectFlags',
-- 'Vulkan.Core10.Enums.SparseImageFormatFlagBits.SparseImageFormatFlags',
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.SparseImageFormatProperties2',
-- 'SparseImageMemoryRequirements',
-- 'getPhysicalDeviceSparseImageFormatProperties'
data SparseImageFormatProperties = SparseImageFormatProperties
  { -- | @aspectMask@ is a bitmask
    -- 'Vulkan.Core10.Enums.ImageAspectFlagBits.ImageAspectFlagBits' specifying
    -- which aspects of the image the properties apply to.
    SparseImageFormatProperties -> ImageAspectFlags
aspectMask :: ImageAspectFlags
  , -- | @imageGranularity@ is the width, height, and depth of the sparse image
    -- block in texels or compressed texel blocks.
    SparseImageFormatProperties -> Extent3D
imageGranularity :: Extent3D
  , -- | @flags@ is a bitmask of
    -- 'Vulkan.Core10.Enums.SparseImageFormatFlagBits.SparseImageFormatFlagBits'
    -- specifying additional information about the sparse resource.
    SparseImageFormatProperties -> SparseImageFormatFlags
flags :: SparseImageFormatFlags
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SparseImageFormatProperties)
#endif
deriving instance Show SparseImageFormatProperties

instance ToCStruct SparseImageFormatProperties where
  withCStruct :: forall b.
SparseImageFormatProperties
-> (("pProperties" ::: Ptr SparseImageFormatProperties) -> IO b)
-> IO b
withCStruct SparseImageFormatProperties
x ("pProperties" ::: Ptr SparseImageFormatProperties) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
20 forall a b. (a -> b) -> a -> b
$ \"pProperties" ::: Ptr SparseImageFormatProperties
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr SparseImageFormatProperties
p SparseImageFormatProperties
x (("pProperties" ::: Ptr SparseImageFormatProperties) -> IO b
f "pProperties" ::: Ptr SparseImageFormatProperties
p)
  pokeCStruct :: forall b.
("pProperties" ::: Ptr SparseImageFormatProperties)
-> SparseImageFormatProperties -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr SparseImageFormatProperties
p SparseImageFormatProperties{Extent3D
SparseImageFormatFlags
ImageAspectFlags
flags :: SparseImageFormatFlags
imageGranularity :: Extent3D
aspectMask :: ImageAspectFlags
$sel:flags:SparseImageFormatProperties :: SparseImageFormatProperties -> SparseImageFormatFlags
$sel:imageGranularity:SparseImageFormatProperties :: SparseImageFormatProperties -> Extent3D
$sel:aspectMask:SparseImageFormatProperties :: SparseImageFormatProperties -> ImageAspectFlags
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr SparseImageFormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr ImageAspectFlags)) (ImageAspectFlags
aspectMask)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr SparseImageFormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Extent3D)) (Extent3D
imageGranularity)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr SparseImageFormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr SparseImageFormatFlags)) (SparseImageFormatFlags
flags)
    IO b
f
  cStructSize :: Int
cStructSize = Int
20
  cStructAlignment :: Int
cStructAlignment = Int
4
  pokeZeroCStruct :: forall b.
("pProperties" ::: Ptr SparseImageFormatProperties) -> IO b -> IO b
pokeZeroCStruct "pProperties" ::: Ptr SparseImageFormatProperties
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr SparseImageFormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Extent3D)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct SparseImageFormatProperties where
  peekCStruct :: ("pProperties" ::: Ptr SparseImageFormatProperties)
-> IO SparseImageFormatProperties
peekCStruct "pProperties" ::: Ptr SparseImageFormatProperties
p = do
    ImageAspectFlags
aspectMask <- forall a. Storable a => Ptr a -> IO a
peek @ImageAspectFlags (("pProperties" ::: Ptr SparseImageFormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr ImageAspectFlags))
    Extent3D
imageGranularity <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent3D (("pProperties" ::: Ptr SparseImageFormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Extent3D))
    SparseImageFormatFlags
flags <- forall a. Storable a => Ptr a -> IO a
peek @SparseImageFormatFlags (("pProperties" ::: Ptr SparseImageFormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr SparseImageFormatFlags))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ImageAspectFlags
-> Extent3D
-> SparseImageFormatFlags
-> SparseImageFormatProperties
SparseImageFormatProperties
             ImageAspectFlags
aspectMask Extent3D
imageGranularity SparseImageFormatFlags
flags

instance Storable SparseImageFormatProperties where
  sizeOf :: SparseImageFormatProperties -> Int
sizeOf ~SparseImageFormatProperties
_ = Int
20
  alignment :: SparseImageFormatProperties -> Int
alignment ~SparseImageFormatProperties
_ = Int
4
  peek :: ("pProperties" ::: Ptr SparseImageFormatProperties)
-> IO SparseImageFormatProperties
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: ("pProperties" ::: Ptr SparseImageFormatProperties)
-> SparseImageFormatProperties -> IO ()
poke "pProperties" ::: Ptr SparseImageFormatProperties
ptr SparseImageFormatProperties
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr SparseImageFormatProperties
ptr SparseImageFormatProperties
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero SparseImageFormatProperties where
  zero :: SparseImageFormatProperties
zero = ImageAspectFlags
-> Extent3D
-> SparseImageFormatFlags
-> SparseImageFormatProperties
SparseImageFormatProperties
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkSparseImageMemoryRequirements - Structure specifying sparse image
-- memory requirements
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize',
-- 'SparseImageFormatProperties',
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_memory_requirements2.SparseImageMemoryRequirements2',
-- 'getImageSparseMemoryRequirements'
data SparseImageMemoryRequirements = SparseImageMemoryRequirements
  { -- | @formatProperties@ is a 'SparseImageFormatProperties' structure
    -- specifying properties of the image format.
    SparseImageMemoryRequirements -> SparseImageFormatProperties
formatProperties :: SparseImageFormatProperties
  , -- | @imageMipTailFirstLod@ is the first mip level at which image
    -- subresources are included in the mip tail region.
    SparseImageMemoryRequirements -> Word32
imageMipTailFirstLod :: Word32
  , -- | @imageMipTailSize@ is the memory size (in bytes) of the mip tail region.
    -- If @formatProperties.flags@ contains
    -- 'Vulkan.Core10.Enums.SparseImageFormatFlagBits.SPARSE_IMAGE_FORMAT_SINGLE_MIPTAIL_BIT',
    -- this is the size of the whole mip tail, otherwise this is the size of
    -- the mip tail of a single array layer. This value is guaranteed to be a
    -- multiple of the sparse block size in bytes.
    SparseImageMemoryRequirements -> DeviceSize
imageMipTailSize :: DeviceSize
  , -- | @imageMipTailOffset@ is the opaque memory offset used with
    -- 'SparseImageOpaqueMemoryBindInfo' to bind the mip tail region(s).
    SparseImageMemoryRequirements -> DeviceSize
imageMipTailOffset :: DeviceSize
  , -- | @imageMipTailStride@ is the offset stride between each array-layer’s mip
    -- tail, if @formatProperties.flags@ does not contain
    -- 'Vulkan.Core10.Enums.SparseImageFormatFlagBits.SPARSE_IMAGE_FORMAT_SINGLE_MIPTAIL_BIT'
    -- (otherwise the value is undefined).
    SparseImageMemoryRequirements -> DeviceSize
imageMipTailStride :: DeviceSize
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SparseImageMemoryRequirements)
#endif
deriving instance Show SparseImageMemoryRequirements

instance ToCStruct SparseImageMemoryRequirements where
  withCStruct :: forall b.
SparseImageMemoryRequirements
-> (("pSparseMemoryRequirements"
     ::: Ptr SparseImageMemoryRequirements)
    -> IO b)
-> IO b
withCStruct SparseImageMemoryRequirements
x ("pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements)
-> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
48 forall a b. (a -> b) -> a -> b
$ \"pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
p SparseImageMemoryRequirements
x (("pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements)
-> IO b
f "pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
p)
  pokeCStruct :: forall b.
("pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements)
-> SparseImageMemoryRequirements -> IO b -> IO b
pokeCStruct "pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
p SparseImageMemoryRequirements{Word32
DeviceSize
SparseImageFormatProperties
imageMipTailStride :: DeviceSize
imageMipTailOffset :: DeviceSize
imageMipTailSize :: DeviceSize
imageMipTailFirstLod :: Word32
formatProperties :: SparseImageFormatProperties
$sel:imageMipTailStride:SparseImageMemoryRequirements :: SparseImageMemoryRequirements -> DeviceSize
$sel:imageMipTailOffset:SparseImageMemoryRequirements :: SparseImageMemoryRequirements -> DeviceSize
$sel:imageMipTailSize:SparseImageMemoryRequirements :: SparseImageMemoryRequirements -> DeviceSize
$sel:imageMipTailFirstLod:SparseImageMemoryRequirements :: SparseImageMemoryRequirements -> Word32
$sel:formatProperties:SparseImageMemoryRequirements :: SparseImageMemoryRequirements -> SparseImageFormatProperties
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr SparseImageFormatProperties)) (SparseImageFormatProperties
formatProperties)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (Word32
imageMipTailFirstLod)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DeviceSize)) (DeviceSize
imageMipTailSize)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr DeviceSize)) (DeviceSize
imageMipTailOffset)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr DeviceSize)) (DeviceSize
imageMipTailStride)
    IO b
f
  cStructSize :: Int
cStructSize = Int
48
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements)
-> IO b -> IO b
pokeZeroCStruct "pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr SparseImageFormatProperties)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct SparseImageMemoryRequirements where
  peekCStruct :: ("pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements)
-> IO SparseImageMemoryRequirements
peekCStruct "pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
p = do
    SparseImageFormatProperties
formatProperties <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @SparseImageFormatProperties (("pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr SparseImageFormatProperties))
    Word32
imageMipTailFirstLod <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
    DeviceSize
imageMipTailSize <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize (("pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DeviceSize))
    DeviceSize
imageMipTailOffset <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize (("pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr DeviceSize))
    DeviceSize
imageMipTailStride <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize (("pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr DeviceSize))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SparseImageFormatProperties
-> Word32
-> DeviceSize
-> DeviceSize
-> DeviceSize
-> SparseImageMemoryRequirements
SparseImageMemoryRequirements
             SparseImageFormatProperties
formatProperties
             Word32
imageMipTailFirstLod
             DeviceSize
imageMipTailSize
             DeviceSize
imageMipTailOffset
             DeviceSize
imageMipTailStride

instance Storable SparseImageMemoryRequirements where
  sizeOf :: SparseImageMemoryRequirements -> Int
sizeOf ~SparseImageMemoryRequirements
_ = Int
48
  alignment :: SparseImageMemoryRequirements -> Int
alignment ~SparseImageMemoryRequirements
_ = Int
8
  peek :: ("pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements)
-> IO SparseImageMemoryRequirements
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: ("pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements)
-> SparseImageMemoryRequirements -> IO ()
poke "pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
ptr SparseImageMemoryRequirements
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pSparseMemoryRequirements" ::: Ptr SparseImageMemoryRequirements
ptr SparseImageMemoryRequirements
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero SparseImageMemoryRequirements where
  zero :: SparseImageMemoryRequirements
zero = SparseImageFormatProperties
-> Word32
-> DeviceSize
-> DeviceSize
-> DeviceSize
-> SparseImageMemoryRequirements
SparseImageMemoryRequirements
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkImageSubresource - Structure specifying an image subresource
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'Vulkan.Core10.Enums.ImageAspectFlagBits.ImageAspectFlags',
-- 'Vulkan.Extensions.VK_EXT_image_compression_control.ImageSubresource2EXT',
-- 'SparseImageMemoryBind', 'Vulkan.Core10.Image.getImageSubresourceLayout'
data ImageSubresource = ImageSubresource
  { -- | @aspectMask@ is a
    -- 'Vulkan.Core10.Enums.ImageAspectFlagBits.ImageAspectFlags' value
    -- selecting the image /aspect/.
    --
    -- #VUID-VkImageSubresource-aspectMask-parameter# @aspectMask@ /must/ be a
    -- valid combination of
    -- 'Vulkan.Core10.Enums.ImageAspectFlagBits.ImageAspectFlagBits' values
    --
    -- #VUID-VkImageSubresource-aspectMask-requiredbitmask# @aspectMask@ /must/
    -- not be @0@
    ImageSubresource -> ImageAspectFlags
aspectMask :: ImageAspectFlags
  , -- | @mipLevel@ selects the mipmap level.
    ImageSubresource -> Word32
mipLevel :: Word32
  , -- | @arrayLayer@ selects the array layer.
    ImageSubresource -> Word32
arrayLayer :: Word32
  }
  deriving (Typeable, ImageSubresource -> ImageSubresource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageSubresource -> ImageSubresource -> Bool
$c/= :: ImageSubresource -> ImageSubresource -> Bool
== :: ImageSubresource -> ImageSubresource -> Bool
$c== :: ImageSubresource -> ImageSubresource -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ImageSubresource)
#endif
deriving instance Show ImageSubresource

instance ToCStruct ImageSubresource where
  withCStruct :: forall b.
ImageSubresource -> (Ptr ImageSubresource -> IO b) -> IO b
withCStruct ImageSubresource
x Ptr ImageSubresource -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
12 forall a b. (a -> b) -> a -> b
$ \Ptr ImageSubresource
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ImageSubresource
p ImageSubresource
x (Ptr ImageSubresource -> IO b
f Ptr ImageSubresource
p)
  pokeCStruct :: forall b. Ptr ImageSubresource -> ImageSubresource -> IO b -> IO b
pokeCStruct Ptr ImageSubresource
p ImageSubresource{Word32
ImageAspectFlags
arrayLayer :: Word32
mipLevel :: Word32
aspectMask :: ImageAspectFlags
$sel:arrayLayer:ImageSubresource :: ImageSubresource -> Word32
$sel:mipLevel:ImageSubresource :: ImageSubresource -> Word32
$sel:aspectMask:ImageSubresource :: ImageSubresource -> ImageAspectFlags
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageSubresource
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr ImageAspectFlags)) (ImageAspectFlags
aspectMask)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageSubresource
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32)) (Word32
mipLevel)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageSubresource
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32)) (Word32
arrayLayer)
    IO b
f
  cStructSize :: Int
cStructSize = Int
12
  cStructAlignment :: Int
cStructAlignment = Int
4
  pokeZeroCStruct :: forall b. Ptr ImageSubresource -> IO b -> IO b
pokeZeroCStruct Ptr ImageSubresource
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageSubresource
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr ImageAspectFlags)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageSubresource
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageSubresource
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct ImageSubresource where
  peekCStruct :: Ptr ImageSubresource -> IO ImageSubresource
peekCStruct Ptr ImageSubresource
p = do
    ImageAspectFlags
aspectMask <- forall a. Storable a => Ptr a -> IO a
peek @ImageAspectFlags ((Ptr ImageSubresource
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr ImageAspectFlags))
    Word32
mipLevel <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr ImageSubresource
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32))
    Word32
arrayLayer <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr ImageSubresource
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ImageAspectFlags -> Word32 -> Word32 -> ImageSubresource
ImageSubresource
             ImageAspectFlags
aspectMask Word32
mipLevel Word32
arrayLayer

instance Storable ImageSubresource where
  sizeOf :: ImageSubresource -> Int
sizeOf ~ImageSubresource
_ = Int
12
  alignment :: ImageSubresource -> Int
alignment ~ImageSubresource
_ = Int
4
  peek :: Ptr ImageSubresource -> IO ImageSubresource
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr ImageSubresource -> ImageSubresource -> IO ()
poke Ptr ImageSubresource
ptr ImageSubresource
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ImageSubresource
ptr ImageSubresource
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero ImageSubresource where
  zero :: ImageSubresource
zero = ImageAspectFlags -> Word32 -> Word32 -> ImageSubresource
ImageSubresource
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkSparseMemoryBind - Structure specifying a sparse memory bind operation
--
-- = Description
--
-- The /binding range/ [@resourceOffset@, @resourceOffset@ + @size@) has
-- different constraints based on @flags@. If @flags@ contains
-- 'Vulkan.Core10.Enums.SparseMemoryBindFlagBits.SPARSE_MEMORY_BIND_METADATA_BIT',
-- the binding range /must/ be within the mip tail region of the metadata
-- aspect. This metadata region is defined by:
--
-- -   metadataRegion = [base, base + @imageMipTailSize@)
--
-- -   base = @imageMipTailOffset@ + @imageMipTailStride@ × n
--
-- and @imageMipTailOffset@, @imageMipTailSize@, and @imageMipTailStride@
-- values are from the 'SparseImageMemoryRequirements' corresponding to the
-- metadata aspect of the image, and n is a valid array layer index for the
-- image,
--
-- @imageMipTailStride@ is considered to be zero for aspects where
-- 'SparseImageMemoryRequirements'::@formatProperties.flags@ contains
-- 'Vulkan.Core10.Enums.SparseImageFormatFlagBits.SPARSE_IMAGE_FORMAT_SINGLE_MIPTAIL_BIT'.
--
-- If @flags@ does not contain
-- 'Vulkan.Core10.Enums.SparseMemoryBindFlagBits.SPARSE_MEMORY_BIND_METADATA_BIT',
-- the binding range /must/ be within the range
-- [0,'Vulkan.Core10.MemoryManagement.MemoryRequirements'::@size@).
--
-- == Valid Usage
--
-- -   #VUID-VkSparseMemoryBind-memory-01096# If @memory@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', @memory@ and
--     @memoryOffset@ /must/ match the memory requirements of the resource,
--     as described in section
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#resources-association>
--
-- -   #VUID-VkSparseMemoryBind-memory-01097# If @memory@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', @memory@ /must/ not have
--     been created with a memory type that reports
--     'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_LAZILY_ALLOCATED_BIT'
--     bit set
--
-- -   #VUID-VkSparseMemoryBind-size-01098# @size@ /must/ be greater than
--     @0@
--
-- -   #VUID-VkSparseMemoryBind-resourceOffset-01099# @resourceOffset@
--     /must/ be less than the size of the resource
--
-- -   #VUID-VkSparseMemoryBind-size-01100# @size@ /must/ be less than or
--     equal to the size of the resource minus @resourceOffset@
--
-- -   #VUID-VkSparseMemoryBind-memoryOffset-01101# @memoryOffset@ /must/
--     be less than the size of @memory@
--
-- -   #VUID-VkSparseMemoryBind-size-01102# @size@ /must/ be less than or
--     equal to the size of @memory@ minus @memoryOffset@
--
-- -   #VUID-VkSparseMemoryBind-memory-02730# If @memory@ was created with
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExportMemoryAllocateInfo'::@handleTypes@
--     not equal to @0@, at least one handle type it contained /must/ also
--     have been set in
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExternalMemoryBufferCreateInfo'::@handleTypes@
--     or
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExternalMemoryImageCreateInfo'::@handleTypes@
--     when the resource was created
--
-- -   #VUID-VkSparseMemoryBind-memory-02731# If @memory@ was created by a
--     memory import operation, the external handle type of the imported
--     memory /must/ also have been set in
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExternalMemoryBufferCreateInfo'::@handleTypes@
--     or
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExternalMemoryImageCreateInfo'::@handleTypes@
--     when the resource was created
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkSparseMemoryBind-memory-parameter# If @memory@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', @memory@ /must/ be a valid
--     'Vulkan.Core10.Handles.DeviceMemory' handle
--
-- -   #VUID-VkSparseMemoryBind-flags-parameter# @flags@ /must/ be a valid
--     combination of
--     'Vulkan.Core10.Enums.SparseMemoryBindFlagBits.SparseMemoryBindFlagBits'
--     values
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'Vulkan.Core10.Handles.DeviceMemory',
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize',
-- 'SparseBufferMemoryBindInfo', 'SparseImageOpaqueMemoryBindInfo',
-- 'Vulkan.Core10.Enums.SparseMemoryBindFlagBits.SparseMemoryBindFlags'
data SparseMemoryBind = SparseMemoryBind
  { -- | @resourceOffset@ is the offset into the resource.
    SparseMemoryBind -> DeviceSize
resourceOffset :: DeviceSize
  , -- | @size@ is the size of the memory region to be bound.
    SparseMemoryBind -> DeviceSize
size :: DeviceSize
  , -- | @memory@ is the 'Vulkan.Core10.Handles.DeviceMemory' object that the
    -- range of the resource is bound to. If @memory@ is
    -- 'Vulkan.Core10.APIConstants.NULL_HANDLE', the range is unbound.
    SparseMemoryBind -> DeviceMemory
memory :: DeviceMemory
  , -- | @memoryOffset@ is the offset into the
    -- 'Vulkan.Core10.Handles.DeviceMemory' object to bind the resource range
    -- to. If @memory@ is 'Vulkan.Core10.APIConstants.NULL_HANDLE', this value
    -- is ignored.
    SparseMemoryBind -> DeviceSize
memoryOffset :: DeviceSize
  , -- | @flags@ is a bitmask of
    -- 'Vulkan.Core10.Enums.SparseMemoryBindFlagBits.SparseMemoryBindFlagBits'
    -- specifying usage of the binding operation.
    SparseMemoryBind -> SparseMemoryBindFlags
flags :: SparseMemoryBindFlags
  }
  deriving (Typeable, SparseMemoryBind -> SparseMemoryBind -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SparseMemoryBind -> SparseMemoryBind -> Bool
$c/= :: SparseMemoryBind -> SparseMemoryBind -> Bool
== :: SparseMemoryBind -> SparseMemoryBind -> Bool
$c== :: SparseMemoryBind -> SparseMemoryBind -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SparseMemoryBind)
#endif
deriving instance Show SparseMemoryBind

instance ToCStruct SparseMemoryBind where
  withCStruct :: forall b.
SparseMemoryBind -> (Ptr SparseMemoryBind -> IO b) -> IO b
withCStruct SparseMemoryBind
x Ptr SparseMemoryBind -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 forall a b. (a -> b) -> a -> b
$ \Ptr SparseMemoryBind
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SparseMemoryBind
p SparseMemoryBind
x (Ptr SparseMemoryBind -> IO b
f Ptr SparseMemoryBind
p)
  pokeCStruct :: forall b. Ptr SparseMemoryBind -> SparseMemoryBind -> IO b -> IO b
pokeCStruct Ptr SparseMemoryBind
p SparseMemoryBind{DeviceSize
DeviceMemory
SparseMemoryBindFlags
flags :: SparseMemoryBindFlags
memoryOffset :: DeviceSize
memory :: DeviceMemory
size :: DeviceSize
resourceOffset :: DeviceSize
$sel:flags:SparseMemoryBind :: SparseMemoryBind -> SparseMemoryBindFlags
$sel:memoryOffset:SparseMemoryBind :: SparseMemoryBind -> DeviceSize
$sel:memory:SparseMemoryBind :: SparseMemoryBind -> DeviceMemory
$sel:size:SparseMemoryBind :: SparseMemoryBind -> DeviceSize
$sel:resourceOffset:SparseMemoryBind :: SparseMemoryBind -> DeviceSize
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SparseMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DeviceSize)) (DeviceSize
resourceOffset)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SparseMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr DeviceSize)) (DeviceSize
size)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SparseMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceMemory)) (DeviceMemory
memory)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SparseMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DeviceSize)) (DeviceSize
memoryOffset)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SparseMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr SparseMemoryBindFlags)) (SparseMemoryBindFlags
flags)
    IO b
f
  cStructSize :: Int
cStructSize = Int
40
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr SparseMemoryBind -> IO b -> IO b
pokeZeroCStruct Ptr SparseMemoryBind
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SparseMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SparseMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SparseMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct SparseMemoryBind where
  peekCStruct :: Ptr SparseMemoryBind -> IO SparseMemoryBind
peekCStruct Ptr SparseMemoryBind
p = do
    DeviceSize
resourceOffset <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr SparseMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DeviceSize))
    DeviceSize
size <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr SparseMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr DeviceSize))
    DeviceMemory
memory <- forall a. Storable a => Ptr a -> IO a
peek @DeviceMemory ((Ptr SparseMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceMemory))
    DeviceSize
memoryOffset <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr SparseMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DeviceSize))
    SparseMemoryBindFlags
flags <- forall a. Storable a => Ptr a -> IO a
peek @SparseMemoryBindFlags ((Ptr SparseMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr SparseMemoryBindFlags))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DeviceSize
-> DeviceSize
-> DeviceMemory
-> DeviceSize
-> SparseMemoryBindFlags
-> SparseMemoryBind
SparseMemoryBind
             DeviceSize
resourceOffset DeviceSize
size DeviceMemory
memory DeviceSize
memoryOffset SparseMemoryBindFlags
flags

instance Storable SparseMemoryBind where
  sizeOf :: SparseMemoryBind -> Int
sizeOf ~SparseMemoryBind
_ = Int
40
  alignment :: SparseMemoryBind -> Int
alignment ~SparseMemoryBind
_ = Int
8
  peek :: Ptr SparseMemoryBind -> IO SparseMemoryBind
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr SparseMemoryBind -> SparseMemoryBind -> IO ()
poke Ptr SparseMemoryBind
ptr SparseMemoryBind
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SparseMemoryBind
ptr SparseMemoryBind
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero SparseMemoryBind where
  zero :: SparseMemoryBind
zero = DeviceSize
-> DeviceSize
-> DeviceMemory
-> DeviceSize
-> SparseMemoryBindFlags
-> SparseMemoryBind
SparseMemoryBind
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkSparseImageMemoryBind - Structure specifying sparse image memory bind
--
-- == Valid Usage
--
-- -   #VUID-VkSparseImageMemoryBind-memory-01104# If the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-sparseResidencyAliased sparseResidencyAliased>
--     feature is not enabled, and if any other resources are bound to
--     ranges of @memory@, the range of @memory@ being bound /must/ not
--     overlap with those bound ranges
--
-- -   #VUID-VkSparseImageMemoryBind-memory-01105# @memory@ and
--     @memoryOffset@ /must/ match the memory requirements of the calling
--     command’s @image@, as described in section
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#resources-association>
--
-- -   #VUID-VkSparseImageMemoryBind-subresource-01106# @subresource@
--     /must/ be a valid image subresource for @image@ (see
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#resources-image-views>)
--
-- -   #VUID-VkSparseImageMemoryBind-offset-01107# @offset.x@ /must/ be a
--     multiple of the sparse image block width
--     ('SparseImageFormatProperties'::@imageGranularity.width@) of the
--     image
--
-- -   #VUID-VkSparseImageMemoryBind-extent-01108# @extent.width@ /must/
--     either be a multiple of the sparse image block width of the image,
--     or else (@extent.width@ + @offset.x@) /must/ equal the width of the
--     image subresource
--
-- -   #VUID-VkSparseImageMemoryBind-offset-01109# @offset.y@ /must/ be a
--     multiple of the sparse image block height
--     ('SparseImageFormatProperties'::@imageGranularity.height@) of the
--     image
--
-- -   #VUID-VkSparseImageMemoryBind-extent-01110# @extent.height@ /must/
--     either be a multiple of the sparse image block height of the image,
--     or else (@extent.height@ + @offset.y@) /must/ equal the height of
--     the image subresource
--
-- -   #VUID-VkSparseImageMemoryBind-offset-01111# @offset.z@ /must/ be a
--     multiple of the sparse image block depth
--     ('SparseImageFormatProperties'::@imageGranularity.depth@) of the
--     image
--
-- -   #VUID-VkSparseImageMemoryBind-extent-01112# @extent.depth@ /must/
--     either be a multiple of the sparse image block depth of the image,
--     or else (@extent.depth@ + @offset.z@) /must/ equal the depth of the
--     image subresource
--
-- -   #VUID-VkSparseImageMemoryBind-memory-02732# If @memory@ was created
--     with
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExportMemoryAllocateInfo'::@handleTypes@
--     not equal to @0@, at least one handle type it contained /must/ also
--     have been set in
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExternalMemoryImageCreateInfo'::@handleTypes@
--     when the image was created
--
-- -   #VUID-VkSparseImageMemoryBind-memory-02733# If @memory@ was created
--     by a memory import operation, the external handle type of the
--     imported memory /must/ also have been set in
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExternalMemoryImageCreateInfo'::@handleTypes@
--     when @image@ was created
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkSparseImageMemoryBind-subresource-parameter# @subresource@
--     /must/ be a valid 'ImageSubresource' structure
--
-- -   #VUID-VkSparseImageMemoryBind-memory-parameter# If @memory@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', @memory@ /must/ be a valid
--     'Vulkan.Core10.Handles.DeviceMemory' handle
--
-- -   #VUID-VkSparseImageMemoryBind-flags-parameter# @flags@ /must/ be a
--     valid combination of
--     'Vulkan.Core10.Enums.SparseMemoryBindFlagBits.SparseMemoryBindFlagBits'
--     values
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'Vulkan.Core10.Handles.DeviceMemory',
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize',
-- 'Vulkan.Core10.FundamentalTypes.Extent3D', 'ImageSubresource',
-- 'Vulkan.Core10.FundamentalTypes.Offset3D', 'SparseImageMemoryBindInfo',
-- 'Vulkan.Core10.Enums.SparseMemoryBindFlagBits.SparseMemoryBindFlags'
data SparseImageMemoryBind = SparseImageMemoryBind
  { -- | @subresource@ is the image /aspect/ and region of interest in the image.
    SparseImageMemoryBind -> ImageSubresource
subresource :: ImageSubresource
  , -- | @offset@ are the coordinates of the first texel within the image
    -- subresource to bind.
    SparseImageMemoryBind -> Offset3D
offset :: Offset3D
  , -- | @extent@ is the size in texels of the region within the image
    -- subresource to bind. The extent /must/ be a multiple of the sparse image
    -- block dimensions, except when binding sparse image blocks along the edge
    -- of an image subresource it /can/ instead be such that any coordinate of
    -- @offset@ + @extent@ equals the corresponding dimensions of the image
    -- subresource.
    SparseImageMemoryBind -> Extent3D
extent :: Extent3D
  , -- | @memory@ is the 'Vulkan.Core10.Handles.DeviceMemory' object that the
    -- sparse image blocks of the image are bound to. If @memory@ is
    -- 'Vulkan.Core10.APIConstants.NULL_HANDLE', the sparse image blocks are
    -- unbound.
    SparseImageMemoryBind -> DeviceMemory
memory :: DeviceMemory
  , -- | @memoryOffset@ is an offset into 'Vulkan.Core10.Handles.DeviceMemory'
    -- object. If @memory@ is 'Vulkan.Core10.APIConstants.NULL_HANDLE', this
    -- value is ignored.
    SparseImageMemoryBind -> DeviceSize
memoryOffset :: DeviceSize
  , -- | @flags@ are sparse memory binding flags.
    SparseImageMemoryBind -> SparseMemoryBindFlags
flags :: SparseMemoryBindFlags
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SparseImageMemoryBind)
#endif
deriving instance Show SparseImageMemoryBind

instance ToCStruct SparseImageMemoryBind where
  withCStruct :: forall b.
SparseImageMemoryBind
-> (Ptr SparseImageMemoryBind -> IO b) -> IO b
withCStruct SparseImageMemoryBind
x Ptr SparseImageMemoryBind -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
64 forall a b. (a -> b) -> a -> b
$ \Ptr SparseImageMemoryBind
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SparseImageMemoryBind
p SparseImageMemoryBind
x (Ptr SparseImageMemoryBind -> IO b
f Ptr SparseImageMemoryBind
p)
  pokeCStruct :: forall b.
Ptr SparseImageMemoryBind -> SparseImageMemoryBind -> IO b -> IO b
pokeCStruct Ptr SparseImageMemoryBind
p SparseImageMemoryBind{DeviceSize
Offset3D
Extent3D
DeviceMemory
ImageSubresource
SparseMemoryBindFlags
flags :: SparseMemoryBindFlags
memoryOffset :: DeviceSize
memory :: DeviceMemory
extent :: Extent3D
offset :: Offset3D
subresource :: ImageSubresource
$sel:flags:SparseImageMemoryBind :: SparseImageMemoryBind -> SparseMemoryBindFlags
$sel:memoryOffset:SparseImageMemoryBind :: SparseImageMemoryBind -> DeviceSize
$sel:memory:SparseImageMemoryBind :: SparseImageMemoryBind -> DeviceMemory
$sel:extent:SparseImageMemoryBind :: SparseImageMemoryBind -> Extent3D
$sel:offset:SparseImageMemoryBind :: SparseImageMemoryBind -> Offset3D
$sel:subresource:SparseImageMemoryBind :: SparseImageMemoryBind -> ImageSubresource
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SparseImageMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr ImageSubresource)) (ImageSubresource
subresource)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SparseImageMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Offset3D)) (Offset3D
offset)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SparseImageMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Extent3D)) (Extent3D
extent)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SparseImageMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr DeviceMemory)) (DeviceMemory
memory)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SparseImageMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr DeviceSize)) (DeviceSize
memoryOffset)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SparseImageMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr SparseMemoryBindFlags)) (SparseMemoryBindFlags
flags)
    IO b
f
  cStructSize :: Int
cStructSize = Int
64
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr SparseImageMemoryBind -> IO b -> IO b
pokeZeroCStruct Ptr SparseImageMemoryBind
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SparseImageMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr ImageSubresource)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SparseImageMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Offset3D)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SparseImageMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Extent3D)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SparseImageMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct SparseImageMemoryBind where
  peekCStruct :: Ptr SparseImageMemoryBind -> IO SparseImageMemoryBind
peekCStruct Ptr SparseImageMemoryBind
p = do
    ImageSubresource
subresource <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ImageSubresource ((Ptr SparseImageMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr ImageSubresource))
    Offset3D
offset <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Offset3D ((Ptr SparseImageMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Offset3D))
    Extent3D
extent <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent3D ((Ptr SparseImageMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Extent3D))
    DeviceMemory
memory <- forall a. Storable a => Ptr a -> IO a
peek @DeviceMemory ((Ptr SparseImageMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr DeviceMemory))
    DeviceSize
memoryOffset <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr SparseImageMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr DeviceSize))
    SparseMemoryBindFlags
flags <- forall a. Storable a => Ptr a -> IO a
peek @SparseMemoryBindFlags ((Ptr SparseImageMemoryBind
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr SparseMemoryBindFlags))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ImageSubresource
-> Offset3D
-> Extent3D
-> DeviceMemory
-> DeviceSize
-> SparseMemoryBindFlags
-> SparseImageMemoryBind
SparseImageMemoryBind
             ImageSubresource
subresource Offset3D
offset Extent3D
extent DeviceMemory
memory DeviceSize
memoryOffset SparseMemoryBindFlags
flags

instance Storable SparseImageMemoryBind where
  sizeOf :: SparseImageMemoryBind -> Int
sizeOf ~SparseImageMemoryBind
_ = Int
64
  alignment :: SparseImageMemoryBind -> Int
alignment ~SparseImageMemoryBind
_ = Int
8
  peek :: Ptr SparseImageMemoryBind -> IO SparseImageMemoryBind
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr SparseImageMemoryBind -> SparseImageMemoryBind -> IO ()
poke Ptr SparseImageMemoryBind
ptr SparseImageMemoryBind
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SparseImageMemoryBind
ptr SparseImageMemoryBind
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero SparseImageMemoryBind where
  zero :: SparseImageMemoryBind
zero = ImageSubresource
-> Offset3D
-> Extent3D
-> DeviceMemory
-> DeviceSize
-> SparseMemoryBindFlags
-> SparseImageMemoryBind
SparseImageMemoryBind
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkSparseBufferMemoryBindInfo - Structure specifying a sparse buffer
-- memory bind operation
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'BindSparseInfo', 'Vulkan.Core10.Handles.Buffer', 'SparseMemoryBind'
data SparseBufferMemoryBindInfo = SparseBufferMemoryBindInfo
  { -- | @buffer@ is the 'Vulkan.Core10.Handles.Buffer' object to be bound.
    --
    -- #VUID-VkSparseBufferMemoryBindInfo-buffer-parameter# @buffer@ /must/ be
    -- a valid 'Vulkan.Core10.Handles.Buffer' handle
    SparseBufferMemoryBindInfo -> Buffer
buffer :: Buffer
  , -- | @pBinds@ is a pointer to an array of 'SparseMemoryBind' structures.
    --
    -- #VUID-VkSparseBufferMemoryBindInfo-pBinds-parameter# @pBinds@ /must/ be
    -- a valid pointer to an array of @bindCount@ valid 'SparseMemoryBind'
    -- structures
    SparseBufferMemoryBindInfo -> Vector SparseMemoryBind
binds :: Vector SparseMemoryBind
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SparseBufferMemoryBindInfo)
#endif
deriving instance Show SparseBufferMemoryBindInfo

instance ToCStruct SparseBufferMemoryBindInfo where
  withCStruct :: forall b.
SparseBufferMemoryBindInfo
-> (Ptr SparseBufferMemoryBindInfo -> IO b) -> IO b
withCStruct SparseBufferMemoryBindInfo
x Ptr SparseBufferMemoryBindInfo -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr SparseBufferMemoryBindInfo
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SparseBufferMemoryBindInfo
p SparseBufferMemoryBindInfo
x (Ptr SparseBufferMemoryBindInfo -> IO b
f Ptr SparseBufferMemoryBindInfo
p)
  pokeCStruct :: forall b.
Ptr SparseBufferMemoryBindInfo
-> SparseBufferMemoryBindInfo -> IO b -> IO b
pokeCStruct Ptr SparseBufferMemoryBindInfo
p SparseBufferMemoryBindInfo{Vector SparseMemoryBind
Buffer
binds :: Vector SparseMemoryBind
buffer :: Buffer
$sel:binds:SparseBufferMemoryBindInfo :: SparseBufferMemoryBindInfo -> Vector SparseMemoryBind
$sel:buffer:SparseBufferMemoryBindInfo :: SparseBufferMemoryBindInfo -> Buffer
..} 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 SparseBufferMemoryBindInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Buffer)) (Buffer
buffer)
    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 SparseBufferMemoryBindInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: 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 SparseMemoryBind
binds)) :: Word32))
    Ptr SparseMemoryBind
pPBinds' <- 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 @SparseMemoryBind ((forall a. Vector a -> Int
Data.Vector.length (Vector SparseMemoryBind
binds)) forall a. Num a => a -> a -> a
* Int
40)
    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 SparseMemoryBind
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr SparseMemoryBind
pPBinds' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
40 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SparseMemoryBind) (SparseMemoryBind
e)) (Vector SparseMemoryBind
binds)
    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 SparseBufferMemoryBindInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr SparseMemoryBind))) (Ptr SparseMemoryBind
pPBinds')
    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
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr SparseBufferMemoryBindInfo -> IO b -> IO b
pokeZeroCStruct Ptr SparseBufferMemoryBindInfo
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SparseBufferMemoryBindInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Buffer)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct SparseBufferMemoryBindInfo where
  peekCStruct :: Ptr SparseBufferMemoryBindInfo -> IO SparseBufferMemoryBindInfo
peekCStruct Ptr SparseBufferMemoryBindInfo
p = do
    Buffer
buffer <- forall a. Storable a => Ptr a -> IO a
peek @Buffer ((Ptr SparseBufferMemoryBindInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Buffer))
    Word32
bindCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr SparseBufferMemoryBindInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32))
    Ptr SparseMemoryBind
pBinds <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr SparseMemoryBind) ((Ptr SparseBufferMemoryBindInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr SparseMemoryBind)))
    Vector SparseMemoryBind
pBinds' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
bindCount) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @SparseMemoryBind ((Ptr SparseMemoryBind
pBinds forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
40 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SparseMemoryBind)))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Buffer -> Vector SparseMemoryBind -> SparseBufferMemoryBindInfo
SparseBufferMemoryBindInfo
             Buffer
buffer Vector SparseMemoryBind
pBinds'

instance Zero SparseBufferMemoryBindInfo where
  zero :: SparseBufferMemoryBindInfo
zero = Buffer -> Vector SparseMemoryBind -> SparseBufferMemoryBindInfo
SparseBufferMemoryBindInfo
           forall a. Zero a => a
zero
           forall a. Monoid a => a
mempty


-- | VkSparseImageOpaqueMemoryBindInfo - Structure specifying sparse image
-- opaque memory bind information
--
-- == Valid Usage
--
-- -   #VUID-VkSparseImageOpaqueMemoryBindInfo-pBinds-01103# If the @flags@
--     member of any element of @pBinds@ contains
--     'Vulkan.Core10.Enums.SparseMemoryBindFlagBits.SPARSE_MEMORY_BIND_METADATA_BIT',
--     the binding range defined /must/ be within the mip tail region of
--     the metadata aspect of @image@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkSparseImageOpaqueMemoryBindInfo-image-parameter# @image@
--     /must/ be a valid 'Vulkan.Core10.Handles.Image' handle
--
-- -   #VUID-VkSparseImageOpaqueMemoryBindInfo-pBinds-parameter# @pBinds@
--     /must/ be a valid pointer to an array of @bindCount@ valid
--     'SparseMemoryBind' structures
--
-- -   #VUID-VkSparseImageOpaqueMemoryBindInfo-bindCount-arraylength#
--     @bindCount@ /must/ be greater than @0@
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'BindSparseInfo', 'Vulkan.Core10.Handles.Image', 'SparseMemoryBind'
data SparseImageOpaqueMemoryBindInfo = SparseImageOpaqueMemoryBindInfo
  { -- | @image@ is the 'Vulkan.Core10.Handles.Image' object to be bound.
    SparseImageOpaqueMemoryBindInfo -> Image
image :: Image
  , -- | @pBinds@ is a pointer to an array of 'SparseMemoryBind' structures.
    SparseImageOpaqueMemoryBindInfo -> Vector SparseMemoryBind
binds :: Vector SparseMemoryBind
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SparseImageOpaqueMemoryBindInfo)
#endif
deriving instance Show SparseImageOpaqueMemoryBindInfo

instance ToCStruct SparseImageOpaqueMemoryBindInfo where
  withCStruct :: forall b.
SparseImageOpaqueMemoryBindInfo
-> (Ptr SparseImageOpaqueMemoryBindInfo -> IO b) -> IO b
withCStruct SparseImageOpaqueMemoryBindInfo
x Ptr SparseImageOpaqueMemoryBindInfo -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr SparseImageOpaqueMemoryBindInfo
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SparseImageOpaqueMemoryBindInfo
p SparseImageOpaqueMemoryBindInfo
x (Ptr SparseImageOpaqueMemoryBindInfo -> IO b
f Ptr SparseImageOpaqueMemoryBindInfo
p)
  pokeCStruct :: forall b.
Ptr SparseImageOpaqueMemoryBindInfo
-> SparseImageOpaqueMemoryBindInfo -> IO b -> IO b
pokeCStruct Ptr SparseImageOpaqueMemoryBindInfo
p SparseImageOpaqueMemoryBindInfo{Vector SparseMemoryBind
Image
binds :: Vector SparseMemoryBind
image :: Image
$sel:binds:SparseImageOpaqueMemoryBindInfo :: SparseImageOpaqueMemoryBindInfo -> Vector SparseMemoryBind
$sel:image:SparseImageOpaqueMemoryBindInfo :: SparseImageOpaqueMemoryBindInfo -> Image
..} 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 SparseImageOpaqueMemoryBindInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Image)) (Image
image)
    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 SparseImageOpaqueMemoryBindInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: 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 SparseMemoryBind
binds)) :: Word32))
    Ptr SparseMemoryBind
pPBinds' <- 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 @SparseMemoryBind ((forall a. Vector a -> Int
Data.Vector.length (Vector SparseMemoryBind
binds)) forall a. Num a => a -> a -> a
* Int
40)
    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 SparseMemoryBind
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr SparseMemoryBind
pPBinds' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
40 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SparseMemoryBind) (SparseMemoryBind
e)) (Vector SparseMemoryBind
binds)
    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 SparseImageOpaqueMemoryBindInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr SparseMemoryBind))) (Ptr SparseMemoryBind
pPBinds')
    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
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr SparseImageOpaqueMemoryBindInfo -> IO b -> IO b
pokeZeroCStruct Ptr SparseImageOpaqueMemoryBindInfo
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SparseImageOpaqueMemoryBindInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Image)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct SparseImageOpaqueMemoryBindInfo where
  peekCStruct :: Ptr SparseImageOpaqueMemoryBindInfo
-> IO SparseImageOpaqueMemoryBindInfo
peekCStruct Ptr SparseImageOpaqueMemoryBindInfo
p = do
    Image
image <- forall a. Storable a => Ptr a -> IO a
peek @Image ((Ptr SparseImageOpaqueMemoryBindInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Image))
    Word32
bindCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr SparseImageOpaqueMemoryBindInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32))
    Ptr SparseMemoryBind
pBinds <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr SparseMemoryBind) ((Ptr SparseImageOpaqueMemoryBindInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr SparseMemoryBind)))
    Vector SparseMemoryBind
pBinds' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
bindCount) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @SparseMemoryBind ((Ptr SparseMemoryBind
pBinds forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
40 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SparseMemoryBind)))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Image -> Vector SparseMemoryBind -> SparseImageOpaqueMemoryBindInfo
SparseImageOpaqueMemoryBindInfo
             Image
image Vector SparseMemoryBind
pBinds'

instance Zero SparseImageOpaqueMemoryBindInfo where
  zero :: SparseImageOpaqueMemoryBindInfo
zero = Image -> Vector SparseMemoryBind -> SparseImageOpaqueMemoryBindInfo
SparseImageOpaqueMemoryBindInfo
           forall a. Zero a => a
zero
           forall a. Monoid a => a
mempty


-- | VkSparseImageMemoryBindInfo - Structure specifying sparse image memory
-- bind information
--
-- == Valid Usage
--
-- -   #VUID-VkSparseImageMemoryBindInfo-subresource-01722# The
--     @subresource.mipLevel@ member of each element of @pBinds@ /must/ be
--     less than the @mipLevels@ specified in
--     'Vulkan.Core10.Image.ImageCreateInfo' when @image@ was created
--
-- -   #VUID-VkSparseImageMemoryBindInfo-subresource-01723# The
--     @subresource.arrayLayer@ member of each element of @pBinds@ /must/
--     be less than the @arrayLayers@ specified in
--     'Vulkan.Core10.Image.ImageCreateInfo' when @image@ was created
--
-- -   #VUID-VkSparseImageMemoryBindInfo-image-02901# @image@ /must/ have
--     been created with
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SPARSE_RESIDENCY_BIT'
--     set
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkSparseImageMemoryBindInfo-image-parameter# @image@ /must/ be
--     a valid 'Vulkan.Core10.Handles.Image' handle
--
-- -   #VUID-VkSparseImageMemoryBindInfo-pBinds-parameter# @pBinds@ /must/
--     be a valid pointer to an array of @bindCount@ valid
--     'SparseImageMemoryBind' structures
--
-- -   #VUID-VkSparseImageMemoryBindInfo-bindCount-arraylength# @bindCount@
--     /must/ be greater than @0@
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'BindSparseInfo', 'Vulkan.Core10.Handles.Image', 'SparseImageMemoryBind'
data SparseImageMemoryBindInfo = SparseImageMemoryBindInfo
  { -- | @image@ is the 'Vulkan.Core10.Handles.Image' object to be bound
    SparseImageMemoryBindInfo -> Image
image :: Image
  , -- | @pBinds@ is a pointer to an array of 'SparseImageMemoryBind' structures
    SparseImageMemoryBindInfo -> Vector SparseImageMemoryBind
binds :: Vector SparseImageMemoryBind
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SparseImageMemoryBindInfo)
#endif
deriving instance Show SparseImageMemoryBindInfo

instance ToCStruct SparseImageMemoryBindInfo where
  withCStruct :: forall b.
SparseImageMemoryBindInfo
-> (Ptr SparseImageMemoryBindInfo -> IO b) -> IO b
withCStruct SparseImageMemoryBindInfo
x Ptr SparseImageMemoryBindInfo -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr SparseImageMemoryBindInfo
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SparseImageMemoryBindInfo
p SparseImageMemoryBindInfo
x (Ptr SparseImageMemoryBindInfo -> IO b
f Ptr SparseImageMemoryBindInfo
p)
  pokeCStruct :: forall b.
Ptr SparseImageMemoryBindInfo
-> SparseImageMemoryBindInfo -> IO b -> IO b
pokeCStruct Ptr SparseImageMemoryBindInfo
p SparseImageMemoryBindInfo{Vector SparseImageMemoryBind
Image
binds :: Vector SparseImageMemoryBind
image :: Image
$sel:binds:SparseImageMemoryBindInfo :: SparseImageMemoryBindInfo -> Vector SparseImageMemoryBind
$sel:image:SparseImageMemoryBindInfo :: SparseImageMemoryBindInfo -> Image
..} 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 SparseImageMemoryBindInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Image)) (Image
image)
    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 SparseImageMemoryBindInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: 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 SparseImageMemoryBind
binds)) :: Word32))
    Ptr SparseImageMemoryBind
pPBinds' <- 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 @SparseImageMemoryBind ((forall a. Vector a -> Int
Data.Vector.length (Vector SparseImageMemoryBind
binds)) forall a. Num a => a -> a -> a
* Int
64)
    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 SparseImageMemoryBind
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr SparseImageMemoryBind
pPBinds' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
64 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SparseImageMemoryBind) (SparseImageMemoryBind
e)) (Vector SparseImageMemoryBind
binds)
    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 SparseImageMemoryBindInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr SparseImageMemoryBind))) (Ptr SparseImageMemoryBind
pPBinds')
    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
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr SparseImageMemoryBindInfo -> IO b -> IO b
pokeZeroCStruct Ptr SparseImageMemoryBindInfo
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SparseImageMemoryBindInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Image)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct SparseImageMemoryBindInfo where
  peekCStruct :: Ptr SparseImageMemoryBindInfo -> IO SparseImageMemoryBindInfo
peekCStruct Ptr SparseImageMemoryBindInfo
p = do
    Image
image <- forall a. Storable a => Ptr a -> IO a
peek @Image ((Ptr SparseImageMemoryBindInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Image))
    Word32
bindCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr SparseImageMemoryBindInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32))
    Ptr SparseImageMemoryBind
pBinds <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr SparseImageMemoryBind) ((Ptr SparseImageMemoryBindInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr SparseImageMemoryBind)))
    Vector SparseImageMemoryBind
pBinds' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
bindCount) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @SparseImageMemoryBind ((Ptr SparseImageMemoryBind
pBinds forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
64 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SparseImageMemoryBind)))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Image -> Vector SparseImageMemoryBind -> SparseImageMemoryBindInfo
SparseImageMemoryBindInfo
             Image
image Vector SparseImageMemoryBind
pBinds'

instance Zero SparseImageMemoryBindInfo where
  zero :: SparseImageMemoryBindInfo
zero = Image -> Vector SparseImageMemoryBind -> SparseImageMemoryBindInfo
SparseImageMemoryBindInfo
           forall a. Zero a => a
zero
           forall a. Monoid a => a
mempty


-- | VkBindSparseInfo - Structure specifying a sparse binding operation
--
-- == Valid Usage
--
-- -   #VUID-VkBindSparseInfo-pWaitSemaphores-03246# If any element of
--     @pWaitSemaphores@ or @pSignalSemaphores@ was created with a
--     'Vulkan.Core12.Enums.SemaphoreType.SemaphoreType' of
--     'Vulkan.Core12.Enums.SemaphoreType.SEMAPHORE_TYPE_TIMELINE' then the
--     @pNext@ chain /must/ include a
--     'Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore.TimelineSemaphoreSubmitInfo'
--     structure
--
-- -   #VUID-VkBindSparseInfo-pNext-03247# If the @pNext@ chain of this
--     structure includes a
--     'Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore.TimelineSemaphoreSubmitInfo'
--     structure and any element of @pWaitSemaphores@ was created with a
--     'Vulkan.Core12.Enums.SemaphoreType.SemaphoreType' of
--     'Vulkan.Core12.Enums.SemaphoreType.SEMAPHORE_TYPE_TIMELINE' then its
--     @waitSemaphoreValueCount@ member /must/ equal @waitSemaphoreCount@
--
-- -   #VUID-VkBindSparseInfo-pNext-03248# If the @pNext@ chain of this
--     structure includes a
--     'Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore.TimelineSemaphoreSubmitInfo'
--     structure and any element of @pSignalSemaphores@ was created with a
--     'Vulkan.Core12.Enums.SemaphoreType.SemaphoreType' of
--     'Vulkan.Core12.Enums.SemaphoreType.SEMAPHORE_TYPE_TIMELINE' then its
--     @signalSemaphoreValueCount@ member /must/ equal
--     @signalSemaphoreCount@
--
-- -   #VUID-VkBindSparseInfo-pSignalSemaphores-03249# For each element of
--     @pSignalSemaphores@ created with a
--     'Vulkan.Core12.Enums.SemaphoreType.SemaphoreType' of
--     'Vulkan.Core12.Enums.SemaphoreType.SEMAPHORE_TYPE_TIMELINE' the
--     corresponding element of
--     'Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore.TimelineSemaphoreSubmitInfo'::@pSignalSemaphoreValues@
--     /must/ have a value greater than the current value of the semaphore
--     when the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-semaphores-signaling semaphore signal operation>
--     is executed
--
-- -   #VUID-VkBindSparseInfo-pWaitSemaphores-03250# For each element of
--     @pWaitSemaphores@ created with a
--     'Vulkan.Core12.Enums.SemaphoreType.SemaphoreType' of
--     'Vulkan.Core12.Enums.SemaphoreType.SEMAPHORE_TYPE_TIMELINE' the
--     corresponding element of
--     'Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore.TimelineSemaphoreSubmitInfo'::@pWaitSemaphoreValues@
--     /must/ have a value which does not differ from the current value of
--     the semaphore or from the value of any outstanding semaphore wait or
--     signal operation on that semaphore by more than
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#limits-maxTimelineSemaphoreValueDifference maxTimelineSemaphoreValueDifference>
--
-- -   #VUID-VkBindSparseInfo-pSignalSemaphores-03251# For each element of
--     @pSignalSemaphores@ created with a
--     'Vulkan.Core12.Enums.SemaphoreType.SemaphoreType' of
--     'Vulkan.Core12.Enums.SemaphoreType.SEMAPHORE_TYPE_TIMELINE' the
--     corresponding element of
--     'Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore.TimelineSemaphoreSubmitInfo'::@pSignalSemaphoreValues@
--     /must/ have a value which does not differ from the current value of
--     the semaphore or from the value of any outstanding semaphore wait or
--     signal operation on that semaphore by more than
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#limits-maxTimelineSemaphoreValueDifference maxTimelineSemaphoreValueDifference>
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkBindSparseInfo-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_BIND_SPARSE_INFO'
--
-- -   #VUID-VkBindSparseInfo-pNext-pNext# Each @pNext@ member of any
--     structure (including this one) in the @pNext@ chain /must/ be either
--     @NULL@ or a pointer to a valid instance of
--     'Vulkan.Core11.Promoted_From_VK_KHR_device_group.DeviceGroupBindSparseInfo'
--     or
--     'Vulkan.Core12.Promoted_From_VK_KHR_timeline_semaphore.TimelineSemaphoreSubmitInfo'
--
-- -   #VUID-VkBindSparseInfo-sType-unique# The @sType@ value of each
--     struct in the @pNext@ chain /must/ be unique
--
-- -   #VUID-VkBindSparseInfo-pWaitSemaphores-parameter# If
--     @waitSemaphoreCount@ is not @0@, @pWaitSemaphores@ /must/ be a valid
--     pointer to an array of @waitSemaphoreCount@ valid
--     'Vulkan.Core10.Handles.Semaphore' handles
--
-- -   #VUID-VkBindSparseInfo-pBufferBinds-parameter# If @bufferBindCount@
--     is not @0@, @pBufferBinds@ /must/ be a valid pointer to an array of
--     @bufferBindCount@ valid 'SparseBufferMemoryBindInfo' structures
--
-- -   #VUID-VkBindSparseInfo-pImageOpaqueBinds-parameter# If
--     @imageOpaqueBindCount@ is not @0@, @pImageOpaqueBinds@ /must/ be a
--     valid pointer to an array of @imageOpaqueBindCount@ valid
--     'SparseImageOpaqueMemoryBindInfo' structures
--
-- -   #VUID-VkBindSparseInfo-pImageBinds-parameter# If @imageBindCount@ is
--     not @0@, @pImageBinds@ /must/ be a valid pointer to an array of
--     @imageBindCount@ valid 'SparseImageMemoryBindInfo' structures
--
-- -   #VUID-VkBindSparseInfo-pSignalSemaphores-parameter# If
--     @signalSemaphoreCount@ is not @0@, @pSignalSemaphores@ /must/ be a
--     valid pointer to an array of @signalSemaphoreCount@ valid
--     'Vulkan.Core10.Handles.Semaphore' handles
--
-- -   #VUID-VkBindSparseInfo-commonparent# Both of the elements of
--     @pSignalSemaphores@, and the elements of @pWaitSemaphores@ that are
--     valid handles of non-ignored parameters /must/ have been created,
--     allocated, or retrieved from the same 'Vulkan.Core10.Handles.Device'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'Vulkan.Core10.Handles.Semaphore', 'SparseBufferMemoryBindInfo',
-- 'SparseImageMemoryBindInfo', 'SparseImageOpaqueMemoryBindInfo',
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'queueBindSparse'
data BindSparseInfo (es :: [Type]) = BindSparseInfo
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    forall (es :: [*]). BindSparseInfo es -> Chain es
next :: Chain es
  , -- | @pWaitSemaphores@ is a pointer to an array of semaphores upon which to
    -- wait on before the sparse binding operations for this batch begin
    -- execution. If semaphores to wait on are provided, they define a
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-semaphores-waiting semaphore wait operation>.
    forall (es :: [*]). BindSparseInfo es -> Vector Semaphore
waitSemaphores :: Vector Semaphore
  , -- | @pBufferBinds@ is a pointer to an array of 'SparseBufferMemoryBindInfo'
    -- structures.
    forall (es :: [*]).
BindSparseInfo es -> Vector SparseBufferMemoryBindInfo
bufferBinds :: Vector SparseBufferMemoryBindInfo
  , -- | @pImageOpaqueBinds@ is a pointer to an array of
    -- 'SparseImageOpaqueMemoryBindInfo' structures, indicating opaque sparse
    -- image bindings to perform.
    forall (es :: [*]).
BindSparseInfo es -> Vector SparseImageOpaqueMemoryBindInfo
imageOpaqueBinds :: Vector SparseImageOpaqueMemoryBindInfo
  , -- | @pImageBinds@ is a pointer to an array of 'SparseImageMemoryBindInfo'
    -- structures, indicating sparse image bindings to perform.
    forall (es :: [*]).
BindSparseInfo es -> Vector SparseImageMemoryBindInfo
imageBinds :: Vector SparseImageMemoryBindInfo
  , -- | @pSignalSemaphores@ is a pointer to an array of semaphores which will be
    -- signaled when the sparse binding operations for this batch have
    -- completed execution. If semaphores to be signaled are provided, they
    -- define a
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-semaphores-signaling semaphore signal operation>.
    forall (es :: [*]). BindSparseInfo es -> Vector Semaphore
signalSemaphores :: Vector Semaphore
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (BindSparseInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (BindSparseInfo es)

instance Extensible BindSparseInfo where
  extensibleTypeName :: String
extensibleTypeName = String
"BindSparseInfo"
  setNext :: forall (ds :: [*]) (es :: [*]).
BindSparseInfo ds -> Chain es -> BindSparseInfo es
setNext BindSparseInfo{Vector Semaphore
Vector SparseImageOpaqueMemoryBindInfo
Vector SparseImageMemoryBindInfo
Vector SparseBufferMemoryBindInfo
Chain ds
signalSemaphores :: Vector Semaphore
imageBinds :: Vector SparseImageMemoryBindInfo
imageOpaqueBinds :: Vector SparseImageOpaqueMemoryBindInfo
bufferBinds :: Vector SparseBufferMemoryBindInfo
waitSemaphores :: Vector Semaphore
next :: Chain ds
$sel:signalSemaphores:BindSparseInfo :: forall (es :: [*]). BindSparseInfo es -> Vector Semaphore
$sel:imageBinds:BindSparseInfo :: forall (es :: [*]).
BindSparseInfo es -> Vector SparseImageMemoryBindInfo
$sel:imageOpaqueBinds:BindSparseInfo :: forall (es :: [*]).
BindSparseInfo es -> Vector SparseImageOpaqueMemoryBindInfo
$sel:bufferBinds:BindSparseInfo :: forall (es :: [*]).
BindSparseInfo es -> Vector SparseBufferMemoryBindInfo
$sel:waitSemaphores:BindSparseInfo :: forall (es :: [*]). BindSparseInfo es -> Vector Semaphore
$sel:next:BindSparseInfo :: forall (es :: [*]). BindSparseInfo es -> Chain es
..} Chain es
next' = BindSparseInfo{$sel:next:BindSparseInfo :: Chain es
next = Chain es
next', Vector Semaphore
Vector SparseImageOpaqueMemoryBindInfo
Vector SparseImageMemoryBindInfo
Vector SparseBufferMemoryBindInfo
signalSemaphores :: Vector Semaphore
imageBinds :: Vector SparseImageMemoryBindInfo
imageOpaqueBinds :: Vector SparseImageOpaqueMemoryBindInfo
bufferBinds :: Vector SparseBufferMemoryBindInfo
waitSemaphores :: Vector Semaphore
$sel:signalSemaphores:BindSparseInfo :: Vector Semaphore
$sel:imageBinds:BindSparseInfo :: Vector SparseImageMemoryBindInfo
$sel:imageOpaqueBinds:BindSparseInfo :: Vector SparseImageOpaqueMemoryBindInfo
$sel:bufferBinds:BindSparseInfo :: Vector SparseBufferMemoryBindInfo
$sel:waitSemaphores:BindSparseInfo :: Vector Semaphore
..}
  getNext :: forall (es :: [*]). BindSparseInfo es -> Chain es
getNext BindSparseInfo{Vector Semaphore
Vector SparseImageOpaqueMemoryBindInfo
Vector SparseImageMemoryBindInfo
Vector SparseBufferMemoryBindInfo
Chain es
signalSemaphores :: Vector Semaphore
imageBinds :: Vector SparseImageMemoryBindInfo
imageOpaqueBinds :: Vector SparseImageOpaqueMemoryBindInfo
bufferBinds :: Vector SparseBufferMemoryBindInfo
waitSemaphores :: Vector Semaphore
next :: Chain es
$sel:signalSemaphores:BindSparseInfo :: forall (es :: [*]). BindSparseInfo es -> Vector Semaphore
$sel:imageBinds:BindSparseInfo :: forall (es :: [*]).
BindSparseInfo es -> Vector SparseImageMemoryBindInfo
$sel:imageOpaqueBinds:BindSparseInfo :: forall (es :: [*]).
BindSparseInfo es -> Vector SparseImageOpaqueMemoryBindInfo
$sel:bufferBinds:BindSparseInfo :: forall (es :: [*]).
BindSparseInfo es -> Vector SparseBufferMemoryBindInfo
$sel:waitSemaphores:BindSparseInfo :: forall (es :: [*]). BindSparseInfo es -> Vector Semaphore
$sel:next:BindSparseInfo :: forall (es :: [*]). BindSparseInfo es -> Chain es
..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends BindSparseInfo e => b) -> Maybe b
  extends :: forall e b (proxy :: * -> *).
Typeable e =>
proxy e -> (Extends BindSparseInfo e => b) -> Maybe b
extends proxy e
_ Extends BindSparseInfo e => b
f
    | Just e :~: TimelineSemaphoreSubmitInfo
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @TimelineSemaphoreSubmitInfo = forall a. a -> Maybe a
Just Extends BindSparseInfo e => b
f
    | Just e :~: DeviceGroupBindSparseInfo
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @DeviceGroupBindSparseInfo = forall a. a -> Maybe a
Just Extends BindSparseInfo e => b
f
    | Bool
otherwise = forall a. Maybe a
Nothing

instance ( Extendss BindSparseInfo es
         , PokeChain es ) => ToCStruct (BindSparseInfo es) where
  withCStruct :: forall b.
BindSparseInfo es -> (Ptr (BindSparseInfo es) -> IO b) -> IO b
withCStruct BindSparseInfo es
x Ptr (BindSparseInfo es) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
96 forall a b. (a -> b) -> a -> b
$ \Ptr (BindSparseInfo es)
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (BindSparseInfo es)
p BindSparseInfo es
x (Ptr (BindSparseInfo es) -> IO b
f Ptr (BindSparseInfo es)
p)
  pokeCStruct :: forall b.
Ptr (BindSparseInfo es) -> BindSparseInfo es -> IO b -> IO b
pokeCStruct Ptr (BindSparseInfo es)
p BindSparseInfo{Vector Semaphore
Vector SparseImageOpaqueMemoryBindInfo
Vector SparseImageMemoryBindInfo
Vector SparseBufferMemoryBindInfo
Chain es
signalSemaphores :: Vector Semaphore
imageBinds :: Vector SparseImageMemoryBindInfo
imageOpaqueBinds :: Vector SparseImageOpaqueMemoryBindInfo
bufferBinds :: Vector SparseBufferMemoryBindInfo
waitSemaphores :: Vector Semaphore
next :: Chain es
$sel:signalSemaphores:BindSparseInfo :: forall (es :: [*]). BindSparseInfo es -> Vector Semaphore
$sel:imageBinds:BindSparseInfo :: forall (es :: [*]).
BindSparseInfo es -> Vector SparseImageMemoryBindInfo
$sel:imageOpaqueBinds:BindSparseInfo :: forall (es :: [*]).
BindSparseInfo es -> Vector SparseImageOpaqueMemoryBindInfo
$sel:bufferBinds:BindSparseInfo :: forall (es :: [*]).
BindSparseInfo es -> Vector SparseBufferMemoryBindInfo
$sel:waitSemaphores:BindSparseInfo :: forall (es :: [*]). BindSparseInfo es -> Vector Semaphore
$sel:next:BindSparseInfo :: forall (es :: [*]). BindSparseInfo es -> Chain es
..} 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 (BindSparseInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_BIND_SPARSE_INFO)
    Ptr ()
pNext'' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
    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 (BindSparseInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext''
    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 (BindSparseInfo es)
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 Semaphore
waitSemaphores)) :: Word32))
    Ptr Semaphore
pPWaitSemaphores' <- 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 @Semaphore ((forall a. Vector a -> Int
Data.Vector.length (Vector Semaphore
waitSemaphores)) forall a. Num a => a -> a -> a
* Int
8)
    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 Semaphore
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Semaphore
pPWaitSemaphores' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Semaphore) (Semaphore
e)) (Vector Semaphore
waitSemaphores)
    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 (BindSparseInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr Semaphore))) (Ptr Semaphore
pPWaitSemaphores')
    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 (BindSparseInfo es)
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 SparseBufferMemoryBindInfo
bufferBinds)) :: Word32))
    Ptr SparseBufferMemoryBindInfo
pPBufferBinds' <- 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 @SparseBufferMemoryBindInfo ((forall a. Vector a -> Int
Data.Vector.length (Vector SparseBufferMemoryBindInfo
bufferBinds)) forall a. Num a => a -> a -> a
* Int
24)
    forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i SparseBufferMemoryBindInfo
e -> 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. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (Ptr SparseBufferMemoryBindInfo
pPBufferBinds' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
24 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SparseBufferMemoryBindInfo) (SparseBufferMemoryBindInfo
e) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())) (Vector SparseBufferMemoryBindInfo
bufferBinds)
    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 (BindSparseInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr SparseBufferMemoryBindInfo))) (Ptr SparseBufferMemoryBindInfo
pPBufferBinds')
    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 (BindSparseInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: 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 SparseImageOpaqueMemoryBindInfo
imageOpaqueBinds)) :: Word32))
    Ptr SparseImageOpaqueMemoryBindInfo
pPImageOpaqueBinds' <- 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 @SparseImageOpaqueMemoryBindInfo ((forall a. Vector a -> Int
Data.Vector.length (Vector SparseImageOpaqueMemoryBindInfo
imageOpaqueBinds)) forall a. Num a => a -> a -> a
* Int
24)
    forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i SparseImageOpaqueMemoryBindInfo
e -> 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. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (Ptr SparseImageOpaqueMemoryBindInfo
pPImageOpaqueBinds' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
24 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SparseImageOpaqueMemoryBindInfo) (SparseImageOpaqueMemoryBindInfo
e) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())) (Vector SparseImageOpaqueMemoryBindInfo
imageOpaqueBinds)
    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 (BindSparseInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr (Ptr SparseImageOpaqueMemoryBindInfo))) (Ptr SparseImageOpaqueMemoryBindInfo
pPImageOpaqueBinds')
    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 (BindSparseInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: 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 SparseImageMemoryBindInfo
imageBinds)) :: Word32))
    Ptr SparseImageMemoryBindInfo
pPImageBinds' <- 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 @SparseImageMemoryBindInfo ((forall a. Vector a -> Int
Data.Vector.length (Vector SparseImageMemoryBindInfo
imageBinds)) forall a. Num a => a -> a -> a
* Int
24)
    forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i SparseImageMemoryBindInfo
e -> 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. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (Ptr SparseImageMemoryBindInfo
pPImageBinds' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
24 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SparseImageMemoryBindInfo) (SparseImageMemoryBindInfo
e) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())) (Vector SparseImageMemoryBindInfo
imageBinds)
    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 (BindSparseInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr (Ptr SparseImageMemoryBindInfo))) (Ptr SparseImageMemoryBindInfo
pPImageBinds')
    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 (BindSparseInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80 :: 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 Semaphore
signalSemaphores)) :: Word32))
    Ptr Semaphore
pPSignalSemaphores' <- 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 @Semaphore ((forall a. Vector a -> Int
Data.Vector.length (Vector Semaphore
signalSemaphores)) forall a. Num a => a -> a -> a
* Int
8)
    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 Semaphore
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Semaphore
pPSignalSemaphores' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Semaphore) (Semaphore
e)) (Vector Semaphore
signalSemaphores)
    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 (BindSparseInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
88 :: Ptr (Ptr Semaphore))) (Ptr Semaphore
pPSignalSemaphores')
    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
96
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr (BindSparseInfo es) -> IO b -> IO b
pokeZeroCStruct Ptr (BindSparseInfo es)
p 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 (BindSparseInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_BIND_SPARSE_INFO)
    Ptr ()
pNext' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
    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 (BindSparseInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext'
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f

instance ( Extendss BindSparseInfo es
         , PeekChain es ) => FromCStruct (BindSparseInfo es) where
  peekCStruct :: Ptr (BindSparseInfo es) -> IO (BindSparseInfo es)
peekCStruct Ptr (BindSparseInfo es)
p = do
    Ptr ()
pNext <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (BindSparseInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ())))
    Chain es
next <- forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
    Word32
waitSemaphoreCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (BindSparseInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    Ptr Semaphore
pWaitSemaphores <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr Semaphore) ((Ptr (BindSparseInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr Semaphore)))
    Vector Semaphore
pWaitSemaphores' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
waitSemaphoreCount) (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @Semaphore ((Ptr Semaphore
pWaitSemaphores forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Semaphore)))
    Word32
bufferBindCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (BindSparseInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32))
    Ptr SparseBufferMemoryBindInfo
pBufferBinds <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr SparseBufferMemoryBindInfo) ((Ptr (BindSparseInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr SparseBufferMemoryBindInfo)))
    Vector SparseBufferMemoryBindInfo
pBufferBinds' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
bufferBindCount) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @SparseBufferMemoryBindInfo ((Ptr SparseBufferMemoryBindInfo
pBufferBinds forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
24 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SparseBufferMemoryBindInfo)))
    Word32
imageOpaqueBindCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (BindSparseInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Word32))
    Ptr SparseImageOpaqueMemoryBindInfo
pImageOpaqueBinds <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr SparseImageOpaqueMemoryBindInfo) ((Ptr (BindSparseInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr (Ptr SparseImageOpaqueMemoryBindInfo)))
    Vector SparseImageOpaqueMemoryBindInfo
pImageOpaqueBinds' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
imageOpaqueBindCount) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @SparseImageOpaqueMemoryBindInfo ((Ptr SparseImageOpaqueMemoryBindInfo
pImageOpaqueBinds forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
24 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SparseImageOpaqueMemoryBindInfo)))
    Word32
imageBindCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (BindSparseInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr Word32))
    Ptr SparseImageMemoryBindInfo
pImageBinds <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr SparseImageMemoryBindInfo) ((Ptr (BindSparseInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr (Ptr SparseImageMemoryBindInfo)))
    Vector SparseImageMemoryBindInfo
pImageBinds' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
imageBindCount) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @SparseImageMemoryBindInfo ((Ptr SparseImageMemoryBindInfo
pImageBinds forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
24 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SparseImageMemoryBindInfo)))
    Word32
signalSemaphoreCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (BindSparseInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80 :: Ptr Word32))
    Ptr Semaphore
pSignalSemaphores <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr Semaphore) ((Ptr (BindSparseInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
88 :: Ptr (Ptr Semaphore)))
    Vector Semaphore
pSignalSemaphores' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
signalSemaphoreCount) (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @Semaphore ((Ptr Semaphore
pSignalSemaphores forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Semaphore)))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (es :: [*]).
Chain es
-> Vector Semaphore
-> Vector SparseBufferMemoryBindInfo
-> Vector SparseImageOpaqueMemoryBindInfo
-> Vector SparseImageMemoryBindInfo
-> Vector Semaphore
-> BindSparseInfo es
BindSparseInfo
             Chain es
next
             Vector Semaphore
pWaitSemaphores'
             Vector SparseBufferMemoryBindInfo
pBufferBinds'
             Vector SparseImageOpaqueMemoryBindInfo
pImageOpaqueBinds'
             Vector SparseImageMemoryBindInfo
pImageBinds'
             Vector Semaphore
pSignalSemaphores'

instance es ~ '[] => Zero (BindSparseInfo es) where
  zero :: BindSparseInfo es
zero = forall (es :: [*]).
Chain es
-> Vector Semaphore
-> Vector SparseBufferMemoryBindInfo
-> Vector SparseImageOpaqueMemoryBindInfo
-> Vector SparseImageMemoryBindInfo
-> Vector Semaphore
-> BindSparseInfo es
BindSparseInfo
           ()
           forall a. Monoid a => a
mempty
           forall a. Monoid a => a
mempty
           forall a. Monoid a => a
mempty
           forall a. Monoid a => a
mempty
           forall a. Monoid a => a
mempty