{-# language CPP #-}
-- | = Name
--
-- VK_NV_copy_memory_indirect - device extension
--
-- == VK_NV_copy_memory_indirect
--
-- [__Name String__]
--     @VK_NV_copy_memory_indirect@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     427
--
-- [__Revision__]
--     1
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires support for Vulkan 1.0
--
--     -   Requires @VK_KHR_get_physical_device_properties2@ to be enabled
--         for any device-level functionality
--
--     -   Requires @VK_KHR_buffer_device_address@ to be enabled for any
--         device-level functionality
--
-- [__Contact__]
--
--     -   Vikram Kushwaha
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_NV_copy_memory_indirect] @vkushwaha-nv%0A*Here describe the issue or question you have about the VK_NV_copy_memory_indirect extension* >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2022-10-14
--
-- [__Contributors__]
--
--     -   Vikram Kushwaha, NVIDIA
--
--     -   Jeff Bolz, NVIDIA
--
--     -   Christoph Kubisch, NVIDIA
--
--     -   Daniel Koch, NVIDIA
--
-- == Description
--
-- This extension adds support for performing copies between memory and
-- image regions using indirect parameters that are read by the device from
-- a buffer during execution. This functionality /may/ be useful for
-- performing copies where the copy parameters are not known during the
-- command buffer creation time.
--
-- == New Commands
--
-- -   'cmdCopyMemoryIndirectNV'
--
-- -   'cmdCopyMemoryToImageIndirectNV'
--
-- == New Structures
--
-- -   'CopyMemoryIndirectCommandNV'
--
-- -   'CopyMemoryToImageIndirectCommandNV'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDeviceCopyMemoryIndirectFeaturesNV'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2':
--
--     -   'PhysicalDeviceCopyMemoryIndirectPropertiesNV'
--
-- == New Enum Constants
--
-- -   'NV_COPY_MEMORY_INDIRECT_EXTENSION_NAME'
--
-- -   'NV_COPY_MEMORY_INDIRECT_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_COPY_MEMORY_INDIRECT_FEATURES_NV'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_COPY_MEMORY_INDIRECT_PROPERTIES_NV'
--
-- == Version History
--
-- -   Revision 1, 2022-10-14 (Vikram Kushwaha)
--
--     -   Initial draft
--
-- == See Also
--
-- 'CopyMemoryIndirectCommandNV', 'CopyMemoryToImageIndirectCommandNV',
-- 'PhysicalDeviceCopyMemoryIndirectFeaturesNV',
-- 'PhysicalDeviceCopyMemoryIndirectPropertiesNV',
-- 'cmdCopyMemoryIndirectNV', 'cmdCopyMemoryToImageIndirectNV'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_NV_copy_memory_indirect Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_NV_copy_memory_indirect  ( cmdCopyMemoryIndirectNV
                                                     , cmdCopyMemoryToImageIndirectNV
                                                     , CopyMemoryIndirectCommandNV(..)
                                                     , CopyMemoryToImageIndirectCommandNV(..)
                                                     , PhysicalDeviceCopyMemoryIndirectFeaturesNV(..)
                                                     , PhysicalDeviceCopyMemoryIndirectPropertiesNV(..)
                                                     , NV_COPY_MEMORY_INDIRECT_SPEC_VERSION
                                                     , pattern NV_COPY_MEMORY_INDIRECT_SPEC_VERSION
                                                     , NV_COPY_MEMORY_INDIRECT_EXTENSION_NAME
                                                     , pattern NV_COPY_MEMORY_INDIRECT_EXTENSION_NAME
                                                     ) where

import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytes)
import GHC.IO (throwIO)
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 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.String (IsString)
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.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Handles (CommandBuffer)
import Vulkan.Core10.Handles (CommandBuffer(..))
import Vulkan.Core10.Handles (CommandBuffer(CommandBuffer))
import Vulkan.Core10.Handles (CommandBuffer_T)
import Vulkan.Core10.FundamentalTypes (DeviceAddress)
import Vulkan.Dynamic (DeviceCmds(pVkCmdCopyMemoryIndirectNV))
import Vulkan.Dynamic (DeviceCmds(pVkCmdCopyMemoryToImageIndirectNV))
import Vulkan.Core10.FundamentalTypes (DeviceSize)
import Vulkan.Core10.FundamentalTypes (Extent3D)
import Vulkan.Core10.Handles (Image)
import Vulkan.Core10.Handles (Image(..))
import Vulkan.Core10.Enums.ImageLayout (ImageLayout)
import Vulkan.Core10.Enums.ImageLayout (ImageLayout(..))
import Vulkan.Core10.CommandBufferBuilding (ImageSubresourceLayers)
import Vulkan.Core10.FundamentalTypes (Offset3D)
import Vulkan.Core10.Enums.QueueFlagBits (QueueFlags)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_COPY_MEMORY_INDIRECT_FEATURES_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_COPY_MEMORY_INDIRECT_PROPERTIES_NV))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdCopyMemoryIndirectNV
  :: FunPtr (Ptr CommandBuffer_T -> DeviceAddress -> Word32 -> Word32 -> IO ()) -> Ptr CommandBuffer_T -> DeviceAddress -> Word32 -> Word32 -> IO ()

-- | vkCmdCopyMemoryIndirectNV - Copy data between memory regions
--
-- = Description
--
-- Each region read from @copyBufferAddress@ is copied from the source
-- region to the specified destination region. The results are undefined if
-- any of the source and destination regions overlap in memory.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdCopyMemoryIndirectNV-None-07653# The
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-indirectCopy indirect copies>
--     feature /must/ be enabled
--
-- -   #VUID-vkCmdCopyMemoryIndirectNV-copyBufferAddress-07654#
--     @copyBufferAddress@ /must/ be 4 byte aligned
--
-- -   #VUID-vkCmdCopyMemoryIndirectNV-stride-07655# @stride@ /must/ be a
--     multiple of @4@ and /must/ be greater than or equal to
--     sizeof('CopyMemoryIndirectCommandNV')
--
-- -   #VUID-vkCmdCopyMemoryIndirectNV-commandBuffer-07656# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support at least one of the
--     'PhysicalDeviceCopyMemoryIndirectPropertiesNV'::@supportedQueues@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdCopyMemoryIndirectNV-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdCopyMemoryIndirectNV-commandBuffer-recording#
--     @commandBuffer@ /must/ be in the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#commandbuffers-lifecycle recording state>
--
-- -   #VUID-vkCmdCopyMemoryIndirectNV-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support transfer, graphics, or compute
--     operations
--
-- -   #VUID-vkCmdCopyMemoryIndirectNV-renderpass# This command /must/ only
--     be called outside of a render pass instance
--
-- -   #VUID-vkCmdCopyMemoryIndirectNV-videocoding# This command /must/
--     only be called outside of a video coding scope
--
-- == Host Synchronization
--
-- -   Host access to @commandBuffer@ /must/ be externally synchronized
--
-- -   Host access to the 'Vulkan.Core10.Handles.CommandPool' that
--     @commandBuffer@ was allocated from /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> |
-- +============================================================================================================================+========================================================================================================================+=============================================================================================================================+=======================================================================================================================+========================================================================================================================================+
-- | Primary                                                                                                                    | Outside                                                                                                                | Outside                                                                                                                     | Transfer                                                                                                              | Action                                                                                                                                 |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                             | Graphics                                                                                                              |                                                                                                                                        |
-- |                                                                                                                            |                                                                                                                        |                                                                                                                             | Compute                                                                                                               |                                                                                                                                        |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_copy_memory_indirect VK_NV_copy_memory_indirect>,
-- 'Vulkan.Core10.Handles.CommandBuffer',
-- 'Vulkan.Core10.FundamentalTypes.DeviceAddress'
cmdCopyMemoryIndirectNV :: forall io
                         . (MonadIO io)
                        => -- | @commandBuffer@ is the command buffer into which the command will be
                           -- recorded.
                           CommandBuffer
                        -> -- | @copyBufferAddress@ is the buffer address specifying the copy
                           -- parameters. This buffer is laid out in memory as an array of
                           -- 'CopyMemoryIndirectCommandNV' structures.
                           ("copyBufferAddress" ::: DeviceAddress)
                        -> -- | @copyCount@ is the number of copies to execute, and can be zero.
                           ("copyCount" ::: Word32)
                        -> -- | @stride@ is the stride in bytes between successive sets of copy
                           -- parameters.
                           ("stride" ::: Word32)
                        -> io ()
cmdCopyMemoryIndirectNV :: forall (io :: * -> *).
MonadIO io =>
CommandBuffer
-> ("copyBufferAddress" ::: DeviceAddress)
-> ("copyCount" ::: Word32)
-> ("copyCount" ::: Word32)
-> io ()
cmdCopyMemoryIndirectNV CommandBuffer
commandBuffer
                          "copyBufferAddress" ::: DeviceAddress
copyBufferAddress
                          "copyCount" ::: Word32
copyCount
                          "copyCount" ::: Word32
stride = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let vkCmdCopyMemoryIndirectNVPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("copyBufferAddress" ::: DeviceAddress)
   -> ("copyCount" ::: Word32)
   -> ("copyCount" ::: Word32)
   -> IO ())
vkCmdCopyMemoryIndirectNVPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("copyBufferAddress" ::: DeviceAddress)
      -> ("copyCount" ::: Word32)
      -> ("copyCount" ::: Word32)
      -> IO ())
pVkCmdCopyMemoryIndirectNV (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr CommandBuffer_T
   -> ("copyBufferAddress" ::: DeviceAddress)
   -> ("copyCount" ::: Word32)
   -> ("copyCount" ::: Word32)
   -> IO ())
vkCmdCopyMemoryIndirectNVPtr FunPtr
  (Ptr CommandBuffer_T
   -> ("copyBufferAddress" ::: DeviceAddress)
   -> ("copyCount" ::: Word32)
   -> ("copyCount" ::: Word32)
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("copyBufferAddress" ::: DeviceAddress)
      -> ("copyCount" ::: Word32)
      -> ("copyCount" ::: Word32)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("copyBufferAddress" ::: DeviceAddress)
   -> ("copyCount" ::: Word32)
   -> ("copyCount" ::: Word32)
   -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCmdCopyMemoryIndirectNV is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdCopyMemoryIndirectNV' :: Ptr CommandBuffer_T
-> ("copyBufferAddress" ::: DeviceAddress)
-> ("copyCount" ::: Word32)
-> ("copyCount" ::: Word32)
-> IO ()
vkCmdCopyMemoryIndirectNV' = FunPtr
  (Ptr CommandBuffer_T
   -> ("copyBufferAddress" ::: DeviceAddress)
   -> ("copyCount" ::: Word32)
   -> ("copyCount" ::: Word32)
   -> IO ())
-> Ptr CommandBuffer_T
-> ("copyBufferAddress" ::: DeviceAddress)
-> ("copyCount" ::: Word32)
-> ("copyCount" ::: Word32)
-> IO ()
mkVkCmdCopyMemoryIndirectNV FunPtr
  (Ptr CommandBuffer_T
   -> ("copyBufferAddress" ::: DeviceAddress)
   -> ("copyCount" ::: Word32)
   -> ("copyCount" ::: Word32)
   -> IO ())
vkCmdCopyMemoryIndirectNVPtr
  String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdCopyMemoryIndirectNV" (Ptr CommandBuffer_T
-> ("copyBufferAddress" ::: DeviceAddress)
-> ("copyCount" ::: Word32)
-> ("copyCount" ::: Word32)
-> IO ()
vkCmdCopyMemoryIndirectNV'
                                                  (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer))
                                                  ("copyBufferAddress" ::: DeviceAddress
copyBufferAddress)
                                                  ("copyCount" ::: Word32
copyCount)
                                                  ("copyCount" ::: Word32
stride))
  () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ ()


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdCopyMemoryToImageIndirectNV
  :: FunPtr (Ptr CommandBuffer_T -> DeviceAddress -> Word32 -> Word32 -> Image -> ImageLayout -> Ptr ImageSubresourceLayers -> IO ()) -> Ptr CommandBuffer_T -> DeviceAddress -> Word32 -> Word32 -> Image -> ImageLayout -> Ptr ImageSubresourceLayers -> IO ()

-- | vkCmdCopyMemoryToImageIndirectNV - Copy data from a memory region into
-- an image
--
-- = Description
--
-- Each region in @copyBufferAddress@ is copied from the source memory
-- region to an image region in the destination image. If the destination
-- image is of type 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_3D', the
-- starting slice and number of slices to copy are specified in
-- @pImageSubresources@::@baseArrayLayer@ and
-- @pImageSubresources@::@layerCount@ respectively. The copy /must/ be
-- performed on a queue that supports indirect copy operations, see
-- 'PhysicalDeviceCopyMemoryIndirectPropertiesNV'.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-None-07660# The
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-indirectCopy indirect copies>
--     feature /must/ be enabled
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-dstImage-07661# @dstImage@
--     /must/ not be a protected image
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-aspectMask-07662# The
--     @aspectMask@ member for every subresource in @pImageSubresources@
--     /must/ only have a single bit set
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-dstImage-07663# The image
--     region specified by each element in @copyBufferAddress@ /must/ be a
--     region that is contained within @dstImage@
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-dstImage-07664# @dstImage@
--     /must/ have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_TRANSFER_DST_BIT'
--     usage flag
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-dstImage-07665# If @dstImage@
--     is non-sparse then it /must/ be bound completely and contiguously to
--     a single 'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-dstImage-07666# @dstImage@
--     /must/ have a sample count equal to
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SAMPLE_COUNT_1_BIT'
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-dstImageLayout-07667#
--     @dstImageLayout@ /must/ specify the layout of the image subresources
--     of @dstImage@ at the time this command is executed on a
--     'Vulkan.Core10.Handles.Device'
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-dstImageLayout-07669#
--     @dstImageLayout@ /must/ be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_GENERAL', or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_SHARED_PRESENT_KHR'
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-mipLevel-07670# The specified
--     @mipLevel@ of each region /must/ be less than the @mipLevels@
--     specified in 'Vulkan.Core10.Image.ImageCreateInfo' when @dstImage@
--     was created
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-baseArrayLayer-07671# The
--     specified @baseArrayLayer@ + @layerCount@ of each region /must/ be
--     less than or equal to the @arrayLayers@ specified in
--     'Vulkan.Core10.Image.ImageCreateInfo' when @dstImage@ was created
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-imageOffset-07672# The
--     @imageOffset@ and @imageExtent@ members of each region /must/
--     respect the image transfer granularity requirements of
--     @commandBuffer@’s command pool’s queue family, as described in
--     'Vulkan.Core10.DeviceInitialization.QueueFamilyProperties'
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-dstImage-07673# @dstImage@
--     /must/ not have been created with @flags@ containing
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SUBSAMPLED_BIT_EXT'
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-commandBuffer-07674# If the
--     queue family used to create the 'Vulkan.Core10.Handles.CommandPool'
--     which @commandBuffer@ was allocated from does not support
--     'Vulkan.Core10.Enums.QueueFlagBits.QUEUE_GRAPHICS_BIT', for each
--     region, the @aspectMask@ member of @pImageSubresources@ /must/ not
--     be 'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_DEPTH_BIT'
--     or
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_STENCIL_BIT'.
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-imageOffset-07675# For each
--     region in @copyBufferAddress@, @imageOffset.y@ and
--     (@imageExtent.height@ + @imageOffset.y@) /must/ both be greater than
--     or equal to @0@ and less than or equal to the height of the
--     specified subresource
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-offset-07676# @offset@ /must/
--     be 4 byte aligned
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-stride-07677# @stride@ /must/
--     be a multiple of @4@ and /must/ be greater than or equal to
--     sizeof('CopyMemoryToImageIndirectCommandNV')
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-dstImage-parameter#
--     @dstImage@ /must/ be a valid 'Vulkan.Core10.Handles.Image' handle
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-dstImageLayout-parameter#
--     @dstImageLayout@ /must/ be a valid
--     'Vulkan.Core10.Enums.ImageLayout.ImageLayout' value
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-pImageSubresources-parameter#
--     @pImageSubresources@ /must/ be a valid pointer to an array of
--     @copyCount@ valid
--     'Vulkan.Core10.CommandBufferBuilding.ImageSubresourceLayers'
--     structures
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-commandBuffer-recording#
--     @commandBuffer@ /must/ be in the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#commandbuffers-lifecycle recording state>
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support transfer, graphics, or compute
--     operations
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-renderpass# This command
--     /must/ only be called outside of a render pass instance
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-videocoding# This command
--     /must/ only be called outside of a video coding scope
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-copyCount-arraylength#
--     @copyCount@ /must/ be greater than @0@
--
-- -   #VUID-vkCmdCopyMemoryToImageIndirectNV-commonparent# Both of
--     @commandBuffer@, and @dstImage@ /must/ have been created, allocated,
--     or retrieved from the same 'Vulkan.Core10.Handles.Device'
--
-- == Host Synchronization
--
-- -   Host access to @commandBuffer@ /must/ be externally synchronized
--
-- -   Host access to the 'Vulkan.Core10.Handles.CommandPool' that
--     @commandBuffer@ was allocated from /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> |
-- +============================================================================================================================+========================================================================================================================+=============================================================================================================================+=======================================================================================================================+========================================================================================================================================+
-- | Primary                                                                                                                    | Outside                                                                                                                | Outside                                                                                                                     | Transfer                                                                                                              | Action                                                                                                                                 |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                             | Graphics                                                                                                              |                                                                                                                                        |
-- |                                                                                                                            |                                                                                                                        |                                                                                                                             | Compute                                                                                                               |                                                                                                                                        |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_copy_memory_indirect VK_NV_copy_memory_indirect>,
-- 'Vulkan.Core10.Handles.CommandBuffer',
-- 'Vulkan.Core10.FundamentalTypes.DeviceAddress',
-- 'Vulkan.Core10.Handles.Image',
-- 'Vulkan.Core10.Enums.ImageLayout.ImageLayout',
-- 'Vulkan.Core10.CommandBufferBuilding.ImageSubresourceLayers'
cmdCopyMemoryToImageIndirectNV :: forall io
                                . (MonadIO io)
                               => -- | @commandBuffer@ is the command buffer into which the command will be
                                  -- recorded.
                                  CommandBuffer
                               -> -- | @copyBufferAddress@ is the buffer address specifying the copy
                                  -- parameters. This buffer is laid out in memory as an array of
                                  -- 'CopyMemoryToImageIndirectCommandNV' structures.
                                  ("copyBufferAddress" ::: DeviceAddress)
                               -> -- | @stride@ is the byte stride between successive sets of copy parameters.
                                  ("stride" ::: Word32)
                               -> -- | @dstImage@ is the destination image.
                                  ("dstImage" ::: Image)
                               -> -- | @dstImageLayout@ is the layout of the destination image subresources for
                                  -- the copy.
                                  ("dstImageLayout" ::: ImageLayout)
                               -> -- | @pImageSubresources@ is a pointer to an array of size @copyCount@ of
                                  -- 'Vulkan.Core10.CommandBufferBuilding.ImageSubresourceLayers' used to
                                  -- specify the specific image subresource of the destination image data for
                                  -- that copy.
                                  ("imageSubresources" ::: Vector ImageSubresourceLayers)
                               -> io ()
cmdCopyMemoryToImageIndirectNV :: forall (io :: * -> *).
MonadIO io =>
CommandBuffer
-> ("copyBufferAddress" ::: DeviceAddress)
-> ("copyCount" ::: Word32)
-> ("dstImage" ::: Image)
-> ("dstImageLayout" ::: ImageLayout)
-> ("imageSubresources" ::: Vector ImageSubresourceLayers)
-> io ()
cmdCopyMemoryToImageIndirectNV CommandBuffer
commandBuffer
                                 "copyBufferAddress" ::: DeviceAddress
copyBufferAddress
                                 "copyCount" ::: Word32
stride
                                 "dstImage" ::: Image
dstImage
                                 "dstImageLayout" ::: ImageLayout
dstImageLayout
                                 "imageSubresources" ::: Vector ImageSubresourceLayers
imageSubresources = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let vkCmdCopyMemoryToImageIndirectNVPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("copyBufferAddress" ::: DeviceAddress)
   -> ("copyCount" ::: Word32)
   -> ("copyCount" ::: Word32)
   -> ("dstImage" ::: Image)
   -> ("dstImageLayout" ::: ImageLayout)
   -> ("pImageSubresources" ::: Ptr ImageSubresourceLayers)
   -> IO ())
vkCmdCopyMemoryToImageIndirectNVPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("copyBufferAddress" ::: DeviceAddress)
      -> ("copyCount" ::: Word32)
      -> ("copyCount" ::: Word32)
      -> ("dstImage" ::: Image)
      -> ("dstImageLayout" ::: ImageLayout)
      -> ("pImageSubresources" ::: Ptr ImageSubresourceLayers)
      -> IO ())
pVkCmdCopyMemoryToImageIndirectNV (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr CommandBuffer_T
   -> ("copyBufferAddress" ::: DeviceAddress)
   -> ("copyCount" ::: Word32)
   -> ("copyCount" ::: Word32)
   -> ("dstImage" ::: Image)
   -> ("dstImageLayout" ::: ImageLayout)
   -> ("pImageSubresources" ::: Ptr ImageSubresourceLayers)
   -> IO ())
vkCmdCopyMemoryToImageIndirectNVPtr FunPtr
  (Ptr CommandBuffer_T
   -> ("copyBufferAddress" ::: DeviceAddress)
   -> ("copyCount" ::: Word32)
   -> ("copyCount" ::: Word32)
   -> ("dstImage" ::: Image)
   -> ("dstImageLayout" ::: ImageLayout)
   -> ("pImageSubresources" ::: Ptr ImageSubresourceLayers)
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("copyBufferAddress" ::: DeviceAddress)
      -> ("copyCount" ::: Word32)
      -> ("copyCount" ::: Word32)
      -> ("dstImage" ::: Image)
      -> ("dstImageLayout" ::: ImageLayout)
      -> ("pImageSubresources" ::: Ptr ImageSubresourceLayers)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("copyBufferAddress" ::: DeviceAddress)
   -> ("copyCount" ::: Word32)
   -> ("copyCount" ::: Word32)
   -> ("dstImage" ::: Image)
   -> ("dstImageLayout" ::: ImageLayout)
   -> ("pImageSubresources" ::: Ptr ImageSubresourceLayers)
   -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCmdCopyMemoryToImageIndirectNV is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdCopyMemoryToImageIndirectNV' :: Ptr CommandBuffer_T
-> ("copyBufferAddress" ::: DeviceAddress)
-> ("copyCount" ::: Word32)
-> ("copyCount" ::: Word32)
-> ("dstImage" ::: Image)
-> ("dstImageLayout" ::: ImageLayout)
-> ("pImageSubresources" ::: Ptr ImageSubresourceLayers)
-> IO ()
vkCmdCopyMemoryToImageIndirectNV' = FunPtr
  (Ptr CommandBuffer_T
   -> ("copyBufferAddress" ::: DeviceAddress)
   -> ("copyCount" ::: Word32)
   -> ("copyCount" ::: Word32)
   -> ("dstImage" ::: Image)
   -> ("dstImageLayout" ::: ImageLayout)
   -> ("pImageSubresources" ::: Ptr ImageSubresourceLayers)
   -> IO ())
-> Ptr CommandBuffer_T
-> ("copyBufferAddress" ::: DeviceAddress)
-> ("copyCount" ::: Word32)
-> ("copyCount" ::: Word32)
-> ("dstImage" ::: Image)
-> ("dstImageLayout" ::: ImageLayout)
-> ("pImageSubresources" ::: Ptr ImageSubresourceLayers)
-> IO ()
mkVkCmdCopyMemoryToImageIndirectNV FunPtr
  (Ptr CommandBuffer_T
   -> ("copyBufferAddress" ::: DeviceAddress)
   -> ("copyCount" ::: Word32)
   -> ("copyCount" ::: Word32)
   -> ("dstImage" ::: Image)
   -> ("dstImageLayout" ::: ImageLayout)
   -> ("pImageSubresources" ::: Ptr ImageSubresourceLayers)
   -> IO ())
vkCmdCopyMemoryToImageIndirectNVPtr
  "pImageSubresources" ::: Ptr ImageSubresourceLayers
pPImageSubresources <- ((("pImageSubresources" ::: Ptr ImageSubresourceLayers) -> IO ())
 -> IO ())
-> ContT
     () IO ("pImageSubresources" ::: Ptr ImageSubresourceLayers)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pImageSubresources" ::: Ptr ImageSubresourceLayers) -> IO ())
  -> IO ())
 -> ContT
      () IO ("pImageSubresources" ::: Ptr ImageSubresourceLayers))
-> ((("pImageSubresources" ::: Ptr ImageSubresourceLayers)
     -> IO ())
    -> IO ())
-> ContT
     () IO ("pImageSubresources" ::: Ptr ImageSubresourceLayers)
forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @ImageSubresourceLayers ((("imageSubresources" ::: Vector ImageSubresourceLayers) -> Int
forall a. Vector a -> Int
Data.Vector.length ("imageSubresources" ::: Vector ImageSubresourceLayers
imageSubresources)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16)
  IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> ImageSubresourceLayers -> IO ())
-> ("imageSubresources" ::: Vector ImageSubresourceLayers) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i ImageSubresourceLayers
e -> ("pImageSubresources" ::: Ptr ImageSubresourceLayers)
-> ImageSubresourceLayers -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pImageSubresources" ::: Ptr ImageSubresourceLayers
pPImageSubresources ("pImageSubresources" ::: Ptr ImageSubresourceLayers)
-> Int -> "pImageSubresources" ::: Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr ImageSubresourceLayers) (ImageSubresourceLayers
e)) ("imageSubresources" ::: Vector ImageSubresourceLayers
imageSubresources)
  IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdCopyMemoryToImageIndirectNV" (Ptr CommandBuffer_T
-> ("copyBufferAddress" ::: DeviceAddress)
-> ("copyCount" ::: Word32)
-> ("copyCount" ::: Word32)
-> ("dstImage" ::: Image)
-> ("dstImageLayout" ::: ImageLayout)
-> ("pImageSubresources" ::: Ptr ImageSubresourceLayers)
-> IO ()
vkCmdCopyMemoryToImageIndirectNV'
                                                                (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer))
                                                                ("copyBufferAddress" ::: DeviceAddress
copyBufferAddress)
                                                                ((Int -> "copyCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("imageSubresources" ::: Vector ImageSubresourceLayers) -> Int
forall a. Vector a -> Int
Data.Vector.length (("imageSubresources" ::: Vector ImageSubresourceLayers) -> Int)
-> ("imageSubresources" ::: Vector ImageSubresourceLayers) -> Int
forall a b. (a -> b) -> a -> b
$ ("imageSubresources" ::: Vector ImageSubresourceLayers
imageSubresources)) :: Word32))
                                                                ("copyCount" ::: Word32
stride)
                                                                ("dstImage" ::: Image
dstImage)
                                                                ("dstImageLayout" ::: ImageLayout
dstImageLayout)
                                                                ("pImageSubresources" ::: Ptr ImageSubresourceLayers
pPImageSubresources))
  () -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()


-- | VkCopyMemoryIndirectCommandNV - Structure specifying indirect memory
-- region copy operation
--
-- == Valid Usage
--
-- -   #VUID-VkCopyMemoryIndirectCommandNV-srcAddress-07657# The
--     @srcAddress@ /must/ be 4 byte aligned
--
-- -   #VUID-VkCopyMemoryIndirectCommandNV-dstAddress-07658# The
--     @dstAddress@ /must/ be 4 byte aligned
--
-- -   #VUID-VkCopyMemoryIndirectCommandNV-size-07659# The @size@ /must/ be
--     4 byte aligned
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_copy_memory_indirect VK_NV_copy_memory_indirect>,
-- 'Vulkan.Core10.FundamentalTypes.DeviceAddress',
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize'
data CopyMemoryIndirectCommandNV = CopyMemoryIndirectCommandNV
  { -- | @srcAddress@ is the starting address of the source host or device memory
    -- to copy from.
    CopyMemoryIndirectCommandNV
-> "copyBufferAddress" ::: DeviceAddress
srcAddress :: DeviceAddress
  , -- | @dstAddress@ is the starting address of the destination host or device
    -- memory to copy to.
    CopyMemoryIndirectCommandNV
-> "copyBufferAddress" ::: DeviceAddress
dstAddress :: DeviceAddress
  , -- | @size@ is the size of the copy in bytes.
    CopyMemoryIndirectCommandNV
-> "copyBufferAddress" ::: DeviceAddress
size :: DeviceSize
  }
  deriving (Typeable, CopyMemoryIndirectCommandNV -> CopyMemoryIndirectCommandNV -> Bool
(CopyMemoryIndirectCommandNV
 -> CopyMemoryIndirectCommandNV -> Bool)
-> (CopyMemoryIndirectCommandNV
    -> CopyMemoryIndirectCommandNV -> Bool)
-> Eq CopyMemoryIndirectCommandNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CopyMemoryIndirectCommandNV -> CopyMemoryIndirectCommandNV -> Bool
$c/= :: CopyMemoryIndirectCommandNV -> CopyMemoryIndirectCommandNV -> Bool
== :: CopyMemoryIndirectCommandNV -> CopyMemoryIndirectCommandNV -> Bool
$c== :: CopyMemoryIndirectCommandNV -> CopyMemoryIndirectCommandNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CopyMemoryIndirectCommandNV)
#endif
deriving instance Show CopyMemoryIndirectCommandNV

instance ToCStruct CopyMemoryIndirectCommandNV where
  withCStruct :: forall b.
CopyMemoryIndirectCommandNV
-> (Ptr CopyMemoryIndirectCommandNV -> IO b) -> IO b
withCStruct CopyMemoryIndirectCommandNV
x Ptr CopyMemoryIndirectCommandNV -> IO b
f = Int -> (Ptr CopyMemoryIndirectCommandNV -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr CopyMemoryIndirectCommandNV -> IO b) -> IO b)
-> (Ptr CopyMemoryIndirectCommandNV -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr CopyMemoryIndirectCommandNV
p -> Ptr CopyMemoryIndirectCommandNV
-> CopyMemoryIndirectCommandNV -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr CopyMemoryIndirectCommandNV
p CopyMemoryIndirectCommandNV
x (Ptr CopyMemoryIndirectCommandNV -> IO b
f Ptr CopyMemoryIndirectCommandNV
p)
  pokeCStruct :: forall b.
Ptr CopyMemoryIndirectCommandNV
-> CopyMemoryIndirectCommandNV -> IO b -> IO b
pokeCStruct Ptr CopyMemoryIndirectCommandNV
p CopyMemoryIndirectCommandNV{"copyBufferAddress" ::: DeviceAddress
size :: "copyBufferAddress" ::: DeviceAddress
dstAddress :: "copyBufferAddress" ::: DeviceAddress
srcAddress :: "copyBufferAddress" ::: DeviceAddress
$sel:size:CopyMemoryIndirectCommandNV :: CopyMemoryIndirectCommandNV
-> "copyBufferAddress" ::: DeviceAddress
$sel:dstAddress:CopyMemoryIndirectCommandNV :: CopyMemoryIndirectCommandNV
-> "copyBufferAddress" ::: DeviceAddress
$sel:srcAddress:CopyMemoryIndirectCommandNV :: CopyMemoryIndirectCommandNV
-> "copyBufferAddress" ::: DeviceAddress
..} IO b
f = do
    Ptr ("copyBufferAddress" ::: DeviceAddress)
-> ("copyBufferAddress" ::: DeviceAddress) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CopyMemoryIndirectCommandNV
p Ptr CopyMemoryIndirectCommandNV
-> Int -> Ptr ("copyBufferAddress" ::: DeviceAddress)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DeviceAddress)) ("copyBufferAddress" ::: DeviceAddress
srcAddress)
    Ptr ("copyBufferAddress" ::: DeviceAddress)
-> ("copyBufferAddress" ::: DeviceAddress) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CopyMemoryIndirectCommandNV
p Ptr CopyMemoryIndirectCommandNV
-> Int -> Ptr ("copyBufferAddress" ::: DeviceAddress)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr DeviceAddress)) ("copyBufferAddress" ::: DeviceAddress
dstAddress)
    Ptr ("copyBufferAddress" ::: DeviceAddress)
-> ("copyBufferAddress" ::: DeviceAddress) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CopyMemoryIndirectCommandNV
p Ptr CopyMemoryIndirectCommandNV
-> Int -> Ptr ("copyBufferAddress" ::: DeviceAddress)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceSize)) ("copyBufferAddress" ::: DeviceAddress
size)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr CopyMemoryIndirectCommandNV -> IO b -> IO b
pokeZeroCStruct Ptr CopyMemoryIndirectCommandNV
p IO b
f = do
    Ptr ("copyBufferAddress" ::: DeviceAddress)
-> ("copyBufferAddress" ::: DeviceAddress) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CopyMemoryIndirectCommandNV
p Ptr CopyMemoryIndirectCommandNV
-> Int -> Ptr ("copyBufferAddress" ::: DeviceAddress)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DeviceAddress)) ("copyBufferAddress" ::: DeviceAddress
forall a. Zero a => a
zero)
    Ptr ("copyBufferAddress" ::: DeviceAddress)
-> ("copyBufferAddress" ::: DeviceAddress) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CopyMemoryIndirectCommandNV
p Ptr CopyMemoryIndirectCommandNV
-> Int -> Ptr ("copyBufferAddress" ::: DeviceAddress)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr DeviceAddress)) ("copyBufferAddress" ::: DeviceAddress
forall a. Zero a => a
zero)
    Ptr ("copyBufferAddress" ::: DeviceAddress)
-> ("copyBufferAddress" ::: DeviceAddress) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CopyMemoryIndirectCommandNV
p Ptr CopyMemoryIndirectCommandNV
-> Int -> Ptr ("copyBufferAddress" ::: DeviceAddress)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceSize)) ("copyBufferAddress" ::: DeviceAddress
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct CopyMemoryIndirectCommandNV where
  peekCStruct :: Ptr CopyMemoryIndirectCommandNV -> IO CopyMemoryIndirectCommandNV
peekCStruct Ptr CopyMemoryIndirectCommandNV
p = do
    "copyBufferAddress" ::: DeviceAddress
srcAddress <- forall a. Storable a => Ptr a -> IO a
peek @DeviceAddress ((Ptr CopyMemoryIndirectCommandNV
p Ptr CopyMemoryIndirectCommandNV
-> Int -> Ptr ("copyBufferAddress" ::: DeviceAddress)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DeviceAddress))
    "copyBufferAddress" ::: DeviceAddress
dstAddress <- forall a. Storable a => Ptr a -> IO a
peek @DeviceAddress ((Ptr CopyMemoryIndirectCommandNV
p Ptr CopyMemoryIndirectCommandNV
-> Int -> Ptr ("copyBufferAddress" ::: DeviceAddress)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr DeviceAddress))
    "copyBufferAddress" ::: DeviceAddress
size <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr CopyMemoryIndirectCommandNV
p Ptr CopyMemoryIndirectCommandNV
-> Int -> Ptr ("copyBufferAddress" ::: DeviceAddress)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceSize))
    CopyMemoryIndirectCommandNV -> IO CopyMemoryIndirectCommandNV
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CopyMemoryIndirectCommandNV -> IO CopyMemoryIndirectCommandNV)
-> CopyMemoryIndirectCommandNV -> IO CopyMemoryIndirectCommandNV
forall a b. (a -> b) -> a -> b
$ ("copyBufferAddress" ::: DeviceAddress)
-> ("copyBufferAddress" ::: DeviceAddress)
-> ("copyBufferAddress" ::: DeviceAddress)
-> CopyMemoryIndirectCommandNV
CopyMemoryIndirectCommandNV
             "copyBufferAddress" ::: DeviceAddress
srcAddress "copyBufferAddress" ::: DeviceAddress
dstAddress "copyBufferAddress" ::: DeviceAddress
size

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

instance Zero CopyMemoryIndirectCommandNV where
  zero :: CopyMemoryIndirectCommandNV
zero = ("copyBufferAddress" ::: DeviceAddress)
-> ("copyBufferAddress" ::: DeviceAddress)
-> ("copyBufferAddress" ::: DeviceAddress)
-> CopyMemoryIndirectCommandNV
CopyMemoryIndirectCommandNV
           "copyBufferAddress" ::: DeviceAddress
forall a. Zero a => a
zero
           "copyBufferAddress" ::: DeviceAddress
forall a. Zero a => a
zero
           "copyBufferAddress" ::: DeviceAddress
forall a. Zero a => a
zero


-- | VkCopyMemoryToImageIndirectCommandNV - Structure specifying indirect
-- buffer image copy operation
--
-- == Valid Usage
--
-- -   #VUID-VkCopyMemoryToImageIndirectCommandNV-srcAddress-07678# The
--     @srcAddress@ /must/ be 4 byte aligned
--
-- -   #VUID-VkCopyMemoryToImageIndirectCommandNV-bufferRowLength-07679#
--     @bufferRowLength@ /must/ be @0@, or greater than or equal to the
--     @width@ member of @imageExtent@
--
-- -   #VUID-VkCopyMemoryToImageIndirectCommandNV-bufferImageHeight-07680#
--     @bufferImageHeight@ /must/ be @0@, or greater than or equal to the
--     @height@ member of @imageExtent@
--
-- -   #VUID-VkCopyMemoryToImageIndirectCommandNV-imageOffset-07681#
--     @imageOffset@ /must/ specify a valid offset in the destination image
--
-- -   #VUID-VkCopyMemoryToImageIndirectCommandNV-imageExtent-07682#
--     @imageExtent@ /must/ specify a valid region in the destination image
--     and can be @0@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkCopyMemoryToImageIndirectCommandNV-imageSubresource-parameter#
--     @imageSubresource@ /must/ be a valid
--     'Vulkan.Core10.CommandBufferBuilding.ImageSubresourceLayers'
--     structure
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_copy_memory_indirect VK_NV_copy_memory_indirect>,
-- 'Vulkan.Core10.FundamentalTypes.DeviceAddress',
-- 'Vulkan.Core10.FundamentalTypes.Extent3D',
-- 'Vulkan.Core10.CommandBufferBuilding.ImageSubresourceLayers',
-- 'Vulkan.Core10.FundamentalTypes.Offset3D'
data CopyMemoryToImageIndirectCommandNV = CopyMemoryToImageIndirectCommandNV
  { -- | @srcAddress@ is the starting address of the source host or device memory
    -- to copy from.
    CopyMemoryToImageIndirectCommandNV
-> "copyBufferAddress" ::: DeviceAddress
srcAddress :: DeviceAddress
  , -- | @bufferRowLength@ and @bufferImageHeight@ specify in texels a subregion
    -- of a larger two- or three-dimensional image in buffer memory, and
    -- control the addressing calculations. If either of these values is zero,
    -- that aspect of the buffer memory is considered to be tightly packed
    -- according to the @imageExtent@.
    CopyMemoryToImageIndirectCommandNV -> "copyCount" ::: Word32
bufferRowLength :: Word32
  , -- No documentation found for Nested "VkCopyMemoryToImageIndirectCommandNV" "bufferImageHeight"
    CopyMemoryToImageIndirectCommandNV -> "copyCount" ::: Word32
bufferImageHeight :: Word32
  , -- | @imageSubresource@ is a
    -- 'Vulkan.Core10.CommandBufferBuilding.ImageSubresourceLayers' used to
    -- specify the specific image subresources of the image used for the
    -- destination image data, which /must/ match the values specified in
    -- @pImageSubresources@ parameter of 'cmdCopyMemoryToImageIndirectNV'
    -- during command recording.
    CopyMemoryToImageIndirectCommandNV -> ImageSubresourceLayers
imageSubresource :: ImageSubresourceLayers
  , -- | @imageOffset@ selects the initial @x@, @y@, @z@ offsets in texels of the
    -- sub-region of the destination image data.
    CopyMemoryToImageIndirectCommandNV -> Offset3D
imageOffset :: Offset3D
  , -- | @imageExtent@ is the size in texels of the destination image in @width@,
    -- @height@ and @depth@.
    CopyMemoryToImageIndirectCommandNV -> Extent3D
imageExtent :: Extent3D
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CopyMemoryToImageIndirectCommandNV)
#endif
deriving instance Show CopyMemoryToImageIndirectCommandNV

instance ToCStruct CopyMemoryToImageIndirectCommandNV where
  withCStruct :: forall b.
CopyMemoryToImageIndirectCommandNV
-> (Ptr CopyMemoryToImageIndirectCommandNV -> IO b) -> IO b
withCStruct CopyMemoryToImageIndirectCommandNV
x Ptr CopyMemoryToImageIndirectCommandNV -> IO b
f = Int -> (Ptr CopyMemoryToImageIndirectCommandNV -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
56 ((Ptr CopyMemoryToImageIndirectCommandNV -> IO b) -> IO b)
-> (Ptr CopyMemoryToImageIndirectCommandNV -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr CopyMemoryToImageIndirectCommandNV
p -> Ptr CopyMemoryToImageIndirectCommandNV
-> CopyMemoryToImageIndirectCommandNV -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr CopyMemoryToImageIndirectCommandNV
p CopyMemoryToImageIndirectCommandNV
x (Ptr CopyMemoryToImageIndirectCommandNV -> IO b
f Ptr CopyMemoryToImageIndirectCommandNV
p)
  pokeCStruct :: forall b.
Ptr CopyMemoryToImageIndirectCommandNV
-> CopyMemoryToImageIndirectCommandNV -> IO b -> IO b
pokeCStruct Ptr CopyMemoryToImageIndirectCommandNV
p CopyMemoryToImageIndirectCommandNV{"copyCount" ::: Word32
"copyBufferAddress" ::: DeviceAddress
ImageSubresourceLayers
Offset3D
Extent3D
imageExtent :: Extent3D
imageOffset :: Offset3D
imageSubresource :: ImageSubresourceLayers
bufferImageHeight :: "copyCount" ::: Word32
bufferRowLength :: "copyCount" ::: Word32
srcAddress :: "copyBufferAddress" ::: DeviceAddress
$sel:imageExtent:CopyMemoryToImageIndirectCommandNV :: CopyMemoryToImageIndirectCommandNV -> Extent3D
$sel:imageOffset:CopyMemoryToImageIndirectCommandNV :: CopyMemoryToImageIndirectCommandNV -> Offset3D
$sel:imageSubresource:CopyMemoryToImageIndirectCommandNV :: CopyMemoryToImageIndirectCommandNV -> ImageSubresourceLayers
$sel:bufferImageHeight:CopyMemoryToImageIndirectCommandNV :: CopyMemoryToImageIndirectCommandNV -> "copyCount" ::: Word32
$sel:bufferRowLength:CopyMemoryToImageIndirectCommandNV :: CopyMemoryToImageIndirectCommandNV -> "copyCount" ::: Word32
$sel:srcAddress:CopyMemoryToImageIndirectCommandNV :: CopyMemoryToImageIndirectCommandNV
-> "copyBufferAddress" ::: DeviceAddress
..} IO b
f = do
    Ptr ("copyBufferAddress" ::: DeviceAddress)
-> ("copyBufferAddress" ::: DeviceAddress) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CopyMemoryToImageIndirectCommandNV
p Ptr CopyMemoryToImageIndirectCommandNV
-> Int -> Ptr ("copyBufferAddress" ::: DeviceAddress)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DeviceAddress)) ("copyBufferAddress" ::: DeviceAddress
srcAddress)
    Ptr ("copyCount" ::: Word32) -> ("copyCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CopyMemoryToImageIndirectCommandNV
p Ptr CopyMemoryToImageIndirectCommandNV
-> Int -> Ptr ("copyCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32)) ("copyCount" ::: Word32
bufferRowLength)
    Ptr ("copyCount" ::: Word32) -> ("copyCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CopyMemoryToImageIndirectCommandNV
p Ptr CopyMemoryToImageIndirectCommandNV
-> Int -> Ptr ("copyCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Word32)) ("copyCount" ::: Word32
bufferImageHeight)
    ("pImageSubresources" ::: Ptr ImageSubresourceLayers)
-> ImageSubresourceLayers -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CopyMemoryToImageIndirectCommandNV
p Ptr CopyMemoryToImageIndirectCommandNV
-> Int -> "pImageSubresources" ::: Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageSubresourceLayers)) (ImageSubresourceLayers
imageSubresource)
    Ptr Offset3D -> Offset3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CopyMemoryToImageIndirectCommandNV
p Ptr CopyMemoryToImageIndirectCommandNV -> Int -> Ptr Offset3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Offset3D)) (Offset3D
imageOffset)
    Ptr Extent3D -> Extent3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CopyMemoryToImageIndirectCommandNV
p Ptr CopyMemoryToImageIndirectCommandNV -> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Extent3D)) (Extent3D
imageExtent)
    IO b
f
  cStructSize :: Int
cStructSize = Int
56
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr CopyMemoryToImageIndirectCommandNV -> IO b -> IO b
pokeZeroCStruct Ptr CopyMemoryToImageIndirectCommandNV
p IO b
f = do
    Ptr ("copyBufferAddress" ::: DeviceAddress)
-> ("copyBufferAddress" ::: DeviceAddress) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CopyMemoryToImageIndirectCommandNV
p Ptr CopyMemoryToImageIndirectCommandNV
-> Int -> Ptr ("copyBufferAddress" ::: DeviceAddress)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DeviceAddress)) ("copyBufferAddress" ::: DeviceAddress
forall a. Zero a => a
zero)
    Ptr ("copyCount" ::: Word32) -> ("copyCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CopyMemoryToImageIndirectCommandNV
p Ptr CopyMemoryToImageIndirectCommandNV
-> Int -> Ptr ("copyCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32)) ("copyCount" ::: Word32
forall a. Zero a => a
zero)
    Ptr ("copyCount" ::: Word32) -> ("copyCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CopyMemoryToImageIndirectCommandNV
p Ptr CopyMemoryToImageIndirectCommandNV
-> Int -> Ptr ("copyCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Word32)) ("copyCount" ::: Word32
forall a. Zero a => a
zero)
    ("pImageSubresources" ::: Ptr ImageSubresourceLayers)
-> ImageSubresourceLayers -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CopyMemoryToImageIndirectCommandNV
p Ptr CopyMemoryToImageIndirectCommandNV
-> Int -> "pImageSubresources" ::: Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageSubresourceLayers)) (ImageSubresourceLayers
forall a. Zero a => a
zero)
    Ptr Offset3D -> Offset3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CopyMemoryToImageIndirectCommandNV
p Ptr CopyMemoryToImageIndirectCommandNV -> Int -> Ptr Offset3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Offset3D)) (Offset3D
forall a. Zero a => a
zero)
    Ptr Extent3D -> Extent3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CopyMemoryToImageIndirectCommandNV
p Ptr CopyMemoryToImageIndirectCommandNV -> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Extent3D)) (Extent3D
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct CopyMemoryToImageIndirectCommandNV where
  peekCStruct :: Ptr CopyMemoryToImageIndirectCommandNV
-> IO CopyMemoryToImageIndirectCommandNV
peekCStruct Ptr CopyMemoryToImageIndirectCommandNV
p = do
    "copyBufferAddress" ::: DeviceAddress
srcAddress <- forall a. Storable a => Ptr a -> IO a
peek @DeviceAddress ((Ptr CopyMemoryToImageIndirectCommandNV
p Ptr CopyMemoryToImageIndirectCommandNV
-> Int -> Ptr ("copyBufferAddress" ::: DeviceAddress)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DeviceAddress))
    "copyCount" ::: Word32
bufferRowLength <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr CopyMemoryToImageIndirectCommandNV
p Ptr CopyMemoryToImageIndirectCommandNV
-> Int -> Ptr ("copyCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32))
    "copyCount" ::: Word32
bufferImageHeight <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr CopyMemoryToImageIndirectCommandNV
p Ptr CopyMemoryToImageIndirectCommandNV
-> Int -> Ptr ("copyCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Word32))
    ImageSubresourceLayers
imageSubresource <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ImageSubresourceLayers ((Ptr CopyMemoryToImageIndirectCommandNV
p Ptr CopyMemoryToImageIndirectCommandNV
-> Int -> "pImageSubresources" ::: Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageSubresourceLayers))
    Offset3D
imageOffset <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Offset3D ((Ptr CopyMemoryToImageIndirectCommandNV
p Ptr CopyMemoryToImageIndirectCommandNV -> Int -> Ptr Offset3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Offset3D))
    Extent3D
imageExtent <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent3D ((Ptr CopyMemoryToImageIndirectCommandNV
p Ptr CopyMemoryToImageIndirectCommandNV -> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Extent3D))
    CopyMemoryToImageIndirectCommandNV
-> IO CopyMemoryToImageIndirectCommandNV
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CopyMemoryToImageIndirectCommandNV
 -> IO CopyMemoryToImageIndirectCommandNV)
-> CopyMemoryToImageIndirectCommandNV
-> IO CopyMemoryToImageIndirectCommandNV
forall a b. (a -> b) -> a -> b
$ ("copyBufferAddress" ::: DeviceAddress)
-> ("copyCount" ::: Word32)
-> ("copyCount" ::: Word32)
-> ImageSubresourceLayers
-> Offset3D
-> Extent3D
-> CopyMemoryToImageIndirectCommandNV
CopyMemoryToImageIndirectCommandNV
             "copyBufferAddress" ::: DeviceAddress
srcAddress
             "copyCount" ::: Word32
bufferRowLength
             "copyCount" ::: Word32
bufferImageHeight
             ImageSubresourceLayers
imageSubresource
             Offset3D
imageOffset
             Extent3D
imageExtent

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

instance Zero CopyMemoryToImageIndirectCommandNV where
  zero :: CopyMemoryToImageIndirectCommandNV
zero = ("copyBufferAddress" ::: DeviceAddress)
-> ("copyCount" ::: Word32)
-> ("copyCount" ::: Word32)
-> ImageSubresourceLayers
-> Offset3D
-> Extent3D
-> CopyMemoryToImageIndirectCommandNV
CopyMemoryToImageIndirectCommandNV
           "copyBufferAddress" ::: DeviceAddress
forall a. Zero a => a
zero
           "copyCount" ::: Word32
forall a. Zero a => a
zero
           "copyCount" ::: Word32
forall a. Zero a => a
zero
           ImageSubresourceLayers
forall a. Zero a => a
zero
           Offset3D
forall a. Zero a => a
zero
           Extent3D
forall a. Zero a => a
zero


-- | VkPhysicalDeviceCopyMemoryIndirectFeaturesNV - Structure describing
-- indirect copy features supported by an implementation
--
-- = Members
--
-- This structure describes the following features:
--
-- = Description
--
-- If the 'PhysicalDeviceCopyMemoryIndirectFeaturesNV' structure is
-- included in the @pNext@ chain of the
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2'
-- structure passed to
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceFeatures2',
-- it is filled in to indicate whether each corresponding feature is
-- supported. 'PhysicalDeviceCopyMemoryIndirectFeaturesNV' /can/ also be
-- used in the @pNext@ chain of 'Vulkan.Core10.Device.DeviceCreateInfo' to
-- selectively enable these features.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_copy_memory_indirect VK_NV_copy_memory_indirect>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceCopyMemoryIndirectFeaturesNV = PhysicalDeviceCopyMemoryIndirectFeaturesNV
  { -- | #features-indirectCopy# @indirectCopy@ indicates whether
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#indirect-copies indirect copies>
    -- are supported.
    PhysicalDeviceCopyMemoryIndirectFeaturesNV -> Bool
indirectCopy :: Bool }
  deriving (Typeable, PhysicalDeviceCopyMemoryIndirectFeaturesNV
-> PhysicalDeviceCopyMemoryIndirectFeaturesNV -> Bool
(PhysicalDeviceCopyMemoryIndirectFeaturesNV
 -> PhysicalDeviceCopyMemoryIndirectFeaturesNV -> Bool)
-> (PhysicalDeviceCopyMemoryIndirectFeaturesNV
    -> PhysicalDeviceCopyMemoryIndirectFeaturesNV -> Bool)
-> Eq PhysicalDeviceCopyMemoryIndirectFeaturesNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceCopyMemoryIndirectFeaturesNV
-> PhysicalDeviceCopyMemoryIndirectFeaturesNV -> Bool
$c/= :: PhysicalDeviceCopyMemoryIndirectFeaturesNV
-> PhysicalDeviceCopyMemoryIndirectFeaturesNV -> Bool
== :: PhysicalDeviceCopyMemoryIndirectFeaturesNV
-> PhysicalDeviceCopyMemoryIndirectFeaturesNV -> Bool
$c== :: PhysicalDeviceCopyMemoryIndirectFeaturesNV
-> PhysicalDeviceCopyMemoryIndirectFeaturesNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceCopyMemoryIndirectFeaturesNV)
#endif
deriving instance Show PhysicalDeviceCopyMemoryIndirectFeaturesNV

instance ToCStruct PhysicalDeviceCopyMemoryIndirectFeaturesNV where
  withCStruct :: forall b.
PhysicalDeviceCopyMemoryIndirectFeaturesNV
-> (Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV -> IO b) -> IO b
withCStruct PhysicalDeviceCopyMemoryIndirectFeaturesNV
x Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV -> IO b
f = Int
-> (Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV -> IO b) -> IO b)
-> (Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV
p -> Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV
-> PhysicalDeviceCopyMemoryIndirectFeaturesNV -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV
p PhysicalDeviceCopyMemoryIndirectFeaturesNV
x (Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV -> IO b
f Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV
p)
  pokeCStruct :: forall b.
Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV
-> PhysicalDeviceCopyMemoryIndirectFeaturesNV -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV
p PhysicalDeviceCopyMemoryIndirectFeaturesNV{Bool
indirectCopy :: Bool
$sel:indirectCopy:PhysicalDeviceCopyMemoryIndirectFeaturesNV :: PhysicalDeviceCopyMemoryIndirectFeaturesNV -> Bool
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV
p Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_COPY_MEMORY_INDIRECT_FEATURES_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV
p Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV
p Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
indirectCopy))
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV
p Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_COPY_MEMORY_INDIRECT_FEATURES_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV
p Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV
p Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct PhysicalDeviceCopyMemoryIndirectFeaturesNV where
  peekCStruct :: Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV
-> IO PhysicalDeviceCopyMemoryIndirectFeaturesNV
peekCStruct Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV
p = do
    Bool32
indirectCopy <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV
p Ptr PhysicalDeviceCopyMemoryIndirectFeaturesNV -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
    PhysicalDeviceCopyMemoryIndirectFeaturesNV
-> IO PhysicalDeviceCopyMemoryIndirectFeaturesNV
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceCopyMemoryIndirectFeaturesNV
 -> IO PhysicalDeviceCopyMemoryIndirectFeaturesNV)
-> PhysicalDeviceCopyMemoryIndirectFeaturesNV
-> IO PhysicalDeviceCopyMemoryIndirectFeaturesNV
forall a b. (a -> b) -> a -> b
$ Bool -> PhysicalDeviceCopyMemoryIndirectFeaturesNV
PhysicalDeviceCopyMemoryIndirectFeaturesNV
             (Bool32 -> Bool
bool32ToBool Bool32
indirectCopy)

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

instance Zero PhysicalDeviceCopyMemoryIndirectFeaturesNV where
  zero :: PhysicalDeviceCopyMemoryIndirectFeaturesNV
zero = Bool -> PhysicalDeviceCopyMemoryIndirectFeaturesNV
PhysicalDeviceCopyMemoryIndirectFeaturesNV
           Bool
forall a. Zero a => a
zero


-- | VkPhysicalDeviceCopyMemoryIndirectPropertiesNV - Structure describing
-- supported queues for indirect copy
--
-- = Description
--
-- If the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-indirectCopy indirect copies>
-- feature is supported, @supportedQueues@ /must/ return at least one
-- supported queue.
--
-- If the 'PhysicalDeviceCopyMemoryIndirectPropertiesNV' structure is
-- included in the @pNext@ chain of the
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2'
-- structure passed to
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceProperties2',
-- it is filled in with each corresponding implementation-dependent
-- property.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_copy_memory_indirect VK_NV_copy_memory_indirect>,
-- 'Vulkan.Core10.Enums.QueueFlagBits.QueueFlags',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceCopyMemoryIndirectPropertiesNV = PhysicalDeviceCopyMemoryIndirectPropertiesNV
  { -- | @supportedQueues@ is a bitmask of
    -- 'Vulkan.Core10.Enums.QueueFlagBits.QueueFlagBits' indicating the queues
    -- on which
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#indirect-copies indirect copy commands>
    -- are supported.
    PhysicalDeviceCopyMemoryIndirectPropertiesNV -> QueueFlags
supportedQueues :: QueueFlags }
  deriving (Typeable, PhysicalDeviceCopyMemoryIndirectPropertiesNV
-> PhysicalDeviceCopyMemoryIndirectPropertiesNV -> Bool
(PhysicalDeviceCopyMemoryIndirectPropertiesNV
 -> PhysicalDeviceCopyMemoryIndirectPropertiesNV -> Bool)
-> (PhysicalDeviceCopyMemoryIndirectPropertiesNV
    -> PhysicalDeviceCopyMemoryIndirectPropertiesNV -> Bool)
-> Eq PhysicalDeviceCopyMemoryIndirectPropertiesNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceCopyMemoryIndirectPropertiesNV
-> PhysicalDeviceCopyMemoryIndirectPropertiesNV -> Bool
$c/= :: PhysicalDeviceCopyMemoryIndirectPropertiesNV
-> PhysicalDeviceCopyMemoryIndirectPropertiesNV -> Bool
== :: PhysicalDeviceCopyMemoryIndirectPropertiesNV
-> PhysicalDeviceCopyMemoryIndirectPropertiesNV -> Bool
$c== :: PhysicalDeviceCopyMemoryIndirectPropertiesNV
-> PhysicalDeviceCopyMemoryIndirectPropertiesNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceCopyMemoryIndirectPropertiesNV)
#endif
deriving instance Show PhysicalDeviceCopyMemoryIndirectPropertiesNV

instance ToCStruct PhysicalDeviceCopyMemoryIndirectPropertiesNV where
  withCStruct :: forall b.
PhysicalDeviceCopyMemoryIndirectPropertiesNV
-> (Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV -> IO b)
-> IO b
withCStruct PhysicalDeviceCopyMemoryIndirectPropertiesNV
x Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV -> IO b
f = Int
-> (Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV -> IO b)
 -> IO b)
-> (Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV
p -> Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV
-> PhysicalDeviceCopyMemoryIndirectPropertiesNV -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV
p PhysicalDeviceCopyMemoryIndirectPropertiesNV
x (Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV -> IO b
f Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV
p)
  pokeCStruct :: forall b.
Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV
-> PhysicalDeviceCopyMemoryIndirectPropertiesNV -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV
p PhysicalDeviceCopyMemoryIndirectPropertiesNV{QueueFlags
supportedQueues :: QueueFlags
$sel:supportedQueues:PhysicalDeviceCopyMemoryIndirectPropertiesNV :: PhysicalDeviceCopyMemoryIndirectPropertiesNV -> QueueFlags
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV
p Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_COPY_MEMORY_INDIRECT_PROPERTIES_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV
p Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr QueueFlags -> QueueFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV
p Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV
-> Int -> Ptr QueueFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr QueueFlags)) (QueueFlags
supportedQueues)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV
p Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_COPY_MEMORY_INDIRECT_PROPERTIES_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV
p Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr QueueFlags -> QueueFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV
p Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV
-> Int -> Ptr QueueFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr QueueFlags)) (QueueFlags
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct PhysicalDeviceCopyMemoryIndirectPropertiesNV where
  peekCStruct :: Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV
-> IO PhysicalDeviceCopyMemoryIndirectPropertiesNV
peekCStruct Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV
p = do
    QueueFlags
supportedQueues <- forall a. Storable a => Ptr a -> IO a
peek @QueueFlags ((Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV
p Ptr PhysicalDeviceCopyMemoryIndirectPropertiesNV
-> Int -> Ptr QueueFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr QueueFlags))
    PhysicalDeviceCopyMemoryIndirectPropertiesNV
-> IO PhysicalDeviceCopyMemoryIndirectPropertiesNV
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceCopyMemoryIndirectPropertiesNV
 -> IO PhysicalDeviceCopyMemoryIndirectPropertiesNV)
-> PhysicalDeviceCopyMemoryIndirectPropertiesNV
-> IO PhysicalDeviceCopyMemoryIndirectPropertiesNV
forall a b. (a -> b) -> a -> b
$ QueueFlags -> PhysicalDeviceCopyMemoryIndirectPropertiesNV
PhysicalDeviceCopyMemoryIndirectPropertiesNV
             QueueFlags
supportedQueues

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

instance Zero PhysicalDeviceCopyMemoryIndirectPropertiesNV where
  zero :: PhysicalDeviceCopyMemoryIndirectPropertiesNV
zero = QueueFlags -> PhysicalDeviceCopyMemoryIndirectPropertiesNV
PhysicalDeviceCopyMemoryIndirectPropertiesNV
           QueueFlags
forall a. Zero a => a
zero


type NV_COPY_MEMORY_INDIRECT_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_NV_COPY_MEMORY_INDIRECT_SPEC_VERSION"
pattern NV_COPY_MEMORY_INDIRECT_SPEC_VERSION :: forall a . Integral a => a
pattern $bNV_COPY_MEMORY_INDIRECT_SPEC_VERSION :: forall a. Integral a => a
$mNV_COPY_MEMORY_INDIRECT_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> (Void# -> r) -> (Void# -> r) -> r
NV_COPY_MEMORY_INDIRECT_SPEC_VERSION = 1


type NV_COPY_MEMORY_INDIRECT_EXTENSION_NAME = "VK_NV_copy_memory_indirect"

-- No documentation found for TopLevel "VK_NV_COPY_MEMORY_INDIRECT_EXTENSION_NAME"
pattern NV_COPY_MEMORY_INDIRECT_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bNV_COPY_MEMORY_INDIRECT_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mNV_COPY_MEMORY_INDIRECT_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
NV_COPY_MEMORY_INDIRECT_EXTENSION_NAME = "VK_NV_copy_memory_indirect"