{-# language CPP #-}
-- | = Name
--
-- VK_EXT_transform_feedback - device extension
--
-- == VK_EXT_transform_feedback
--
-- [__Name String__]
--     @VK_EXT_transform_feedback@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     29
--
-- [__Revision__]
--     1
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires Vulkan 1.0
--
--     -   Requires @VK_KHR_get_physical_device_properties2@
--
-- [__Special Uses__]
--
--     -   <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#extendingvulkan-compatibility-specialuse OpenGL \/ ES support>
--
--     -   <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#extendingvulkan-compatibility-specialuse D3D support>
--
--     -   <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#extendingvulkan-compatibility-specialuse Developer tools>
--
-- [__Contact__]
--
--     -   Piers Daniell
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_EXT_transform_feedback] @pdaniell-nv%0A<<Here describe the issue or question you have about the VK_EXT_transform_feedback extension>> >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2018-10-09
--
-- [__Contributors__]
--
--     -   Baldur Karlsson, Valve
--
--     -   Boris Zanin, Mobica
--
--     -   Daniel Rakos, AMD
--
--     -   Donald Scorgie, Imagination
--
--     -   Henri Verbeet, CodeWeavers
--
--     -   Jan-Harald Fredriksen, Arm
--
--     -   Jason Ekstrand, Intel
--
--     -   Jeff Bolz, NVIDIA
--
--     -   Jesse Barker, Unity
--
--     -   Jesse Hall, Google
--
--     -   Pierre-Loup Griffais, Valve
--
--     -   Philip Rebohle, DXVK
--
--     -   Ruihao Zhang, Qualcomm
--
--     -   Samuel Pitoiset, Valve
--
--     -   Slawomir Grajewski, Intel
--
--     -   Stu Smith, Imagination Technologies
--
-- == Description
--
-- This extension adds transform feedback to the Vulkan API by exposing the
-- SPIR-V @TransformFeedback@ and @GeometryStreams@ capabilities to capture
-- vertex, tessellation or geometry shader outputs to one or more buffers.
-- It adds API functionality to bind transform feedback buffers to capture
-- the primitives emitted by the graphics pipeline from SPIR-V outputs
-- decorated for transform feedback. The transform feedback capture can be
-- paused and resumed by way of storing and retrieving a byte counter. The
-- captured data can be drawn again where the vertex count is derived from
-- the byte counter without CPU intervention. If the implementation is
-- capable, a vertex stream other than zero can be rasterized.
--
-- All these features are designed to match the full capabilities of OpenGL
-- core transform feedback functionality and beyond. Many of the features
-- are optional to allow base OpenGL ES GPUs to also implement this
-- extension.
--
-- The primary purpose of the functionality exposed by this extension is to
-- support translation layers from other 3D APIs. This functionality is not
-- considered forward looking, and is not expected to be promoted to a KHR
-- extension or to core Vulkan. Unless this is needed for translation, it
-- is recommended that developers use alternative techniques of using the
-- GPU to process and capture vertex data.
--
-- == New Commands
--
-- -   'cmdBeginQueryIndexedEXT'
--
-- -   'cmdBeginTransformFeedbackEXT'
--
-- -   'cmdBindTransformFeedbackBuffersEXT'
--
-- -   'cmdDrawIndirectByteCountEXT'
--
-- -   'cmdEndQueryIndexedEXT'
--
-- -   'cmdEndTransformFeedbackEXT'
--
-- == New Structures
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDeviceTransformFeedbackFeaturesEXT'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2':
--
--     -   'PhysicalDeviceTransformFeedbackPropertiesEXT'
--
-- -   Extending
--     'Vulkan.Core10.Pipeline.PipelineRasterizationStateCreateInfo':
--
--     -   'PipelineRasterizationStateStreamCreateInfoEXT'
--
-- == New Bitmasks
--
-- -   'PipelineRasterizationStateStreamCreateFlagsEXT'
--
-- == New Enum Constants
--
-- -   'EXT_TRANSFORM_FEEDBACK_EXTENSION_NAME'
--
-- -   'EXT_TRANSFORM_FEEDBACK_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.AccessFlagBits.AccessFlagBits':
--
--     -   'Vulkan.Core10.Enums.AccessFlagBits.ACCESS_TRANSFORM_FEEDBACK_COUNTER_READ_BIT_EXT'
--
--     -   'Vulkan.Core10.Enums.AccessFlagBits.ACCESS_TRANSFORM_FEEDBACK_COUNTER_WRITE_BIT_EXT'
--
--     -   'Vulkan.Core10.Enums.AccessFlagBits.ACCESS_TRANSFORM_FEEDBACK_WRITE_BIT_EXT'
--
-- -   Extending
--     'Vulkan.Core10.Enums.BufferUsageFlagBits.BufferUsageFlagBits':
--
--     -   'Vulkan.Core10.Enums.BufferUsageFlagBits.BUFFER_USAGE_TRANSFORM_FEEDBACK_BUFFER_BIT_EXT'
--
--     -   'Vulkan.Core10.Enums.BufferUsageFlagBits.BUFFER_USAGE_TRANSFORM_FEEDBACK_COUNTER_BUFFER_BIT_EXT'
--
-- -   Extending
--     'Vulkan.Core10.Enums.PipelineStageFlagBits.PipelineStageFlagBits':
--
--     -   'Vulkan.Core10.Enums.PipelineStageFlagBits.PIPELINE_STAGE_TRANSFORM_FEEDBACK_BIT_EXT'
--
-- -   Extending 'Vulkan.Core10.Enums.QueryType.QueryType':
--
--     -   'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_TRANSFORM_FEEDBACK_STREAM_EXT'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_TRANSFORM_FEEDBACK_FEATURES_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_TRANSFORM_FEEDBACK_PROPERTIES_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PIPELINE_RASTERIZATION_STATE_STREAM_CREATE_INFO_EXT'
--
-- == Issues
--
-- 1) Should we include pause\/resume functionality?
--
-- __RESOLVED__: Yes, this is needed to ease layering other APIs which have
-- this functionality. To pause use 'cmdEndTransformFeedbackEXT' and
-- provide valid buffer handles in the @pCounterBuffers@ array and offsets
-- in the @pCounterBufferOffsets@ array for the implementation to save the
-- resume points. Then to resume use 'cmdBeginTransformFeedbackEXT' with
-- the previous @pCounterBuffers@ and @pCounterBufferOffsets@ values.
-- Between the pause and resume there needs to be a memory barrier for the
-- counter buffers with a source access of
-- 'Vulkan.Core10.Enums.AccessFlagBits.ACCESS_TRANSFORM_FEEDBACK_COUNTER_WRITE_BIT_EXT'
-- at pipeline stage
-- 'Vulkan.Core10.Enums.PipelineStageFlagBits.PIPELINE_STAGE_TRANSFORM_FEEDBACK_BIT_EXT'
-- to a destination access of
-- 'Vulkan.Core10.Enums.AccessFlagBits.ACCESS_TRANSFORM_FEEDBACK_COUNTER_READ_BIT_EXT'
-- at pipeline stage
-- 'Vulkan.Core10.Enums.PipelineStageFlagBits.PIPELINE_STAGE_TRANSFORM_FEEDBACK_BIT_EXT'.
--
-- 2) How does this interact with multiview?
--
-- __RESOLVED__: Transform feedback cannot be made active in a render pass
-- with multiview enabled.
--
-- 3) How should queries be done?
--
-- __RESOLVED__: There is a new query type
-- 'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_TRANSFORM_FEEDBACK_STREAM_EXT'.
-- A query pool created with this type will capture 2 integers -
-- numPrimitivesWritten and numPrimitivesNeeded - for the specified vertex
-- stream output from the last
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#pipeline-graphics-subsets-pre-rasterization pre-rasterization shader stage>.
-- The vertex stream output queried is zero by default, but can be
-- specified with the new 'cmdBeginQueryIndexedEXT' and
-- 'cmdEndQueryIndexedEXT' commands.
--
-- == Version History
--
-- -   Revision 1, 2018-10-09 (Piers Daniell)
--
--     -   Internal revisions
--
-- == See Also
--
-- 'PhysicalDeviceTransformFeedbackFeaturesEXT',
-- 'PhysicalDeviceTransformFeedbackPropertiesEXT',
-- 'PipelineRasterizationStateStreamCreateFlagsEXT',
-- 'PipelineRasterizationStateStreamCreateInfoEXT',
-- 'cmdBeginQueryIndexedEXT', 'cmdBeginTransformFeedbackEXT',
-- 'cmdBindTransformFeedbackBuffersEXT', 'cmdDrawIndirectByteCountEXT',
-- 'cmdEndQueryIndexedEXT', 'cmdEndTransformFeedbackEXT'
--
-- == Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_transform_feedback Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_EXT_transform_feedback  ( cmdBindTransformFeedbackBuffersEXT
                                                    , cmdBeginTransformFeedbackEXT
                                                    , cmdUseTransformFeedbackEXT
                                                    , cmdEndTransformFeedbackEXT
                                                    , cmdBeginQueryIndexedEXT
                                                    , cmdUseQueryIndexedEXT
                                                    , cmdEndQueryIndexedEXT
                                                    , cmdDrawIndirectByteCountEXT
                                                    , PhysicalDeviceTransformFeedbackFeaturesEXT(..)
                                                    , PhysicalDeviceTransformFeedbackPropertiesEXT(..)
                                                    , PipelineRasterizationStateStreamCreateInfoEXT(..)
                                                    , PipelineRasterizationStateStreamCreateFlagsEXT(..)
                                                    , EXT_TRANSFORM_FEEDBACK_SPEC_VERSION
                                                    , pattern EXT_TRANSFORM_FEEDBACK_SPEC_VERSION
                                                    , EXT_TRANSFORM_FEEDBACK_EXTENSION_NAME
                                                    , pattern EXT_TRANSFORM_FEEDBACK_EXTENSION_NAME
                                                    ) where

import Vulkan.Internal.Utils (enumReadPrec)
import Vulkan.Internal.Utils (enumShowsPrec)
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 GHC.Show (showString)
import Numeric (showHex)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import qualified Data.Vector (null)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero)
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.Bits (Bits)
import Data.Bits (FiniteBits)
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 GHC.Read (Read(readPrec))
import GHC.Show (Show(showsPrec))
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 (Buffer)
import Vulkan.Core10.Handles (Buffer(..))
import Vulkan.Core10.Handles (CommandBuffer)
import Vulkan.Core10.Handles (CommandBuffer(..))
import Vulkan.Core10.Handles (CommandBuffer(CommandBuffer))
import Vulkan.Core10.Handles (CommandBuffer_T)
import Vulkan.Dynamic (DeviceCmds(pVkCmdBeginQueryIndexedEXT))
import Vulkan.Dynamic (DeviceCmds(pVkCmdBeginTransformFeedbackEXT))
import Vulkan.Dynamic (DeviceCmds(pVkCmdBindTransformFeedbackBuffersEXT))
import Vulkan.Dynamic (DeviceCmds(pVkCmdDrawIndirectByteCountEXT))
import Vulkan.Dynamic (DeviceCmds(pVkCmdEndQueryIndexedEXT))
import Vulkan.Dynamic (DeviceCmds(pVkCmdEndTransformFeedbackEXT))
import Vulkan.Core10.FundamentalTypes (DeviceSize)
import Vulkan.Core10.FundamentalTypes (Flags)
import Vulkan.Core10.Enums.QueryControlFlagBits (QueryControlFlagBits(..))
import Vulkan.Core10.Enums.QueryControlFlagBits (QueryControlFlags)
import Vulkan.Core10.Handles (QueryPool)
import Vulkan.Core10.Handles (QueryPool(..))
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_TRANSFORM_FEEDBACK_FEATURES_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_TRANSFORM_FEEDBACK_PROPERTIES_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_RASTERIZATION_STATE_STREAM_CREATE_INFO_EXT))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdBindTransformFeedbackBuffersEXT
  :: FunPtr (Ptr CommandBuffer_T -> Word32 -> Word32 -> Ptr Buffer -> Ptr DeviceSize -> Ptr DeviceSize -> IO ()) -> Ptr CommandBuffer_T -> Word32 -> Word32 -> Ptr Buffer -> Ptr DeviceSize -> Ptr DeviceSize -> IO ()

-- | vkCmdBindTransformFeedbackBuffersEXT - Bind transform feedback buffers
-- to a command buffer
--
-- = Description
--
-- The values taken from elements i of @pBuffers@, @pOffsets@ and @pSizes@
-- replace the current state for the transform feedback binding
-- @firstBinding@ + i, for i in [0, @bindingCount@). The transform feedback
-- binding is updated to start at the offset indicated by @pOffsets@[i]
-- from the start of the buffer @pBuffers@[i].
--
-- == Valid Usage
--
-- -   #VUID-vkCmdBindTransformFeedbackBuffersEXT-transformFeedback-02355#
--     'PhysicalDeviceTransformFeedbackFeaturesEXT'::@transformFeedback@
--     /must/ be enabled
--
-- -   #VUID-vkCmdBindTransformFeedbackBuffersEXT-firstBinding-02356#
--     @firstBinding@ /must/ be less than
--     'PhysicalDeviceTransformFeedbackPropertiesEXT'::@maxTransformFeedbackBuffers@
--
-- -   #VUID-vkCmdBindTransformFeedbackBuffersEXT-firstBinding-02357# The
--     sum of @firstBinding@ and @bindingCount@ /must/ be less than or
--     equal to
--     'PhysicalDeviceTransformFeedbackPropertiesEXT'::@maxTransformFeedbackBuffers@
--
-- -   #VUID-vkCmdBindTransformFeedbackBuffersEXT-pOffsets-02358# All
--     elements of @pOffsets@ /must/ be less than the size of the
--     corresponding element in @pBuffers@
--
-- -   #VUID-vkCmdBindTransformFeedbackBuffersEXT-pOffsets-02359# All
--     elements of @pOffsets@ /must/ be a multiple of 4
--
-- -   #VUID-vkCmdBindTransformFeedbackBuffersEXT-pBuffers-02360# All
--     elements of @pBuffers@ /must/ have been created with the
--     'Vulkan.Core10.Enums.BufferUsageFlagBits.BUFFER_USAGE_TRANSFORM_FEEDBACK_BUFFER_BIT_EXT'
--     flag
--
-- -   #VUID-vkCmdBindTransformFeedbackBuffersEXT-pSize-02361# If the
--     optional @pSize@ array is specified, each element of @pSizes@ /must/
--     either be 'Vulkan.Core10.APIConstants.WHOLE_SIZE', or be less than
--     or equal to
--     'PhysicalDeviceTransformFeedbackPropertiesEXT'::@maxTransformFeedbackBufferSize@
--
-- -   #VUID-vkCmdBindTransformFeedbackBuffersEXT-pSizes-02362# All
--     elements of @pSizes@ /must/ be either
--     'Vulkan.Core10.APIConstants.WHOLE_SIZE', or less than or equal to
--     the size of the corresponding buffer in @pBuffers@
--
-- -   #VUID-vkCmdBindTransformFeedbackBuffersEXT-pOffsets-02363# All
--     elements of @pOffsets@ plus @pSizes@, where the @pSizes@, element is
--     not 'Vulkan.Core10.APIConstants.WHOLE_SIZE', /must/ be less than or
--     equal to the size of the corresponding buffer in @pBuffers@
--
-- -   #VUID-vkCmdBindTransformFeedbackBuffersEXT-pBuffers-02364# Each
--     element of @pBuffers@ that is non-sparse /must/ be bound completely
--     and contiguously to a single 'Vulkan.Core10.Handles.DeviceMemory'
--     object
--
-- -   #VUID-vkCmdBindTransformFeedbackBuffersEXT-None-02365# Transform
--     feedback /must/ not be active when the
--     'cmdBindTransformFeedbackBuffersEXT' command is recorded
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdBindTransformFeedbackBuffersEXT-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdBindTransformFeedbackBuffersEXT-pBuffers-parameter#
--     @pBuffers@ /must/ be a valid pointer to an array of @bindingCount@
--     valid 'Vulkan.Core10.Handles.Buffer' handles
--
-- -   #VUID-vkCmdBindTransformFeedbackBuffersEXT-pOffsets-parameter#
--     @pOffsets@ /must/ be a valid pointer to an array of @bindingCount@
--     'Vulkan.Core10.FundamentalTypes.DeviceSize' values
--
-- -   #VUID-vkCmdBindTransformFeedbackBuffersEXT-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-vkCmdBindTransformFeedbackBuffersEXT-commandBuffer-cmdpool#
--     The 'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- -   #VUID-vkCmdBindTransformFeedbackBuffersEXT-bindingCount-arraylength#
--     @bindingCount@ /must/ be greater than @0@
--
-- -   #VUID-vkCmdBindTransformFeedbackBuffersEXT-commonparent# Both of
--     @commandBuffer@, and the elements of @pBuffers@ /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#VkQueueFlagBits Supported Queue Types> |
-- +============================================================================================================================+========================================================================================================================+=======================================================================================================================+
-- | Primary                                                                                                                    | Both                                                                                                                   | Graphics                                                                                                              |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                       |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_transform_feedback VK_EXT_transform_feedback>,
-- 'Vulkan.Core10.Handles.Buffer', 'Vulkan.Core10.Handles.CommandBuffer',
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize'
cmdBindTransformFeedbackBuffersEXT :: forall io
                                    . (MonadIO io)
                                   => -- | @commandBuffer@ is the command buffer into which the command is
                                      -- recorded.
                                      CommandBuffer
                                   -> -- | @firstBinding@ is the index of the first transform feedback binding
                                      -- whose state is updated by the command.
                                      ("firstBinding" ::: Word32)
                                   -> -- | @pBuffers@ is a pointer to an array of buffer handles.
                                      ("buffers" ::: Vector Buffer)
                                   -> -- | @pOffsets@ is a pointer to an array of buffer offsets.
                                      ("offsets" ::: Vector DeviceSize)
                                   -> -- | @pSizes@ is @NULL@ or a pointer to an array of
                                      -- 'Vulkan.Core10.FundamentalTypes.DeviceSize' buffer sizes, specifying the
                                      -- maximum number of bytes to capture to the corresponding transform
                                      -- feedback buffer. If @pSizes@ is @NULL@, or the value of the @pSizes@
                                      -- array element is 'Vulkan.Core10.APIConstants.WHOLE_SIZE', then the
                                      -- maximum number of bytes captured will be the size of the corresponding
                                      -- buffer minus the buffer offset.
                                      ("sizes" ::: Vector DeviceSize)
                                   -> io ()
cmdBindTransformFeedbackBuffersEXT :: CommandBuffer
-> ("firstBinding" ::: Word32)
-> ("buffers" ::: Vector Buffer)
-> ("offsets" ::: Vector DeviceSize)
-> ("offsets" ::: Vector DeviceSize)
-> io ()
cmdBindTransformFeedbackBuffersEXT CommandBuffer
commandBuffer "firstBinding" ::: Word32
firstBinding "buffers" ::: Vector Buffer
buffers "offsets" ::: Vector DeviceSize
offsets "offsets" ::: Vector DeviceSize
sizes = 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 vkCmdBindTransformFeedbackBuffersEXTPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> ("pBuffers" ::: Ptr Buffer)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> IO ())
vkCmdBindTransformFeedbackBuffersEXTPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("firstBinding" ::: Word32)
      -> ("firstBinding" ::: Word32)
      -> ("pBuffers" ::: Ptr Buffer)
      -> ("pOffsets" ::: Ptr DeviceSize)
      -> ("pOffsets" ::: Ptr DeviceSize)
      -> IO ())
pVkCmdBindTransformFeedbackBuffersEXT (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds :: 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
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> ("pBuffers" ::: Ptr Buffer)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> IO ())
vkCmdBindTransformFeedbackBuffersEXTPtr FunPtr
  (Ptr CommandBuffer_T
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> ("pBuffers" ::: Ptr Buffer)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("firstBinding" ::: Word32)
      -> ("firstBinding" ::: Word32)
      -> ("pBuffers" ::: Ptr Buffer)
      -> ("pOffsets" ::: Ptr DeviceSize)
      -> ("pOffsets" ::: Ptr DeviceSize)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> ("pBuffers" ::: Ptr Buffer)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> 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 vkCmdBindTransformFeedbackBuffersEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdBindTransformFeedbackBuffersEXT' :: Ptr CommandBuffer_T
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> ("pBuffers" ::: Ptr Buffer)
-> ("pOffsets" ::: Ptr DeviceSize)
-> ("pOffsets" ::: Ptr DeviceSize)
-> IO ()
vkCmdBindTransformFeedbackBuffersEXT' = FunPtr
  (Ptr CommandBuffer_T
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> ("pBuffers" ::: Ptr Buffer)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> IO ())
-> Ptr CommandBuffer_T
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> ("pBuffers" ::: Ptr Buffer)
-> ("pOffsets" ::: Ptr DeviceSize)
-> ("pOffsets" ::: Ptr DeviceSize)
-> IO ()
mkVkCmdBindTransformFeedbackBuffersEXT FunPtr
  (Ptr CommandBuffer_T
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> ("pBuffers" ::: Ptr Buffer)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> IO ())
vkCmdBindTransformFeedbackBuffersEXTPtr
  let pBuffersLength :: Int
pBuffersLength = ("buffers" ::: Vector Buffer) -> Int
forall a. Vector a -> Int
Data.Vector.length (("buffers" ::: Vector Buffer) -> Int)
-> ("buffers" ::: Vector Buffer) -> Int
forall a b. (a -> b) -> a -> b
$ ("buffers" ::: Vector Buffer
buffers)
  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 ((("offsets" ::: Vector DeviceSize) -> Int
forall a. Vector a -> Int
Data.Vector.length (("offsets" ::: Vector DeviceSize) -> Int)
-> ("offsets" ::: Vector DeviceSize) -> Int
forall a b. (a -> b) -> a -> b
$ ("offsets" ::: Vector DeviceSize
offsets)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
pBuffersLength) (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
"pOffsets and pBuffers must have the same length" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let pSizesLength :: Int
pSizesLength = ("offsets" ::: Vector DeviceSize) -> Int
forall a. Vector a -> Int
Data.Vector.length (("offsets" ::: Vector DeviceSize) -> Int)
-> ("offsets" ::: Vector DeviceSize) -> Int
forall a b. (a -> b) -> a -> b
$ ("offsets" ::: Vector DeviceSize
sizes)
  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 (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pSizesLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
pBuffersLength Bool -> Bool -> Bool
|| Int
pSizesLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (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
"pSizes and pBuffers must have the same length" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  "pBuffers" ::: Ptr Buffer
pPBuffers <- ((("pBuffers" ::: Ptr Buffer) -> IO ()) -> IO ())
-> ContT () IO ("pBuffers" ::: Ptr Buffer)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pBuffers" ::: Ptr Buffer) -> IO ()) -> IO ())
 -> ContT () IO ("pBuffers" ::: Ptr Buffer))
-> ((("pBuffers" ::: Ptr Buffer) -> IO ()) -> IO ())
-> ContT () IO ("pBuffers" ::: Ptr Buffer)
forall a b. (a -> b) -> a -> b
$ Int -> (("pBuffers" ::: Ptr Buffer) -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @Buffer ((("buffers" ::: Vector Buffer) -> Int
forall a. Vector a -> Int
Data.Vector.length ("buffers" ::: Vector Buffer
buffers)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
  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 -> Buffer -> IO ()) -> ("buffers" ::: Vector Buffer) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Buffer
e -> ("pBuffers" ::: Ptr Buffer) -> Buffer -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pBuffers" ::: Ptr Buffer
pPBuffers ("pBuffers" ::: Ptr Buffer) -> Int -> "pBuffers" ::: Ptr Buffer
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Buffer) (Buffer
e)) ("buffers" ::: Vector Buffer
buffers)
  "pOffsets" ::: Ptr DeviceSize
pPOffsets <- ((("pOffsets" ::: Ptr DeviceSize) -> IO ()) -> IO ())
-> ContT () IO ("pOffsets" ::: Ptr DeviceSize)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pOffsets" ::: Ptr DeviceSize) -> IO ()) -> IO ())
 -> ContT () IO ("pOffsets" ::: Ptr DeviceSize))
-> ((("pOffsets" ::: Ptr DeviceSize) -> IO ()) -> IO ())
-> ContT () IO ("pOffsets" ::: Ptr DeviceSize)
forall a b. (a -> b) -> a -> b
$ Int -> (("pOffsets" ::: Ptr DeviceSize) -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @DeviceSize ((("offsets" ::: Vector DeviceSize) -> Int
forall a. Vector a -> Int
Data.Vector.length ("offsets" ::: Vector DeviceSize
offsets)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
  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 -> DeviceSize -> IO ())
-> ("offsets" ::: Vector DeviceSize) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i DeviceSize
e -> ("pOffsets" ::: Ptr DeviceSize) -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pOffsets" ::: Ptr DeviceSize
pPOffsets ("pOffsets" ::: Ptr DeviceSize)
-> Int -> "pOffsets" ::: Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr DeviceSize) (DeviceSize
e)) ("offsets" ::: Vector DeviceSize
offsets)
  "pOffsets" ::: Ptr DeviceSize
pSizes <- if ("offsets" ::: Vector DeviceSize) -> Bool
forall a. Vector a -> Bool
Data.Vector.null ("offsets" ::: Vector DeviceSize
sizes)
    then ("pOffsets" ::: Ptr DeviceSize)
-> ContT () IO ("pOffsets" ::: Ptr DeviceSize)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pOffsets" ::: Ptr DeviceSize
forall a. Ptr a
nullPtr
    else do
      "pOffsets" ::: Ptr DeviceSize
pPSizes <- ((("pOffsets" ::: Ptr DeviceSize) -> IO ()) -> IO ())
-> ContT () IO ("pOffsets" ::: Ptr DeviceSize)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pOffsets" ::: Ptr DeviceSize) -> IO ()) -> IO ())
 -> ContT () IO ("pOffsets" ::: Ptr DeviceSize))
-> ((("pOffsets" ::: Ptr DeviceSize) -> IO ()) -> IO ())
-> ContT () IO ("pOffsets" ::: Ptr DeviceSize)
forall a b. (a -> b) -> a -> b
$ Int -> (("pOffsets" ::: Ptr DeviceSize) -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @DeviceSize (((("offsets" ::: Vector DeviceSize) -> Int
forall a. Vector a -> Int
Data.Vector.length ("offsets" ::: Vector DeviceSize
sizes))) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
      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 -> DeviceSize -> IO ())
-> ("offsets" ::: Vector DeviceSize) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i DeviceSize
e -> ("pOffsets" ::: Ptr DeviceSize) -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pOffsets" ::: Ptr DeviceSize
pPSizes ("pOffsets" ::: Ptr DeviceSize)
-> Int -> "pOffsets" ::: Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr DeviceSize) (DeviceSize
e)) (("offsets" ::: Vector DeviceSize
sizes))
      ("pOffsets" ::: Ptr DeviceSize)
-> ContT () IO ("pOffsets" ::: Ptr DeviceSize)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("pOffsets" ::: Ptr DeviceSize)
 -> ContT () IO ("pOffsets" ::: Ptr DeviceSize))
-> ("pOffsets" ::: Ptr DeviceSize)
-> ContT () IO ("pOffsets" ::: Ptr DeviceSize)
forall a b. (a -> b) -> a -> b
$ "pOffsets" ::: Ptr DeviceSize
pPSizes
  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
"vkCmdBindTransformFeedbackBuffersEXT" (Ptr CommandBuffer_T
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> ("pBuffers" ::: Ptr Buffer)
-> ("pOffsets" ::: Ptr DeviceSize)
-> ("pOffsets" ::: Ptr DeviceSize)
-> IO ()
vkCmdBindTransformFeedbackBuffersEXT' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) ("firstBinding" ::: Word32
firstBinding) ((Int -> "firstBinding" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pBuffersLength :: Word32)) ("pBuffers" ::: Ptr Buffer
pPBuffers) ("pOffsets" ::: Ptr DeviceSize
pPOffsets) "pOffsets" ::: Ptr DeviceSize
pSizes)
  () -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdBeginTransformFeedbackEXT
  :: FunPtr (Ptr CommandBuffer_T -> Word32 -> Word32 -> Ptr Buffer -> Ptr DeviceSize -> IO ()) -> Ptr CommandBuffer_T -> Word32 -> Word32 -> Ptr Buffer -> Ptr DeviceSize -> IO ()

-- | vkCmdBeginTransformFeedbackEXT - Make transform feedback active in the
-- command buffer
--
-- = Description
--
-- The active transform feedback buffers will capture primitives emitted
-- from the corresponding @XfbBuffer@ in the bound graphics pipeline. Any
-- @XfbBuffer@ emitted that does not output to an active transform feedback
-- buffer will not be captured.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdBeginTransformFeedbackEXT-transformFeedback-02366#
--     'PhysicalDeviceTransformFeedbackFeaturesEXT'::@transformFeedback@
--     /must/ be enabled
--
-- -   #VUID-vkCmdBeginTransformFeedbackEXT-None-02367# Transform feedback
--     /must/ not be active
--
-- -   #VUID-vkCmdBeginTransformFeedbackEXT-firstCounterBuffer-02368#
--     @firstCounterBuffer@ /must/ be less than
--     'PhysicalDeviceTransformFeedbackPropertiesEXT'::@maxTransformFeedbackBuffers@
--
-- -   #VUID-vkCmdBeginTransformFeedbackEXT-firstCounterBuffer-02369# The
--     sum of @firstCounterBuffer@ and @counterBufferCount@ /must/ be less
--     than or equal to
--     'PhysicalDeviceTransformFeedbackPropertiesEXT'::@maxTransformFeedbackBuffers@
--
-- -   #VUID-vkCmdBeginTransformFeedbackEXT-counterBufferCount-02607# If
--     @counterBufferCount@ is not @0@, and @pCounterBuffers@ is not
--     @NULL@, @pCounterBuffers@ /must/ be a valid pointer to an array of
--     @counterBufferCount@ 'Vulkan.Core10.Handles.Buffer' handles that are
--     either valid or 'Vulkan.Core10.APIConstants.NULL_HANDLE'
--
-- -   #VUID-vkCmdBeginTransformFeedbackEXT-pCounterBufferOffsets-02370#
--     For each buffer handle in the array, if it is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE' it /must/ reference a
--     buffer large enough to hold 4 bytes at the corresponding offset from
--     the @pCounterBufferOffsets@ array
--
-- -   #VUID-vkCmdBeginTransformFeedbackEXT-pCounterBuffer-02371# If
--     @pCounterBuffer@ is @NULL@, then @pCounterBufferOffsets@ /must/ also
--     be @NULL@
--
-- -   #VUID-vkCmdBeginTransformFeedbackEXT-pCounterBuffers-02372# For each
--     buffer handle in the @pCounterBuffers@ array that is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE' it /must/ have been created
--     with a @usage@ value containing
--     'Vulkan.Core10.Enums.BufferUsageFlagBits.BUFFER_USAGE_TRANSFORM_FEEDBACK_COUNTER_BUFFER_BIT_EXT'
--
-- -   #VUID-vkCmdBeginTransformFeedbackEXT-None-06233# A valid graphics
--     pipeline /must/ be bound to
--     'Vulkan.Core10.Enums.PipelineBindPoint.PIPELINE_BIND_POINT_GRAPHICS'
--
-- -   #VUID-vkCmdBeginTransformFeedbackEXT-None-04128# The last
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#pipeline-graphics-subsets-pre-rasterization pre-rasterization shader stage>
--     of the bound graphics pipeline /must/ have been declared with the
--     @Xfb@ execution mode
--
-- -   #VUID-vkCmdBeginTransformFeedbackEXT-None-02373# Transform feedback
--     /must/ not be made active in a render pass instance with multiview
--     enabled
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdBeginTransformFeedbackEXT-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdBeginTransformFeedbackEXT-pCounterBufferOffsets-parameter#
--     If @counterBufferCount@ is not @0@, and @pCounterBufferOffsets@ is
--     not @NULL@, @pCounterBufferOffsets@ /must/ be a valid pointer to an
--     array of @counterBufferCount@
--     'Vulkan.Core10.FundamentalTypes.DeviceSize' values
--
-- -   #VUID-vkCmdBeginTransformFeedbackEXT-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-vkCmdBeginTransformFeedbackEXT-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- -   #VUID-vkCmdBeginTransformFeedbackEXT-renderpass# This command /must/
--     only be called inside of a render pass instance
--
-- -   #VUID-vkCmdBeginTransformFeedbackEXT-commonparent# Both of
--     @commandBuffer@, and the elements of @pCounterBuffers@ 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 @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#VkQueueFlagBits Supported Queue Types> |
-- +============================================================================================================================+========================================================================================================================+=======================================================================================================================+
-- | Primary                                                                                                                    | Inside                                                                                                                 | Graphics                                                                                                              |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                       |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_transform_feedback VK_EXT_transform_feedback>,
-- 'Vulkan.Core10.Handles.Buffer', 'Vulkan.Core10.Handles.CommandBuffer',
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize'
cmdBeginTransformFeedbackEXT :: forall io
                              . (MonadIO io)
                             => -- | @commandBuffer@ is the command buffer into which the command is
                                -- recorded.
                                CommandBuffer
                             -> -- | @firstCounterBuffer@ is the index of the first transform feedback buffer
                                -- corresponding to @pCounterBuffers@[0] and @pCounterBufferOffsets@[0].
                                ("firstCounterBuffer" ::: Word32)
                             -> -- | @pCounterBuffers@ is @NULL@ or a pointer to an array of
                                -- 'Vulkan.Core10.Handles.Buffer' handles to counter buffers. Each buffer
                                -- contains a 4 byte integer value representing the byte offset from the
                                -- start of the corresponding transform feedback buffer from where to start
                                -- capturing vertex data. If the byte offset stored to the counter buffer
                                -- location was done using 'cmdEndTransformFeedbackEXT' it can be used to
                                -- resume transform feedback from the previous location. If
                                -- @pCounterBuffers@ is @NULL@, then transform feedback will start
                                -- capturing vertex data to byte offset zero in all bound transform
                                -- feedback buffers. For each element of @pCounterBuffers@ that is
                                -- 'Vulkan.Core10.APIConstants.NULL_HANDLE', transform feedback will start
                                -- capturing vertex data to byte zero in the corresponding bound transform
                                -- feedback buffer.
                                ("counterBuffers" ::: Vector Buffer)
                             -> -- | @pCounterBufferOffsets@ is @NULL@ or a pointer to an array of
                                -- 'Vulkan.Core10.FundamentalTypes.DeviceSize' values specifying offsets
                                -- within each of the @pCounterBuffers@ where the counter values were
                                -- previously written. The location in each counter buffer at these offsets
                                -- /must/ be large enough to contain 4 bytes of data. This data is the
                                -- number of bytes captured by the previous transform feedback to this
                                -- buffer. If @pCounterBufferOffsets@ is @NULL@, then it is assumed the
                                -- offsets are zero.
                                ("counterBufferOffsets" ::: Vector DeviceSize)
                             -> io ()
cmdBeginTransformFeedbackEXT :: CommandBuffer
-> ("firstBinding" ::: Word32)
-> ("buffers" ::: Vector Buffer)
-> ("offsets" ::: Vector DeviceSize)
-> io ()
cmdBeginTransformFeedbackEXT CommandBuffer
commandBuffer "firstBinding" ::: Word32
firstCounterBuffer "buffers" ::: Vector Buffer
counterBuffers "offsets" ::: Vector DeviceSize
counterBufferOffsets = 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 vkCmdBeginTransformFeedbackEXTPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> ("pBuffers" ::: Ptr Buffer)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> IO ())
vkCmdBeginTransformFeedbackEXTPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("firstBinding" ::: Word32)
      -> ("firstBinding" ::: Word32)
      -> ("pBuffers" ::: Ptr Buffer)
      -> ("pOffsets" ::: Ptr DeviceSize)
      -> IO ())
pVkCmdBeginTransformFeedbackEXT (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
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> ("pBuffers" ::: Ptr Buffer)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> IO ())
vkCmdBeginTransformFeedbackEXTPtr FunPtr
  (Ptr CommandBuffer_T
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> ("pBuffers" ::: Ptr Buffer)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("firstBinding" ::: Word32)
      -> ("firstBinding" ::: Word32)
      -> ("pBuffers" ::: Ptr Buffer)
      -> ("pOffsets" ::: Ptr DeviceSize)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> ("pBuffers" ::: Ptr Buffer)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> 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 vkCmdBeginTransformFeedbackEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdBeginTransformFeedbackEXT' :: Ptr CommandBuffer_T
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> ("pBuffers" ::: Ptr Buffer)
-> ("pOffsets" ::: Ptr DeviceSize)
-> IO ()
vkCmdBeginTransformFeedbackEXT' = FunPtr
  (Ptr CommandBuffer_T
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> ("pBuffers" ::: Ptr Buffer)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> IO ())
-> Ptr CommandBuffer_T
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> ("pBuffers" ::: Ptr Buffer)
-> ("pOffsets" ::: Ptr DeviceSize)
-> IO ()
mkVkCmdBeginTransformFeedbackEXT FunPtr
  (Ptr CommandBuffer_T
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> ("pBuffers" ::: Ptr Buffer)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> IO ())
vkCmdBeginTransformFeedbackEXTPtr
  let pCounterBuffersLength :: Int
pCounterBuffersLength = ("buffers" ::: Vector Buffer) -> Int
forall a. Vector a -> Int
Data.Vector.length (("buffers" ::: Vector Buffer) -> Int)
-> ("buffers" ::: Vector Buffer) -> Int
forall a b. (a -> b) -> a -> b
$ ("buffers" ::: Vector Buffer
counterBuffers)
  let pCounterBufferOffsetsLength :: Int
pCounterBufferOffsetsLength = ("offsets" ::: Vector DeviceSize) -> Int
forall a. Vector a -> Int
Data.Vector.length (("offsets" ::: Vector DeviceSize) -> Int)
-> ("offsets" ::: Vector DeviceSize) -> Int
forall a b. (a -> b) -> a -> b
$ ("offsets" ::: Vector DeviceSize
counterBufferOffsets)
  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 (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pCounterBufferOffsetsLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
pCounterBuffersLength Bool -> Bool -> Bool
|| Int
pCounterBufferOffsetsLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (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
"pCounterBufferOffsets and pCounterBuffers must have the same length" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  "pBuffers" ::: Ptr Buffer
pPCounterBuffers <- ((("pBuffers" ::: Ptr Buffer) -> IO ()) -> IO ())
-> ContT () IO ("pBuffers" ::: Ptr Buffer)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pBuffers" ::: Ptr Buffer) -> IO ()) -> IO ())
 -> ContT () IO ("pBuffers" ::: Ptr Buffer))
-> ((("pBuffers" ::: Ptr Buffer) -> IO ()) -> IO ())
-> ContT () IO ("pBuffers" ::: Ptr Buffer)
forall a b. (a -> b) -> a -> b
$ Int -> (("pBuffers" ::: Ptr Buffer) -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @Buffer ((("buffers" ::: Vector Buffer) -> Int
forall a. Vector a -> Int
Data.Vector.length ("buffers" ::: Vector Buffer
counterBuffers)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
  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 -> Buffer -> IO ()) -> ("buffers" ::: Vector Buffer) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Buffer
e -> ("pBuffers" ::: Ptr Buffer) -> Buffer -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pBuffers" ::: Ptr Buffer
pPCounterBuffers ("pBuffers" ::: Ptr Buffer) -> Int -> "pBuffers" ::: Ptr Buffer
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Buffer) (Buffer
e)) ("buffers" ::: Vector Buffer
counterBuffers)
  "pOffsets" ::: Ptr DeviceSize
pCounterBufferOffsets <- if ("offsets" ::: Vector DeviceSize) -> Bool
forall a. Vector a -> Bool
Data.Vector.null ("offsets" ::: Vector DeviceSize
counterBufferOffsets)
    then ("pOffsets" ::: Ptr DeviceSize)
-> ContT () IO ("pOffsets" ::: Ptr DeviceSize)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pOffsets" ::: Ptr DeviceSize
forall a. Ptr a
nullPtr
    else do
      "pOffsets" ::: Ptr DeviceSize
pPCounterBufferOffsets <- ((("pOffsets" ::: Ptr DeviceSize) -> IO ()) -> IO ())
-> ContT () IO ("pOffsets" ::: Ptr DeviceSize)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pOffsets" ::: Ptr DeviceSize) -> IO ()) -> IO ())
 -> ContT () IO ("pOffsets" ::: Ptr DeviceSize))
-> ((("pOffsets" ::: Ptr DeviceSize) -> IO ()) -> IO ())
-> ContT () IO ("pOffsets" ::: Ptr DeviceSize)
forall a b. (a -> b) -> a -> b
$ Int -> (("pOffsets" ::: Ptr DeviceSize) -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @DeviceSize (((("offsets" ::: Vector DeviceSize) -> Int
forall a. Vector a -> Int
Data.Vector.length ("offsets" ::: Vector DeviceSize
counterBufferOffsets))) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
      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 -> DeviceSize -> IO ())
-> ("offsets" ::: Vector DeviceSize) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i DeviceSize
e -> ("pOffsets" ::: Ptr DeviceSize) -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pOffsets" ::: Ptr DeviceSize
pPCounterBufferOffsets ("pOffsets" ::: Ptr DeviceSize)
-> Int -> "pOffsets" ::: Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr DeviceSize) (DeviceSize
e)) (("offsets" ::: Vector DeviceSize
counterBufferOffsets))
      ("pOffsets" ::: Ptr DeviceSize)
-> ContT () IO ("pOffsets" ::: Ptr DeviceSize)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("pOffsets" ::: Ptr DeviceSize)
 -> ContT () IO ("pOffsets" ::: Ptr DeviceSize))
-> ("pOffsets" ::: Ptr DeviceSize)
-> ContT () IO ("pOffsets" ::: Ptr DeviceSize)
forall a b. (a -> b) -> a -> b
$ "pOffsets" ::: Ptr DeviceSize
pPCounterBufferOffsets
  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
"vkCmdBeginTransformFeedbackEXT" (Ptr CommandBuffer_T
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> ("pBuffers" ::: Ptr Buffer)
-> ("pOffsets" ::: Ptr DeviceSize)
-> IO ()
vkCmdBeginTransformFeedbackEXT' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) ("firstBinding" ::: Word32
firstCounterBuffer) ((Int -> "firstBinding" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pCounterBuffersLength :: Word32)) ("pBuffers" ::: Ptr Buffer
pPCounterBuffers) "pOffsets" ::: Ptr DeviceSize
pCounterBufferOffsets)
  () -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()

-- | This function will call the supplied action between calls to
-- 'cmdBeginTransformFeedbackEXT' and 'cmdEndTransformFeedbackEXT'
--
-- Note that 'cmdEndTransformFeedbackEXT' is *not* called if an exception
-- is thrown by the inner action.
cmdUseTransformFeedbackEXT :: forall io r . MonadIO io => CommandBuffer -> Word32 -> Vector Buffer -> Vector DeviceSize -> io r -> io r
cmdUseTransformFeedbackEXT :: CommandBuffer
-> ("firstBinding" ::: Word32)
-> ("buffers" ::: Vector Buffer)
-> ("offsets" ::: Vector DeviceSize)
-> io r
-> io r
cmdUseTransformFeedbackEXT CommandBuffer
commandBuffer "firstBinding" ::: Word32
firstCounterBuffer "buffers" ::: Vector Buffer
pCounterBuffers "offsets" ::: Vector DeviceSize
pCounterBufferOffsets io r
a =
  (CommandBuffer
-> ("firstBinding" ::: Word32)
-> ("buffers" ::: Vector Buffer)
-> ("offsets" ::: Vector DeviceSize)
-> io ()
forall (io :: * -> *).
MonadIO io =>
CommandBuffer
-> ("firstBinding" ::: Word32)
-> ("buffers" ::: Vector Buffer)
-> ("offsets" ::: Vector DeviceSize)
-> io ()
cmdBeginTransformFeedbackEXT CommandBuffer
commandBuffer "firstBinding" ::: Word32
firstCounterBuffer "buffers" ::: Vector Buffer
pCounterBuffers "offsets" ::: Vector DeviceSize
pCounterBufferOffsets) io () -> io r -> io r
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> io r
a io r -> io () -> io r
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (CommandBuffer
-> ("firstBinding" ::: Word32)
-> ("buffers" ::: Vector Buffer)
-> ("offsets" ::: Vector DeviceSize)
-> io ()
forall (io :: * -> *).
MonadIO io =>
CommandBuffer
-> ("firstBinding" ::: Word32)
-> ("buffers" ::: Vector Buffer)
-> ("offsets" ::: Vector DeviceSize)
-> io ()
cmdEndTransformFeedbackEXT CommandBuffer
commandBuffer "firstBinding" ::: Word32
firstCounterBuffer "buffers" ::: Vector Buffer
pCounterBuffers "offsets" ::: Vector DeviceSize
pCounterBufferOffsets)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdEndTransformFeedbackEXT
  :: FunPtr (Ptr CommandBuffer_T -> Word32 -> Word32 -> Ptr Buffer -> Ptr DeviceSize -> IO ()) -> Ptr CommandBuffer_T -> Word32 -> Word32 -> Ptr Buffer -> Ptr DeviceSize -> IO ()

-- | vkCmdEndTransformFeedbackEXT - Make transform feedback inactive in the
-- command buffer
--
-- == Valid Usage
--
-- -   #VUID-vkCmdEndTransformFeedbackEXT-transformFeedback-02374#
--     'PhysicalDeviceTransformFeedbackFeaturesEXT'::@transformFeedback@
--     /must/ be enabled
--
-- -   #VUID-vkCmdEndTransformFeedbackEXT-None-02375# Transform feedback
--     /must/ be active
--
-- -   #VUID-vkCmdEndTransformFeedbackEXT-firstCounterBuffer-02376#
--     @firstCounterBuffer@ /must/ be less than
--     'PhysicalDeviceTransformFeedbackPropertiesEXT'::@maxTransformFeedbackBuffers@
--
-- -   #VUID-vkCmdEndTransformFeedbackEXT-firstCounterBuffer-02377# The sum
--     of @firstCounterBuffer@ and @counterBufferCount@ /must/ be less than
--     or equal to
--     'PhysicalDeviceTransformFeedbackPropertiesEXT'::@maxTransformFeedbackBuffers@
--
-- -   #VUID-vkCmdEndTransformFeedbackEXT-counterBufferCount-02608# If
--     @counterBufferCount@ is not @0@, and @pCounterBuffers@ is not
--     @NULL@, @pCounterBuffers@ /must/ be a valid pointer to an array of
--     @counterBufferCount@ 'Vulkan.Core10.Handles.Buffer' handles that are
--     either valid or 'Vulkan.Core10.APIConstants.NULL_HANDLE'
--
-- -   #VUID-vkCmdEndTransformFeedbackEXT-pCounterBufferOffsets-02378# For
--     each buffer handle in the array, if it is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE' it /must/ reference a
--     buffer large enough to hold 4 bytes at the corresponding offset from
--     the @pCounterBufferOffsets@ array
--
-- -   #VUID-vkCmdEndTransformFeedbackEXT-pCounterBuffer-02379# If
--     @pCounterBuffer@ is @NULL@, then @pCounterBufferOffsets@ /must/ also
--     be @NULL@
--
-- -   #VUID-vkCmdEndTransformFeedbackEXT-pCounterBuffers-02380# For each
--     buffer handle in the @pCounterBuffers@ array that is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE' it /must/ have been created
--     with a @usage@ value containing
--     'Vulkan.Core10.Enums.BufferUsageFlagBits.BUFFER_USAGE_TRANSFORM_FEEDBACK_COUNTER_BUFFER_BIT_EXT'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdEndTransformFeedbackEXT-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdEndTransformFeedbackEXT-pCounterBufferOffsets-parameter#
--     If @counterBufferCount@ is not @0@, and @pCounterBufferOffsets@ is
--     not @NULL@, @pCounterBufferOffsets@ /must/ be a valid pointer to an
--     array of @counterBufferCount@
--     'Vulkan.Core10.FundamentalTypes.DeviceSize' values
--
-- -   #VUID-vkCmdEndTransformFeedbackEXT-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-vkCmdEndTransformFeedbackEXT-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- -   #VUID-vkCmdEndTransformFeedbackEXT-renderpass# This command /must/
--     only be called inside of a render pass instance
--
-- -   #VUID-vkCmdEndTransformFeedbackEXT-commonparent# Both of
--     @commandBuffer@, and the elements of @pCounterBuffers@ 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 @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#VkQueueFlagBits Supported Queue Types> |
-- +============================================================================================================================+========================================================================================================================+=======================================================================================================================+
-- | Primary                                                                                                                    | Inside                                                                                                                 | Graphics                                                                                                              |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                       |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_transform_feedback VK_EXT_transform_feedback>,
-- 'Vulkan.Core10.Handles.Buffer', 'Vulkan.Core10.Handles.CommandBuffer',
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize'
cmdEndTransformFeedbackEXT :: forall io
                            . (MonadIO io)
                           => -- | @commandBuffer@ is the command buffer into which the command is
                              -- recorded.
                              CommandBuffer
                           -> -- | @firstCounterBuffer@ is the index of the first transform feedback buffer
                              -- corresponding to @pCounterBuffers@[0] and @pCounterBufferOffsets@[0].
                              ("firstCounterBuffer" ::: Word32)
                           -> -- | @pCounterBuffers@ is @NULL@ or a pointer to an array of
                              -- 'Vulkan.Core10.Handles.Buffer' handles to counter buffers. The counter
                              -- buffers are used to record the current byte positions of each transform
                              -- feedback buffer where the next vertex output data would be captured.
                              -- This /can/ be used by a subsequent 'cmdBeginTransformFeedbackEXT' call
                              -- to resume transform feedback capture from this position. It can also be
                              -- used by 'cmdDrawIndirectByteCountEXT' to determine the vertex count of
                              -- the draw call.
                              ("counterBuffers" ::: Vector Buffer)
                           -> -- | @pCounterBufferOffsets@ is @NULL@ or a pointer to an array of
                              -- 'Vulkan.Core10.FundamentalTypes.DeviceSize' values specifying offsets
                              -- within each of the @pCounterBuffers@ where the counter values can be
                              -- written. The location in each counter buffer at these offsets /must/ be
                              -- large enough to contain 4 bytes of data. The data stored at this
                              -- location is the byte offset from the start of the transform feedback
                              -- buffer binding where the next vertex data would be written. If
                              -- @pCounterBufferOffsets@ is @NULL@, then it is assumed the offsets are
                              -- zero.
                              ("counterBufferOffsets" ::: Vector DeviceSize)
                           -> io ()
cmdEndTransformFeedbackEXT :: CommandBuffer
-> ("firstBinding" ::: Word32)
-> ("buffers" ::: Vector Buffer)
-> ("offsets" ::: Vector DeviceSize)
-> io ()
cmdEndTransformFeedbackEXT CommandBuffer
commandBuffer "firstBinding" ::: Word32
firstCounterBuffer "buffers" ::: Vector Buffer
counterBuffers "offsets" ::: Vector DeviceSize
counterBufferOffsets = 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 vkCmdEndTransformFeedbackEXTPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> ("pBuffers" ::: Ptr Buffer)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> IO ())
vkCmdEndTransformFeedbackEXTPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("firstBinding" ::: Word32)
      -> ("firstBinding" ::: Word32)
      -> ("pBuffers" ::: Ptr Buffer)
      -> ("pOffsets" ::: Ptr DeviceSize)
      -> IO ())
pVkCmdEndTransformFeedbackEXT (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
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> ("pBuffers" ::: Ptr Buffer)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> IO ())
vkCmdEndTransformFeedbackEXTPtr FunPtr
  (Ptr CommandBuffer_T
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> ("pBuffers" ::: Ptr Buffer)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("firstBinding" ::: Word32)
      -> ("firstBinding" ::: Word32)
      -> ("pBuffers" ::: Ptr Buffer)
      -> ("pOffsets" ::: Ptr DeviceSize)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> ("pBuffers" ::: Ptr Buffer)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> 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 vkCmdEndTransformFeedbackEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdEndTransformFeedbackEXT' :: Ptr CommandBuffer_T
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> ("pBuffers" ::: Ptr Buffer)
-> ("pOffsets" ::: Ptr DeviceSize)
-> IO ()
vkCmdEndTransformFeedbackEXT' = FunPtr
  (Ptr CommandBuffer_T
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> ("pBuffers" ::: Ptr Buffer)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> IO ())
-> Ptr CommandBuffer_T
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> ("pBuffers" ::: Ptr Buffer)
-> ("pOffsets" ::: Ptr DeviceSize)
-> IO ()
mkVkCmdEndTransformFeedbackEXT FunPtr
  (Ptr CommandBuffer_T
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> ("pBuffers" ::: Ptr Buffer)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> IO ())
vkCmdEndTransformFeedbackEXTPtr
  let pCounterBuffersLength :: Int
pCounterBuffersLength = ("buffers" ::: Vector Buffer) -> Int
forall a. Vector a -> Int
Data.Vector.length (("buffers" ::: Vector Buffer) -> Int)
-> ("buffers" ::: Vector Buffer) -> Int
forall a b. (a -> b) -> a -> b
$ ("buffers" ::: Vector Buffer
counterBuffers)
  let pCounterBufferOffsetsLength :: Int
pCounterBufferOffsetsLength = ("offsets" ::: Vector DeviceSize) -> Int
forall a. Vector a -> Int
Data.Vector.length (("offsets" ::: Vector DeviceSize) -> Int)
-> ("offsets" ::: Vector DeviceSize) -> Int
forall a b. (a -> b) -> a -> b
$ ("offsets" ::: Vector DeviceSize
counterBufferOffsets)
  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 (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pCounterBufferOffsetsLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
pCounterBuffersLength Bool -> Bool -> Bool
|| Int
pCounterBufferOffsetsLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (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
"pCounterBufferOffsets and pCounterBuffers must have the same length" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  "pBuffers" ::: Ptr Buffer
pPCounterBuffers <- ((("pBuffers" ::: Ptr Buffer) -> IO ()) -> IO ())
-> ContT () IO ("pBuffers" ::: Ptr Buffer)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pBuffers" ::: Ptr Buffer) -> IO ()) -> IO ())
 -> ContT () IO ("pBuffers" ::: Ptr Buffer))
-> ((("pBuffers" ::: Ptr Buffer) -> IO ()) -> IO ())
-> ContT () IO ("pBuffers" ::: Ptr Buffer)
forall a b. (a -> b) -> a -> b
$ Int -> (("pBuffers" ::: Ptr Buffer) -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @Buffer ((("buffers" ::: Vector Buffer) -> Int
forall a. Vector a -> Int
Data.Vector.length ("buffers" ::: Vector Buffer
counterBuffers)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
  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 -> Buffer -> IO ()) -> ("buffers" ::: Vector Buffer) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Buffer
e -> ("pBuffers" ::: Ptr Buffer) -> Buffer -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pBuffers" ::: Ptr Buffer
pPCounterBuffers ("pBuffers" ::: Ptr Buffer) -> Int -> "pBuffers" ::: Ptr Buffer
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Buffer) (Buffer
e)) ("buffers" ::: Vector Buffer
counterBuffers)
  "pOffsets" ::: Ptr DeviceSize
pCounterBufferOffsets <- if ("offsets" ::: Vector DeviceSize) -> Bool
forall a. Vector a -> Bool
Data.Vector.null ("offsets" ::: Vector DeviceSize
counterBufferOffsets)
    then ("pOffsets" ::: Ptr DeviceSize)
-> ContT () IO ("pOffsets" ::: Ptr DeviceSize)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pOffsets" ::: Ptr DeviceSize
forall a. Ptr a
nullPtr
    else do
      "pOffsets" ::: Ptr DeviceSize
pPCounterBufferOffsets <- ((("pOffsets" ::: Ptr DeviceSize) -> IO ()) -> IO ())
-> ContT () IO ("pOffsets" ::: Ptr DeviceSize)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pOffsets" ::: Ptr DeviceSize) -> IO ()) -> IO ())
 -> ContT () IO ("pOffsets" ::: Ptr DeviceSize))
-> ((("pOffsets" ::: Ptr DeviceSize) -> IO ()) -> IO ())
-> ContT () IO ("pOffsets" ::: Ptr DeviceSize)
forall a b. (a -> b) -> a -> b
$ Int -> (("pOffsets" ::: Ptr DeviceSize) -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @DeviceSize (((("offsets" ::: Vector DeviceSize) -> Int
forall a. Vector a -> Int
Data.Vector.length ("offsets" ::: Vector DeviceSize
counterBufferOffsets))) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
      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 -> DeviceSize -> IO ())
-> ("offsets" ::: Vector DeviceSize) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i DeviceSize
e -> ("pOffsets" ::: Ptr DeviceSize) -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pOffsets" ::: Ptr DeviceSize
pPCounterBufferOffsets ("pOffsets" ::: Ptr DeviceSize)
-> Int -> "pOffsets" ::: Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr DeviceSize) (DeviceSize
e)) (("offsets" ::: Vector DeviceSize
counterBufferOffsets))
      ("pOffsets" ::: Ptr DeviceSize)
-> ContT () IO ("pOffsets" ::: Ptr DeviceSize)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("pOffsets" ::: Ptr DeviceSize)
 -> ContT () IO ("pOffsets" ::: Ptr DeviceSize))
-> ("pOffsets" ::: Ptr DeviceSize)
-> ContT () IO ("pOffsets" ::: Ptr DeviceSize)
forall a b. (a -> b) -> a -> b
$ "pOffsets" ::: Ptr DeviceSize
pPCounterBufferOffsets
  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
"vkCmdEndTransformFeedbackEXT" (Ptr CommandBuffer_T
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> ("pBuffers" ::: Ptr Buffer)
-> ("pOffsets" ::: Ptr DeviceSize)
-> IO ()
vkCmdEndTransformFeedbackEXT' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) ("firstBinding" ::: Word32
firstCounterBuffer) ((Int -> "firstBinding" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pCounterBuffersLength :: Word32)) ("pBuffers" ::: Ptr Buffer
pPCounterBuffers) "pOffsets" ::: Ptr DeviceSize
pCounterBufferOffsets)
  () -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdBeginQueryIndexedEXT
  :: FunPtr (Ptr CommandBuffer_T -> QueryPool -> Word32 -> QueryControlFlags -> Word32 -> IO ()) -> Ptr CommandBuffer_T -> QueryPool -> Word32 -> QueryControlFlags -> Word32 -> IO ()

-- | vkCmdBeginQueryIndexedEXT - Begin an indexed query
--
-- = Description
--
-- The 'cmdBeginQueryIndexedEXT' command operates the same as the
-- 'Vulkan.Core10.CommandBufferBuilding.cmdBeginQuery' command, except that
-- it also accepts a query type specific @index@ parameter.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-None-00807# All queries used by the
--     command /must/ be unavailable
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-queryType-02804# The @queryType@
--     used to create @queryPool@ /must/ not be
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_TIMESTAMP'
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-queryType-04728# The @queryType@
--     used to create @queryPool@ /must/ not be
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_ACCELERATION_STRUCTURE_COMPACTED_SIZE_KHR'
--     or
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_ACCELERATION_STRUCTURE_SERIALIZATION_SIZE_KHR'
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-queryType-04729# The @queryType@
--     used to create @queryPool@ /must/ not be
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_ACCELERATION_STRUCTURE_COMPACTED_SIZE_NV'
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-queryType-00800# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-occlusionQueryPrecise precise occlusion queries>
--     feature is not enabled, or the @queryType@ used to create
--     @queryPool@ was not
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_OCCLUSION', @flags@ /must/
--     not contain
--     'Vulkan.Core10.Enums.QueryControlFlagBits.QUERY_CONTROL_PRECISE_BIT'
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-query-00802# @query@ /must/ be less
--     than the number of queries in @queryPool@
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-queryType-00803# If the @queryType@
--     used to create @queryPool@ was
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_OCCLUSION', the
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-queryType-00804# If the @queryType@
--     used to create @queryPool@ was
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_PIPELINE_STATISTICS' and
--     any of the @pipelineStatistics@ indicate graphics operations, the
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-queryType-00805# If the @queryType@
--     used to create @queryPool@ was
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_PIPELINE_STATISTICS' and
--     any of the @pipelineStatistics@ indicate compute operations, the
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support compute operations
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-commandBuffer-01885# @commandBuffer@
--     /must/ not be a protected command buffer
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-query-00808# If called within a
--     render pass instance, the sum of @query@ and the number of bits set
--     in the current subpass’s view mask /must/ be less than or equal to
--     the number of queries in @queryPool@
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-queryPool-04753# If the @queryPool@
--     was created with the same @queryType@ as that of another
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#queries-operation-active active>
--     query within @commandBuffer@, then @index@ /must/ not match the
--     index used for the active query
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-queryType-02338# If the @queryType@
--     used to create @queryPool@ was
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_TRANSFORM_FEEDBACK_STREAM_EXT'
--     the 'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-queryType-02339# If the @queryType@
--     used to create @queryPool@ was
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_TRANSFORM_FEEDBACK_STREAM_EXT'
--     the @index@ parameter /must/ be less than
--     'PhysicalDeviceTransformFeedbackPropertiesEXT'::@maxTransformFeedbackStreams@
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-queryType-02340# If the @queryType@
--     used to create @queryPool@ was not
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_TRANSFORM_FEEDBACK_STREAM_EXT'
--     the @index@ /must/ be zero
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-queryType-02341# If the @queryType@
--     used to create @queryPool@ was
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_TRANSFORM_FEEDBACK_STREAM_EXT'
--     then
--     'PhysicalDeviceTransformFeedbackPropertiesEXT'::@transformFeedbackQueries@
--     /must/ be supported
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-queryPool-03223# If @queryPool@ was
--     created with a @queryType@ of
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_PERFORMANCE_QUERY_KHR',
--     the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#profiling-lock profiling lock>
--     /must/ have been held before
--     'Vulkan.Core10.CommandBuffer.beginCommandBuffer' was called on
--     @commandBuffer@
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-queryPool-03224# If @queryPool@ was
--     created with a @queryType@ of
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_PERFORMANCE_QUERY_KHR' and
--     one of the counters used to create @queryPool@ was
--     'Vulkan.Extensions.VK_KHR_performance_query.PERFORMANCE_COUNTER_SCOPE_COMMAND_BUFFER_KHR',
--     the query begin /must/ be the first recorded command in
--     @commandBuffer@
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-queryPool-03225# If @queryPool@ was
--     created with a @queryType@ of
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_PERFORMANCE_QUERY_KHR' and
--     one of the counters used to create @queryPool@ was
--     'Vulkan.Extensions.VK_KHR_performance_query.PERFORMANCE_COUNTER_SCOPE_RENDER_PASS_KHR',
--     the begin command /must/ not be recorded within a render pass
--     instance
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-queryPool-03226# If @queryPool@ was
--     created with a @queryType@ of
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_PERFORMANCE_QUERY_KHR' and
--     another query pool with a @queryType@
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_PERFORMANCE_QUERY_KHR' has
--     been used within @commandBuffer@, its parent primary command buffer
--     or secondary command buffer recorded within the same parent primary
--     command buffer as @commandBuffer@, the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-performanceCounterMultipleQueryPools performanceCounterMultipleQueryPools>
--     feature /must/ be enabled
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-None-02863# If @queryPool@ was
--     created with a @queryType@ of
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_PERFORMANCE_QUERY_KHR',
--     this command /must/ not be recorded in a command buffer that, either
--     directly or through secondary command buffers, also contains a
--     'Vulkan.Core10.CommandBufferBuilding.cmdResetQueryPool' command
--     affecting the same query
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-queryPool-parameter# @queryPool@
--     /must/ be a valid 'Vulkan.Core10.Handles.QueryPool' handle
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-flags-parameter# @flags@ /must/ be a
--     valid combination of
--     'Vulkan.Core10.Enums.QueryControlFlagBits.QueryControlFlagBits'
--     values
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-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-vkCmdBeginQueryIndexedEXT-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics, or compute operations
--
-- -   #VUID-vkCmdBeginQueryIndexedEXT-commonparent# Both of
--     @commandBuffer@, and @queryPool@ /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#VkQueueFlagBits Supported Queue Types> |
-- +============================================================================================================================+========================================================================================================================+=======================================================================================================================+
-- | Primary                                                                                                                    | Both                                                                                                                   | Graphics                                                                                                              |
-- | Secondary                                                                                                                  |                                                                                                                        | Compute                                                                                                               |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_transform_feedback VK_EXT_transform_feedback>,
-- 'Vulkan.Core10.Handles.CommandBuffer',
-- 'Vulkan.Core10.Enums.QueryControlFlagBits.QueryControlFlags',
-- 'Vulkan.Core10.Handles.QueryPool'
cmdBeginQueryIndexedEXT :: forall io
                         . (MonadIO io)
                        => -- | @commandBuffer@ is the command buffer into which this command will be
                           -- recorded.
                           CommandBuffer
                        -> -- | @queryPool@ is the query pool that will manage the results of the query.
                           QueryPool
                        -> -- | @query@ is the query index within the query pool that will contain the
                           -- results.
                           ("query" ::: Word32)
                        -> -- | @flags@ is a bitmask of
                           -- 'Vulkan.Core10.Enums.QueryControlFlagBits.QueryControlFlagBits'
                           -- specifying constraints on the types of queries that /can/ be performed.
                           QueryControlFlags
                        -> -- | @index@ is the query type specific index. When the query type is
                           -- 'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_TRANSFORM_FEEDBACK_STREAM_EXT'
                           -- the index represents the vertex stream.
                           ("index" ::: Word32)
                        -> io ()
cmdBeginQueryIndexedEXT :: CommandBuffer
-> QueryPool
-> ("firstBinding" ::: Word32)
-> QueryControlFlags
-> ("firstBinding" ::: Word32)
-> io ()
cmdBeginQueryIndexedEXT CommandBuffer
commandBuffer QueryPool
queryPool "firstBinding" ::: Word32
query QueryControlFlags
flags "firstBinding" ::: Word32
index = 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 vkCmdBeginQueryIndexedEXTPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> QueryPool
   -> ("firstBinding" ::: Word32)
   -> QueryControlFlags
   -> ("firstBinding" ::: Word32)
   -> IO ())
vkCmdBeginQueryIndexedEXTPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> QueryPool
      -> ("firstBinding" ::: Word32)
      -> QueryControlFlags
      -> ("firstBinding" ::: Word32)
      -> IO ())
pVkCmdBeginQueryIndexedEXT (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr CommandBuffer_T
   -> QueryPool
   -> ("firstBinding" ::: Word32)
   -> QueryControlFlags
   -> ("firstBinding" ::: Word32)
   -> IO ())
vkCmdBeginQueryIndexedEXTPtr FunPtr
  (Ptr CommandBuffer_T
   -> QueryPool
   -> ("firstBinding" ::: Word32)
   -> QueryControlFlags
   -> ("firstBinding" ::: Word32)
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> QueryPool
      -> ("firstBinding" ::: Word32)
      -> QueryControlFlags
      -> ("firstBinding" ::: Word32)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> QueryPool
   -> ("firstBinding" ::: Word32)
   -> QueryControlFlags
   -> ("firstBinding" ::: 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 vkCmdBeginQueryIndexedEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdBeginQueryIndexedEXT' :: Ptr CommandBuffer_T
-> QueryPool
-> ("firstBinding" ::: Word32)
-> QueryControlFlags
-> ("firstBinding" ::: Word32)
-> IO ()
vkCmdBeginQueryIndexedEXT' = FunPtr
  (Ptr CommandBuffer_T
   -> QueryPool
   -> ("firstBinding" ::: Word32)
   -> QueryControlFlags
   -> ("firstBinding" ::: Word32)
   -> IO ())
-> Ptr CommandBuffer_T
-> QueryPool
-> ("firstBinding" ::: Word32)
-> QueryControlFlags
-> ("firstBinding" ::: Word32)
-> IO ()
mkVkCmdBeginQueryIndexedEXT FunPtr
  (Ptr CommandBuffer_T
   -> QueryPool
   -> ("firstBinding" ::: Word32)
   -> QueryControlFlags
   -> ("firstBinding" ::: Word32)
   -> IO ())
vkCmdBeginQueryIndexedEXTPtr
  String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdBeginQueryIndexedEXT" (Ptr CommandBuffer_T
-> QueryPool
-> ("firstBinding" ::: Word32)
-> QueryControlFlags
-> ("firstBinding" ::: Word32)
-> IO ()
vkCmdBeginQueryIndexedEXT' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) (QueryPool
queryPool) ("firstBinding" ::: Word32
query) (QueryControlFlags
flags) ("firstBinding" ::: Word32
index))
  () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ ()

-- | This function will call the supplied action between calls to
-- 'cmdBeginQueryIndexedEXT' and 'cmdEndQueryIndexedEXT'
--
-- Note that 'cmdEndQueryIndexedEXT' is *not* called if an exception is
-- thrown by the inner action.
cmdUseQueryIndexedEXT :: forall io r . MonadIO io => CommandBuffer -> QueryPool -> Word32 -> QueryControlFlags -> Word32 -> io r -> io r
cmdUseQueryIndexedEXT :: CommandBuffer
-> QueryPool
-> ("firstBinding" ::: Word32)
-> QueryControlFlags
-> ("firstBinding" ::: Word32)
-> io r
-> io r
cmdUseQueryIndexedEXT CommandBuffer
commandBuffer QueryPool
queryPool "firstBinding" ::: Word32
query QueryControlFlags
flags "firstBinding" ::: Word32
index io r
a =
  (CommandBuffer
-> QueryPool
-> ("firstBinding" ::: Word32)
-> QueryControlFlags
-> ("firstBinding" ::: Word32)
-> io ()
forall (io :: * -> *).
MonadIO io =>
CommandBuffer
-> QueryPool
-> ("firstBinding" ::: Word32)
-> QueryControlFlags
-> ("firstBinding" ::: Word32)
-> io ()
cmdBeginQueryIndexedEXT CommandBuffer
commandBuffer QueryPool
queryPool "firstBinding" ::: Word32
query QueryControlFlags
flags "firstBinding" ::: Word32
index) io () -> io r -> io r
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> io r
a io r -> io () -> io r
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (CommandBuffer
-> QueryPool
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> io ()
forall (io :: * -> *).
MonadIO io =>
CommandBuffer
-> QueryPool
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> io ()
cmdEndQueryIndexedEXT CommandBuffer
commandBuffer QueryPool
queryPool "firstBinding" ::: Word32
query "firstBinding" ::: Word32
index)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdEndQueryIndexedEXT
  :: FunPtr (Ptr CommandBuffer_T -> QueryPool -> Word32 -> Word32 -> IO ()) -> Ptr CommandBuffer_T -> QueryPool -> Word32 -> Word32 -> IO ()

-- | vkCmdEndQueryIndexedEXT - Ends a query
--
-- = Description
--
-- The 'cmdEndQueryIndexedEXT' command operates the same as the
-- 'Vulkan.Core10.CommandBufferBuilding.cmdEndQuery' command, except that
-- it also accepts a query type specific @index@ parameter.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdEndQueryIndexedEXT-None-02342# All queries used by the
--     command /must/ be
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#queries-operation-active active>
--
-- -   #VUID-vkCmdEndQueryIndexedEXT-query-02343# @query@ /must/ be less
--     than the number of queries in @queryPool@
--
-- -   #VUID-vkCmdEndQueryIndexedEXT-commandBuffer-02344# @commandBuffer@
--     /must/ not be a protected command buffer
--
-- -   #VUID-vkCmdEndQueryIndexedEXT-query-02345# If
--     'cmdEndQueryIndexedEXT' is called within a render pass instance, the
--     sum of @query@ and the number of bits set in the current subpass’s
--     view mask /must/ be less than or equal to the number of queries in
--     @queryPool@
--
-- -   #VUID-vkCmdEndQueryIndexedEXT-queryType-02346# If the @queryType@
--     used to create @queryPool@ was
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_TRANSFORM_FEEDBACK_STREAM_EXT'
--     the @index@ parameter /must/ be less than
--     'PhysicalDeviceTransformFeedbackPropertiesEXT'::@maxTransformFeedbackStreams@
--
-- -   #VUID-vkCmdEndQueryIndexedEXT-queryType-02347# If the @queryType@
--     used to create @queryPool@ was not
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_TRANSFORM_FEEDBACK_STREAM_EXT'
--     the @index@ /must/ be zero
--
-- -   #VUID-vkCmdEndQueryIndexedEXT-queryType-02723# If the @queryType@
--     used to create @queryPool@ was
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_TRANSFORM_FEEDBACK_STREAM_EXT'
--     @index@ /must/ equal the @index@ used to begin the query
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdEndQueryIndexedEXT-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdEndQueryIndexedEXT-queryPool-parameter# @queryPool@
--     /must/ be a valid 'Vulkan.Core10.Handles.QueryPool' handle
--
-- -   #VUID-vkCmdEndQueryIndexedEXT-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-vkCmdEndQueryIndexedEXT-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics, or compute operations
--
-- -   #VUID-vkCmdEndQueryIndexedEXT-commonparent# Both of @commandBuffer@,
--     and @queryPool@ /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#VkQueueFlagBits Supported Queue Types> |
-- +============================================================================================================================+========================================================================================================================+=======================================================================================================================+
-- | Primary                                                                                                                    | Both                                                                                                                   | Graphics                                                                                                              |
-- | Secondary                                                                                                                  |                                                                                                                        | Compute                                                                                                               |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_transform_feedback VK_EXT_transform_feedback>,
-- 'Vulkan.Core10.Handles.CommandBuffer', 'Vulkan.Core10.Handles.QueryPool'
cmdEndQueryIndexedEXT :: forall io
                       . (MonadIO io)
                      => -- | @commandBuffer@ is the command buffer into which this command will be
                         -- recorded.
                         CommandBuffer
                      -> -- | @queryPool@ is the query pool that is managing the results of the query.
                         QueryPool
                      -> -- | @query@ is the query index within the query pool where the result is
                         -- stored.
                         ("query" ::: Word32)
                      -> -- | @index@ is the query type specific index.
                         ("index" ::: Word32)
                      -> io ()
cmdEndQueryIndexedEXT :: CommandBuffer
-> QueryPool
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> io ()
cmdEndQueryIndexedEXT CommandBuffer
commandBuffer QueryPool
queryPool "firstBinding" ::: Word32
query "firstBinding" ::: Word32
index = 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 vkCmdEndQueryIndexedEXTPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> QueryPool
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> IO ())
vkCmdEndQueryIndexedEXTPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> QueryPool
      -> ("firstBinding" ::: Word32)
      -> ("firstBinding" ::: Word32)
      -> IO ())
pVkCmdEndQueryIndexedEXT (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr CommandBuffer_T
   -> QueryPool
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> IO ())
vkCmdEndQueryIndexedEXTPtr FunPtr
  (Ptr CommandBuffer_T
   -> QueryPool
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> QueryPool
      -> ("firstBinding" ::: Word32)
      -> ("firstBinding" ::: Word32)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> QueryPool
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: 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 vkCmdEndQueryIndexedEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdEndQueryIndexedEXT' :: Ptr CommandBuffer_T
-> QueryPool
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> IO ()
vkCmdEndQueryIndexedEXT' = FunPtr
  (Ptr CommandBuffer_T
   -> QueryPool
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> IO ())
-> Ptr CommandBuffer_T
-> QueryPool
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> IO ()
mkVkCmdEndQueryIndexedEXT FunPtr
  (Ptr CommandBuffer_T
   -> QueryPool
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> IO ())
vkCmdEndQueryIndexedEXTPtr
  String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdEndQueryIndexedEXT" (Ptr CommandBuffer_T
-> QueryPool
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> IO ()
vkCmdEndQueryIndexedEXT' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) (QueryPool
queryPool) ("firstBinding" ::: Word32
query) ("firstBinding" ::: Word32
index))
  () -> 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" mkVkCmdDrawIndirectByteCountEXT
  :: FunPtr (Ptr CommandBuffer_T -> Word32 -> Word32 -> Buffer -> DeviceSize -> Word32 -> Word32 -> IO ()) -> Ptr CommandBuffer_T -> Word32 -> Word32 -> Buffer -> DeviceSize -> Word32 -> Word32 -> IO ()

-- | vkCmdDrawIndirectByteCountEXT - Draw primitives with indirect parameters
-- where the vertex count is derived from the counter byte value in the
-- counter buffer
--
-- = Description
--
-- When the command is executed, primitives are assembled in the same way
-- as done with 'Vulkan.Core10.CommandBufferBuilding.cmdDraw' except the
-- @vertexCount@ is calculated based on the byte count read from
-- @counterBuffer@ at offset @counterBufferOffset@. The assembled
-- primitives execute the bound graphics pipeline.
--
-- The effective @vertexCount@ is calculated as follows:
--
-- > const uint32_t * counterBufferPtr = (const uint8_t *)counterBuffer.address + counterBufferOffset;
-- > vertexCount = floor(max(0, (*counterBufferPtr - counterOffset)) / vertexStride);
--
-- The effective @firstVertex@ is zero.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-magFilter-04553# If a
--     'Vulkan.Core10.Handles.Sampler' created with @magFilter@ or
--     @minFilter@ equal to 'Vulkan.Core10.Enums.Filter.FILTER_LINEAR' and
--     @compareEnable@ equal to 'Vulkan.Core10.FundamentalTypes.FALSE' is
--     used to sample a 'Vulkan.Core10.Handles.ImageView' as a result of
--     this command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_SAMPLED_IMAGE_FILTER_LINEAR_BIT'
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-mipmapMode-04770# If a
--     'Vulkan.Core10.Handles.Sampler' created with @mipmapMode@ equal to
--     'Vulkan.Core10.Enums.SamplerMipmapMode.SAMPLER_MIPMAP_MODE_LINEAR'
--     and @compareEnable@ equal to 'Vulkan.Core10.FundamentalTypes.FALSE'
--     is used to sample a 'Vulkan.Core10.Handles.ImageView' as a result of
--     this command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_SAMPLED_IMAGE_FILTER_LINEAR_BIT'
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-None-06479# If a
--     'Vulkan.Core10.Handles.ImageView' is sampled with
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#textures-depth-compare-operation depth comparison>,
--     the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Extensions.VK_KHR_acceleration_structure.FORMAT_FEATURE_2_SAMPLED_IMAGE_DEPTH_COMPARISON_BIT_KHR'
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-None-02691# If a
--     'Vulkan.Core10.Handles.ImageView' is accessed using atomic
--     operations as a result of this command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_STORAGE_IMAGE_ATOMIC_BIT'
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-None-02692# If a
--     'Vulkan.Core10.Handles.ImageView' is sampled with
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FILTER_CUBIC_EXT' as a result
--     of this command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FORMAT_FEATURE_SAMPLED_IMAGE_FILTER_CUBIC_BIT_EXT'
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-filterCubic-02694# Any
--     'Vulkan.Core10.Handles.ImageView' being sampled with
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FILTER_CUBIC_EXT' as a result
--     of this command /must/ have a
--     'Vulkan.Core10.Enums.ImageViewType.ImageViewType' and format that
--     supports cubic filtering, as specified by
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FilterCubicImageViewImageFormatPropertiesEXT'::@filterCubic@
--     returned by
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceImageFormatProperties2'
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-filterCubicMinmax-02695# Any
--     'Vulkan.Core10.Handles.ImageView' being sampled with
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FILTER_CUBIC_EXT' with a
--     reduction mode of either
--     'Vulkan.Core12.Enums.SamplerReductionMode.SAMPLER_REDUCTION_MODE_MIN'
--     or
--     'Vulkan.Core12.Enums.SamplerReductionMode.SAMPLER_REDUCTION_MODE_MAX'
--     as a result of this command /must/ have a
--     'Vulkan.Core10.Enums.ImageViewType.ImageViewType' and format that
--     supports cubic filtering together with minmax filtering, as
--     specified by
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FilterCubicImageViewImageFormatPropertiesEXT'::@filterCubicMinmax@
--     returned by
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceImageFormatProperties2'
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-flags-02696# Any
--     'Vulkan.Core10.Handles.Image' created with a
--     'Vulkan.Core10.Image.ImageCreateInfo'::@flags@ containing
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_CORNER_SAMPLED_BIT_NV'
--     sampled as a result of this command /must/ only be sampled using a
--     'Vulkan.Core10.Enums.SamplerAddressMode.SamplerAddressMode' of
--     'Vulkan.Core10.Enums.SamplerAddressMode.SAMPLER_ADDRESS_MODE_CLAMP_TO_EDGE'
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-OpTypeImage-06423# Any
--     'Vulkan.Core10.Handles.ImageView' or
--     'Vulkan.Core10.Handles.BufferView' being written as a storage image
--     or storage texel buffer where the image format field of the
--     @OpTypeImage@ is @Unknown@ /must/ have image format features that
--     support
--     'Vulkan.Extensions.VK_KHR_acceleration_structure.FORMAT_FEATURE_2_STORAGE_WRITE_WITHOUT_FORMAT_BIT_KHR'
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-OpTypeImage-06424# Any
--     'Vulkan.Core10.Handles.ImageView' or
--     'Vulkan.Core10.Handles.BufferView' being read as a storage image or
--     storage texel buffer where the image format field of the
--     @OpTypeImage@ is @Unknown@ /must/ have image format features that
--     support
--     'Vulkan.Extensions.VK_KHR_acceleration_structure.FORMAT_FEATURE_2_STORAGE_READ_WITHOUT_FORMAT_BIT_KHR'
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-None-02697# For each set /n/
--     that is statically used by the 'Vulkan.Core10.Handles.Pipeline'
--     bound to the pipeline bind point used by this command, a descriptor
--     set /must/ have been bound to /n/ at the same pipeline bind point,
--     with a 'Vulkan.Core10.Handles.PipelineLayout' that is compatible for
--     set /n/, with the 'Vulkan.Core10.Handles.PipelineLayout' used to
--     create the current 'Vulkan.Core10.Handles.Pipeline', as described in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#descriptorsets-compatibility ???>
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-maintenance4-06425# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-maintenance4 maintenance4>
--     feature is not enabled, then for each push constant that is
--     statically used by the 'Vulkan.Core10.Handles.Pipeline' bound to the
--     pipeline bind point used by this command, a push constant value
--     /must/ have been set for the same pipeline bind point, with a
--     'Vulkan.Core10.Handles.PipelineLayout' that is compatible for push
--     constants, with the 'Vulkan.Core10.Handles.PipelineLayout' used to
--     create the current 'Vulkan.Core10.Handles.Pipeline', as described in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#descriptorsets-compatibility ???>
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-None-02699# Descriptors in each
--     bound descriptor set, specified via
--     'Vulkan.Core10.CommandBufferBuilding.cmdBindDescriptorSets', /must/
--     be valid if they are statically used by the
--     'Vulkan.Core10.Handles.Pipeline' bound to the pipeline bind point
--     used by this command
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-None-02700# A valid pipeline
--     /must/ be bound to the pipeline bind point used by this command
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-commandBuffer-02701# If the
--     'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline bind
--     point used by this command requires any dynamic state, that state
--     /must/ have been set or inherited (if the
--     @VK_NV_inherited_viewport_scissor@ extension is enabled) for
--     @commandBuffer@, and done so after any previously bound pipeline
--     with the corresponding state not specified as dynamic
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-None-02859# There /must/ not
--     have been any calls to dynamic state setting commands for any state
--     not specified as dynamic in the 'Vulkan.Core10.Handles.Pipeline'
--     object bound to the pipeline bind point used by this command, since
--     that pipeline was bound
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-None-02702# If the
--     'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline bind
--     point used by this command accesses a
--     'Vulkan.Core10.Handles.Sampler' object that uses unnormalized
--     coordinates, that sampler /must/ not be used to sample from any
--     'Vulkan.Core10.Handles.Image' with a
--     'Vulkan.Core10.Handles.ImageView' of the type
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_3D',
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE',
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_1D_ARRAY',
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D_ARRAY' or
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE_ARRAY', in
--     any shader stage
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-None-02703# If the
--     'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline bind
--     point used by this command accesses a
--     'Vulkan.Core10.Handles.Sampler' object that uses unnormalized
--     coordinates, that sampler /must/ not be used with any of the SPIR-V
--     @OpImageSample*@ or @OpImageSparseSample*@ instructions with
--     @ImplicitLod@, @Dref@ or @Proj@ in their name, in any shader stage
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-None-02704# If the
--     'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline bind
--     point used by this command accesses a
--     'Vulkan.Core10.Handles.Sampler' object that uses unnormalized
--     coordinates, that sampler /must/ not be used with any of the SPIR-V
--     @OpImageSample*@ or @OpImageSparseSample*@ instructions that
--     includes a LOD bias or any offset values, in any shader stage
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-None-02705# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-robustBufferAccess robust buffer access>
--     feature is not enabled, and if the 'Vulkan.Core10.Handles.Pipeline'
--     object bound to the pipeline bind point used by this command
--     accesses a uniform buffer, it /must/ not access values outside of
--     the range of the buffer as specified in the descriptor set bound to
--     the same pipeline bind point
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-None-02706# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-robustBufferAccess robust buffer access>
--     feature is not enabled, and if the 'Vulkan.Core10.Handles.Pipeline'
--     object bound to the pipeline bind point used by this command
--     accesses a storage buffer, it /must/ not access values outside of
--     the range of the buffer as specified in the descriptor set bound to
--     the same pipeline bind point
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-commandBuffer-02707# If
--     @commandBuffer@ is an unprotected command buffer and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-protectedNoFault protectedNoFault>
--     is not supported, any resource accessed by the
--     'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline bind
--     point used by this command /must/ not be a protected resource
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-None-04115# If a
--     'Vulkan.Core10.Handles.ImageView' is accessed using @OpImageWrite@
--     as a result of this command, then the @Type@ of the @Texel@ operand
--     of that instruction /must/ have at least as many components as the
--     image view’s format
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-OpImageWrite-04469# If a
--     'Vulkan.Core10.Handles.BufferView' is accessed using @OpImageWrite@
--     as a result of this command, then the @Type@ of the @Texel@ operand
--     of that instruction /must/ have at least as many components as the
--     buffer view’s format
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-SampledType-04470# If a
--     'Vulkan.Core10.Handles.ImageView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a 64-bit component
--     width is accessed as a result of this command, the @SampledType@ of
--     the @OpTypeImage@ operand of that instruction /must/ have a @Width@
--     of 64
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-SampledType-04471# If a
--     'Vulkan.Core10.Handles.ImageView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a component width less
--     than 64-bit is accessed as a result of this command, the
--     @SampledType@ of the @OpTypeImage@ operand of that instruction
--     /must/ have a @Width@ of 32
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-SampledType-04472# If a
--     'Vulkan.Core10.Handles.BufferView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a 64-bit component
--     width is accessed as a result of this command, the @SampledType@ of
--     the @OpTypeImage@ operand of that instruction /must/ have a @Width@
--     of 64
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-SampledType-04473# If a
--     'Vulkan.Core10.Handles.BufferView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a component width less
--     than 64-bit is accessed as a result of this command, the
--     @SampledType@ of the @OpTypeImage@ operand of that instruction
--     /must/ have a @Width@ of 32
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-sparseImageInt64Atomics-04474#
--     If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-sparseImageInt64Atomics sparseImageInt64Atomics>
--     feature is not enabled, 'Vulkan.Core10.Handles.Image' objects
--     created with the
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SPARSE_RESIDENCY_BIT'
--     flag /must/ not be accessed by atomic instructions through an
--     @OpTypeImage@ with a @SampledType@ with a @Width@ of 64 by this
--     command
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-sparseImageInt64Atomics-04475#
--     If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-sparseImageInt64Atomics sparseImageInt64Atomics>
--     feature is not enabled, 'Vulkan.Core10.Handles.Buffer' objects
--     created with the
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_SPARSE_RESIDENCY_BIT'
--     flag /must/ not be accessed by atomic instructions through an
--     @OpTypeImage@ with a @SampledType@ with a @Width@ of 64 by this
--     command
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-renderPass-02684# The current
--     render pass /must/ be
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#renderpass-compatibility compatible>
--     with the @renderPass@ member of the
--     'Vulkan.Core10.Pipeline.GraphicsPipelineCreateInfo' structure
--     specified when creating the 'Vulkan.Core10.Handles.Pipeline' bound
--     to
--     'Vulkan.Core10.Enums.PipelineBindPoint.PIPELINE_BIND_POINT_GRAPHICS'
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-subpass-02685# The subpass index
--     of the current render pass /must/ be equal to the @subpass@ member
--     of the 'Vulkan.Core10.Pipeline.GraphicsPipelineCreateInfo' structure
--     specified when creating the 'Vulkan.Core10.Handles.Pipeline' bound
--     to
--     'Vulkan.Core10.Enums.PipelineBindPoint.PIPELINE_BIND_POINT_GRAPHICS'
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-None-02686# Every input
--     attachment used by the current subpass /must/ be bound to the
--     pipeline via a descriptor set
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-None-04584# Image subresources
--     used as attachments in the current render pass /must/ not be
--     accessed in any way other than as an attachment by this command,
--     except for cases involving read-only access to depth\/stencil
--     attachments as described in the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#renderpass-attachment-nonattachment Render Pass>
--     chapter
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-maxMultiviewInstanceIndex-02688#
--     If the draw is recorded in a render pass instance with multiview
--     enabled, the maximum instance index /must/ be less than or equal to
--     'Vulkan.Core11.Promoted_From_VK_KHR_multiview.PhysicalDeviceMultiviewProperties'::@maxMultiviewInstanceIndex@
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-sampleLocationsEnable-02689# If
--     the bound graphics pipeline was created with
--     'Vulkan.Extensions.VK_EXT_sample_locations.PipelineSampleLocationsStateCreateInfoEXT'::@sampleLocationsEnable@
--     set to 'Vulkan.Core10.FundamentalTypes.TRUE' and the current subpass
--     has a depth\/stencil attachment, then that attachment /must/ have
--     been created with the
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SAMPLE_LOCATIONS_COMPATIBLE_DEPTH_BIT_EXT'
--     bit set
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-viewportCount-03417# If the
--     bound graphics pipeline state was created with the
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VIEWPORT_WITH_COUNT_EXT'
--     dynamic state enabled, but not the
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_SCISSOR_WITH_COUNT_EXT'
--     dynamic state enabled, then
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state.cmdSetViewportWithCountEXT'
--     /must/ have been called in the current command buffer prior to this
--     drawing command, and the @viewportCount@ parameter of
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state.cmdSetViewportWithCountEXT'
--     /must/ match the
--     'Vulkan.Core10.Pipeline.PipelineViewportStateCreateInfo'::@scissorCount@
--     of the pipeline
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-scissorCount-03418# If the bound
--     graphics pipeline state was created with the
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_SCISSOR_WITH_COUNT_EXT'
--     dynamic state enabled, but not the
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VIEWPORT_WITH_COUNT_EXT'
--     dynamic state enabled, then
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state.cmdSetScissorWithCountEXT'
--     /must/ have been called in the current command buffer prior to this
--     drawing command, and the @scissorCount@ parameter of
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state.cmdSetScissorWithCountEXT'
--     /must/ match the
--     'Vulkan.Core10.Pipeline.PipelineViewportStateCreateInfo'::@viewportCount@
--     of the pipeline
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-viewportCount-03419# If the
--     bound graphics pipeline state was created with both the
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_SCISSOR_WITH_COUNT_EXT'
--     and
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VIEWPORT_WITH_COUNT_EXT'
--     dynamic states enabled then both
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state.cmdSetViewportWithCountEXT'
--     and
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state.cmdSetScissorWithCountEXT'
--     /must/ have been called in the current command buffer prior to this
--     drawing command, and the @viewportCount@ parameter of
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state.cmdSetViewportWithCountEXT'
--     /must/ match the @scissorCount@ parameter of
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state.cmdSetScissorWithCountEXT'
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-viewportCount-04137# If the
--     bound graphics pipeline state was created with the
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VIEWPORT_WITH_COUNT_EXT'
--     dynamic state enabled, but not the
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VIEWPORT_W_SCALING_NV'
--     dynamic state enabled, then the bound graphics pipeline /must/ have
--     been created with
--     'Vulkan.Extensions.VK_NV_clip_space_w_scaling.PipelineViewportWScalingStateCreateInfoNV'::@viewportCount@
--     greater or equal to the @viewportCount@ parameter in the last call
--     to
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state.cmdSetViewportWithCountEXT'
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-viewportCount-04138# If the
--     bound graphics pipeline state was created with the
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VIEWPORT_WITH_COUNT_EXT'
--     and
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VIEWPORT_W_SCALING_NV'
--     dynamic states enabled then the @viewportCount@ parameter in the
--     last call to
--     'Vulkan.Extensions.VK_NV_clip_space_w_scaling.cmdSetViewportWScalingNV'
--     /must/ be greater than or equal to the @viewportCount@ parameter in
--     the last call to
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state.cmdSetViewportWithCountEXT'
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-viewportCount-04139# If the
--     bound graphics pipeline state was created with the
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VIEWPORT_WITH_COUNT_EXT'
--     dynamic state enabled, but not the
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VIEWPORT_SHADING_RATE_PALETTE_NV'
--     dynamic state enabled, then the bound graphics pipeline /must/ have
--     been created with
--     'Vulkan.Extensions.VK_NV_shading_rate_image.PipelineViewportShadingRateImageStateCreateInfoNV'::@viewportCount@
--     greater or equal to the @viewportCount@ parameter in the last call
--     to
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state.cmdSetViewportWithCountEXT'
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-viewportCount-04140# If the
--     bound graphics pipeline state was created with the
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VIEWPORT_WITH_COUNT_EXT'
--     and
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VIEWPORT_SHADING_RATE_PALETTE_NV'
--     dynamic states enabled then the @viewportCount@ parameter in the
--     last call to
--     'Vulkan.Extensions.VK_NV_shading_rate_image.cmdSetViewportShadingRatePaletteNV'
--     /must/ be greater than or equal to the @viewportCount@ parameter in
--     the last call to
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state.cmdSetViewportWithCountEXT'
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-VkPipelineVieportCreateInfo-04141#
--     If the bound graphics pipeline state was created with the
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VIEWPORT_WITH_COUNT_EXT'
--     dynamic state enabled and a
--     'Vulkan.Extensions.VK_NV_viewport_swizzle.PipelineViewportSwizzleStateCreateInfoNV'
--     structure chained from @VkPipelineVieportCreateInfo@, then the bound
--     graphics pipeline /must/ have been created with
--     'Vulkan.Extensions.VK_NV_viewport_swizzle.PipelineViewportSwizzleStateCreateInfoNV'::@viewportCount@
--     greater or equal to the @viewportCount@ parameter in the last call
--     to
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state.cmdSetViewportWithCountEXT'
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-VkPipelineVieportCreateInfo-04142#
--     If the bound graphics pipeline state was created with the
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VIEWPORT_WITH_COUNT_EXT'
--     dynamic state enabled and a
--     'Vulkan.Extensions.VK_NV_scissor_exclusive.PipelineViewportExclusiveScissorStateCreateInfoNV'
--     structure chained from @VkPipelineVieportCreateInfo@, then the bound
--     graphics pipeline /must/ have been created with
--     'Vulkan.Extensions.VK_NV_scissor_exclusive.PipelineViewportExclusiveScissorStateCreateInfoNV'::@exclusiveScissorCount@
--     greater or equal to the @viewportCount@ parameter in the last call
--     to
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state.cmdSetViewportWithCountEXT'
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-None-04876# If the bound
--     graphics pipeline state was created with the
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_RASTERIZER_DISCARD_ENABLE_EXT'
--     dynamic state enabled then
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state2.cmdSetRasterizerDiscardEnableEXT'
--     /must/ have been called in the current command buffer prior to this
--     drawing command
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-None-04877# If the bound
--     graphics pipeline state was created with the
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_DEPTH_BIAS_ENABLE_EXT'
--     dynamic state enabled then
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state2.cmdSetDepthBiasEnableEXT'
--     /must/ have been called in the current command buffer prior to this
--     drawing command
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-logicOp-04878# If the bound
--     graphics pipeline state was created with the
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_LOGIC_OP_EXT'
--     dynamic state enabled then
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state2.cmdSetLogicOpEXT'
--     /must/ have been called in the current command buffer prior to this
--     drawing command and the @logicOp@ /must/ be a valid
--     'Vulkan.Core10.Enums.LogicOp.LogicOp' value
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-primitiveFragmentShadingRateWithMultipleViewports-04552#
--     If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-primitiveFragmentShadingRateWithMultipleViewports primitiveFragmentShadingRateWithMultipleViewports>
--     limit is not supported, the bound graphics pipeline was created with
--     the
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VIEWPORT_WITH_COUNT_EXT'
--     dynamic state enabled, and any of the shader stages of the bound
--     graphics pipeline write to the @PrimitiveShadingRateKHR@ built-in,
--     then
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state.cmdSetViewportWithCountEXT'
--     /must/ have been called in the current command buffer prior to this
--     drawing command, and the @viewportCount@ parameter of
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state.cmdSetViewportWithCountEXT'
--     /must/ be @1@
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-blendEnable-04727# If
--     rasterization is not disabled in the bound graphics pipeline, then
--     for each color attachment in the subpass, if the corresponding image
--     view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     do not contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_COLOR_ATTACHMENT_BLEND_BIT',
--     then the @blendEnable@ member of the corresponding element of the
--     @pAttachments@ member of @pColorBlendState@ /must/ be
--     'Vulkan.Core10.FundamentalTypes.FALSE'
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-rasterizationSamples-04740# If
--     rasterization is not disabled in the bound graphics pipeline, and
--     neither the @VK_AMD_mixed_attachment_samples@ nor the
--     @VK_NV_framebuffer_mixed_samples@ extensions are enabled, then
--     'Vulkan.Core10.Pipeline.PipelineMultisampleStateCreateInfo'::@rasterizationSamples@
--     /must/ be the same as the current subpass color and\/or
--     depth\/stencil attachments
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-imageView-06172# If the current
--     render pass instance was begun with
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.cmdBeginRenderingKHR',
--     the @imageView@ member of @pDepthAttachment@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', and the @layout@ member of
--     @pDepthAttachment@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_STENCIL_READ_ONLY_OPTIMAL',
--     this command /must/ not write any values to the depth attachment
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-imageView-06173# If the current
--     render pass instance was begun with
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.cmdBeginRenderingKHR',
--     the @imageView@ member of @pStencilAttachment@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', and the @layout@ member of
--     @pStencilAttachment@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_STENCIL_READ_ONLY_OPTIMAL',
--     this command /must/ not write any values to the stencil attachment
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-imageView-06174# If the current
--     render pass instance was begun with
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.cmdBeginRenderingKHR',
--     the @imageView@ member of @pDepthAttachment@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', and the @layout@ member of
--     @pDepthAttachment@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_STENCIL_ATTACHMENT_OPTIMAL',
--     this command /must/ not write any values to the depth attachment
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-imageView-06175# If the current
--     render pass instance was begun with
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.cmdBeginRenderingKHR',
--     the @imageView@ member of @pStencilAttachment@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', and the @layout@ member of
--     @pStencilAttachment@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_STENCIL_READ_ONLY_OPTIMAL',
--     this command /must/ not write any values to the stencil attachment
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-imageView-06176# If the current
--     render pass instance was begun with
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.cmdBeginRenderingKHR',
--     the @imageView@ member of @pDepthAttachment@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', and the @layout@ member of
--     @pDepthAttachment@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_OPTIMAL',
--     this command /must/ not write any values to the depth attachment
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-imageView-06177# If the current
--     render pass instance was begun with
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.cmdBeginRenderingKHR',
--     the @imageView@ member of @pStencilAttachment@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', and the @layout@ member of
--     @pStencilAttachment@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_STENCIL_READ_ONLY_OPTIMAL',
--     this command /must/ not write any values to the stencil attachment
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-viewMask-06178# If the current
--     render pass instance was begun with
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.cmdBeginRenderingKHR',
--     the currently bound graphics pipeline /must/ have been created with
--     a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.PipelineRenderingCreateInfoKHR'::@viewMask@
--     equal to
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingInfoKHR'::@viewMask@
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-colorAttachmentCount-06179# If
--     the current render pass instance was begun with
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.cmdBeginRenderingKHR',
--     the currently bound graphics pipeline /must/ have been created with
--     a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.PipelineRenderingCreateInfoKHR'::@colorAttachmentCount@
--     equal to
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingInfoKHR'::@colorAttachmentCount@
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-colorAttachmentCount-06180# If
--     the current render pass instance was begun with
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.cmdBeginRenderingKHR'
--     and
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingInfoKHR'::@colorAttachmentCount@
--     greater than @0@, then each element of the
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingInfoKHR'::@pColorAttachments@
--     array with a @imageView@ not equal to
--     'Vulkan.Core10.APIConstants.NULL_HANDLE' /must/ have been created
--     with a 'Vulkan.Core10.Enums.Format.Format' equal to the
--     corresponding element of
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.PipelineRenderingCreateInfoKHR'::@pColorAttachmentFormats@
--     used to create the currently bound graphics pipeline
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-pDepthAttachment-06181# If the
--     current render pass instance was begun with
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.cmdBeginRenderingKHR'
--     and
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingInfoKHR'::@pDepthAttachment->pname@:imageView
--     was not 'Vulkan.Core10.APIConstants.NULL_HANDLE', the value of
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.PipelineRenderingCreateInfoKHR'::@depthAttachmentFormat@
--     used to create the currently bound graphics pipeline /must/ be equal
--     to the 'Vulkan.Core10.Enums.Format.Format' used to create
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingInfoKHR'::@pDepthAttachment->pname@:imageView
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-pStencilAttachment-06182# If the
--     current render pass instance was begun with
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.cmdBeginRenderingKHR'
--     and
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingInfoKHR'::@pStencilAttachment->pname@:imageView
--     was not 'Vulkan.Core10.APIConstants.NULL_HANDLE', the value of
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.PipelineRenderingCreateInfoKHR'::@stencilAttachmentFormat@
--     used to create the currently bound graphics pipeline /must/ be equal
--     to the 'Vulkan.Core10.Enums.Format.Format' used to create
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingInfoKHR'::@pStencilAttachment->pname@:imageView
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-imageView-06183# If the current
--     render pass instance was begun with
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.cmdBeginRenderingKHR'
--     and
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingFragmentShadingRateAttachmentInfoKHR'::@imageView@
--     was not 'Vulkan.Core10.APIConstants.NULL_HANDLE', the currently
--     bound graphics pipeline /must/ have been created with
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RENDERING_FRAGMENT_SHADING_RATE_ATTACHMENT_BIT_KHR'
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-imageView-06184# If the current
--     render pass instance was begun with
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.cmdBeginRenderingKHR'
--     and
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingFragmentDensityMapAttachmentInfoEXT'::@imageView@
--     was not 'Vulkan.Core10.APIConstants.NULL_HANDLE', the currently
--     bound graphics pipeline /must/ have been created with
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RENDERING_FRAGMENT_DENSITY_MAP_ATTACHMENT_BIT_EXT'
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-colorAttachmentCount-06185# If
--     the currently bound pipeline was created with a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.AttachmentSampleCountInfoAMD'
--     or
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.AttachmentSampleCountInfoNV'
--     structure, and the current render pass instance was begun with
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.cmdBeginRenderingKHR'
--     with a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingInfoKHR'::@colorAttachmentCount@
--     parameter greater than @0@, then each element of the
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingInfoKHR'::@pColorAttachments@
--     array with a @imageView@ not equal to
--     'Vulkan.Core10.APIConstants.NULL_HANDLE' /must/ have been created
--     with a sample count equal to the corresponding element of the
--     @pColorAttachmentSamples@ member of
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.AttachmentSampleCountInfoAMD'
--     or
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.AttachmentSampleCountInfoNV'
--     used to create the currently bound graphics pipeline
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-pDepthAttachment-06186# If the
--     current render pass instance was begun with
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.cmdBeginRenderingKHR',
--     the currently bound pipeline was created with a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.AttachmentSampleCountInfoAMD'
--     or
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.AttachmentSampleCountInfoNV'
--     structure, and
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingInfoKHR'::@pDepthAttachment->pname@:imageView
--     was not 'Vulkan.Core10.APIConstants.NULL_HANDLE', the value of the
--     @depthStencilAttachmentSamples@ member of
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.AttachmentSampleCountInfoAMD'
--     or
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.AttachmentSampleCountInfoNV'
--     used to create the currently bound graphics pipeline /must/ be equal
--     to the sample count used to create
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingInfoKHR'::@pDepthAttachment->pname@:imageView
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-pStencilAttachment-06187# If the
--     current render pass instance was begun with
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.cmdBeginRenderingKHR',
--     the currently bound pipeline was created with a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.AttachmentSampleCountInfoAMD'
--     or
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.AttachmentSampleCountInfoNV'
--     structure, and
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingInfoKHR'::@pStencilAttachment->pname@:imageView
--     was not 'Vulkan.Core10.APIConstants.NULL_HANDLE', the value of the
--     @depthStencilAttachmentSamples@ member of
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.AttachmentSampleCountInfoAMD'
--     or
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.AttachmentSampleCountInfoNV'
--     used to create the currently bound graphics pipeline /must/ be equal
--     to the sample count used to create
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingInfoKHR'::@pStencilAttachment->pname@:imageView
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-colorAttachmentCount-06188# If
--     the currently bound pipeline was created without a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.AttachmentSampleCountInfoAMD'
--     or
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.AttachmentSampleCountInfoNV'
--     structure, and the current render pass instance was begun with
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.cmdBeginRenderingKHR'
--     with a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingInfoKHR'::@colorAttachmentCount@
--     parameter greater than @0@, then each element of the
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingInfoKHR'::@pColorAttachments@
--     array with a @imageView@ not equal to
--     'Vulkan.Core10.APIConstants.NULL_HANDLE' /must/ have been created
--     with a sample count equal to the value of
--     'Vulkan.Core10.Pipeline.PipelineMultisampleStateCreateInfo'::@rasterizationSamples@
--     used to create the currently bound graphics pipeline
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-pDepthAttachment-06189# If the
--     current render pass instance was begun with
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.cmdBeginRenderingKHR',
--     the currently bound pipeline was created without a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.AttachmentSampleCountInfoAMD'
--     or
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.AttachmentSampleCountInfoNV'
--     structure, and
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingInfoKHR'::@pDepthAttachment->pname@:imageView
--     was not 'Vulkan.Core10.APIConstants.NULL_HANDLE', the value of
--     'Vulkan.Core10.Pipeline.PipelineMultisampleStateCreateInfo'::@rasterizationSamples@
--     used to create the currently bound graphics pipeline /must/ be equal
--     to the sample count used to create
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingInfoKHR'::@pDepthAttachment->pname@:imageView
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-pStencilAttachment-06190# If the
--     current render pass instance was begun with
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.cmdBeginRenderingKHR',
--     the currently bound pipeline was created without a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.AttachmentSampleCountInfoAMD'
--     or
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.AttachmentSampleCountInfoNV'
--     structure, and
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingInfoKHR'::@pStencilAttachment->pname@:imageView
--     was not 'Vulkan.Core10.APIConstants.NULL_HANDLE', the value of
--     'Vulkan.Core10.Pipeline.PipelineMultisampleStateCreateInfo'::@rasterizationSamples@
--     used to create the currently bound graphics pipeline /must/ be equal
--     to the sample count used to create
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingInfoKHR'::@pStencilAttachment->pname@:imageView
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-renderPass-06198# If the current
--     render pass instance was begun with
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.cmdBeginRenderingKHR',
--     the currently bound pipeline /must/ have been created with a
--     'Vulkan.Core10.Pipeline.GraphicsPipelineCreateInfo'::@renderPass@
--     equal to 'Vulkan.Core10.APIConstants.NULL_HANDLE'
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-None-04007# All vertex input
--     bindings accessed via vertex input variables declared in the vertex
--     shader entry point’s interface /must/ have either valid or
--     'Vulkan.Core10.APIConstants.NULL_HANDLE' buffers bound
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-None-04008# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-nullDescriptor nullDescriptor>
--     feature is not enabled, all vertex input bindings accessed via
--     vertex input variables declared in the vertex shader entry point’s
--     interface /must/ not be 'Vulkan.Core10.APIConstants.NULL_HANDLE'
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-None-02721# For a given vertex
--     buffer binding, any attribute data fetched /must/ be entirely
--     contained within the corresponding vertex buffer binding, as
--     described in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fxvertex-input ???>
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-primitiveTopology-03420# If the
--     bound graphics pipeline state was created with the
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_PRIMITIVE_TOPOLOGY_EXT'
--     dynamic state enabled then
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state.cmdSetPrimitiveTopologyEXT'
--     /must/ have been called in the current command buffer prior to this
--     drawing command, and the @primitiveTopology@ parameter of
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state.cmdSetPrimitiveTopologyEXT'
--     /must/ be of the same
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#drawing-primitive-topology-class topology class>
--     as the pipeline
--     'Vulkan.Core10.Pipeline.PipelineInputAssemblyStateCreateInfo'::@topology@
--     state
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-None-04912# If the bound
--     graphics pipeline was created with both the
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VERTEX_INPUT_EXT'
--     and
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VERTEX_INPUT_BINDING_STRIDE_EXT'
--     dynamic states enabled, then
--     'Vulkan.Extensions.VK_EXT_vertex_input_dynamic_state.cmdSetVertexInputEXT'
--     /must/ have been called in the current command buffer prior to this
--     draw command
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-pStrides-04913# If the bound
--     graphics pipeline was created with the
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VERTEX_INPUT_BINDING_STRIDE_EXT'
--     dynamic state enabled, but not the
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VERTEX_INPUT_EXT'
--     dynamic state enabled, then
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state.cmdBindVertexBuffers2EXT'
--     /must/ have been called in the current command buffer prior to this
--     draw command, and the @pStrides@ parameter of
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state.cmdBindVertexBuffers2EXT'
--     /must/ not be @NULL@
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-None-04914# If the bound
--     graphics pipeline state was created with the
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VERTEX_INPUT_EXT'
--     dynamic state enabled, then
--     'Vulkan.Extensions.VK_EXT_vertex_input_dynamic_state.cmdSetVertexInputEXT'
--     /must/ have been called in the current command buffer prior to this
--     draw command
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-None-04875# If the bound
--     graphics pipeline state was created with the
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_PATCH_CONTROL_POINTS_EXT'
--     dynamic state enabled then
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state2.cmdSetPatchControlPointsEXT'
--     /must/ have been called in the current command buffer prior to this
--     drawing command
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-None-04879# If the bound
--     graphics pipeline state was created with the
--     'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_PRIMITIVE_RESTART_ENABLE_EXT'
--     dynamic state enabled then
--     'Vulkan.Extensions.VK_EXT_extended_dynamic_state2.cmdSetPrimitiveRestartEnableEXT'
--     /must/ have been called in the current command buffer prior to this
--     drawing command
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-stage-06481# The bound graphics
--     pipeline /must/ not have been created with the
--     'Vulkan.Core10.Pipeline.PipelineShaderStageCreateInfo'::@stage@
--     member of an element of
--     'Vulkan.Core10.Pipeline.GraphicsPipelineCreateInfo'::@pStages@ set
--     to
--     'Vulkan.Core10.Enums.ShaderStageFlagBits.SHADER_STAGE_TASK_BIT_NV'
--     or
--     'Vulkan.Core10.Enums.ShaderStageFlagBits.SHADER_STAGE_MESH_BIT_NV'
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-transformFeedback-02287#
--     'PhysicalDeviceTransformFeedbackFeaturesEXT'::@transformFeedback@
--     /must/ be enabled
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-transformFeedbackDraw-02288# The
--     implementation /must/ support
--     'PhysicalDeviceTransformFeedbackPropertiesEXT'::@transformFeedbackDraw@
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-vertexStride-02289#
--     @vertexStride@ /must/ be greater than 0 and less than or equal to
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxTransformFeedbackBufferDataStride@
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-counterBuffer-04567# If
--     @counterBuffer@ is non-sparse then it /must/ be bound completely and
--     contiguously to a single 'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-counterBuffer-02290#
--     @counterBuffer@ /must/ have been created with the
--     'Vulkan.Core10.Enums.BufferUsageFlagBits.BUFFER_USAGE_INDIRECT_BUFFER_BIT'
--     bit set
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-counterBufferOffset-04568#
--     @counterBufferOffset@ /must/ be a multiple of @4@
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-commandBuffer-02646#
--     @commandBuffer@ /must/ not be a protected command buffer
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-counterBuffer-parameter#
--     @counterBuffer@ /must/ be a valid 'Vulkan.Core10.Handles.Buffer'
--     handle
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-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-vkCmdDrawIndirectByteCountEXT-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-renderpass# This command /must/
--     only be called inside of a render pass instance
--
-- -   #VUID-vkCmdDrawIndirectByteCountEXT-commonparent# Both of
--     @commandBuffer@, and @counterBuffer@ /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#VkQueueFlagBits Supported Queue Types> |
-- +============================================================================================================================+========================================================================================================================+=======================================================================================================================+
-- | Primary                                                                                                                    | Inside                                                                                                                 | Graphics                                                                                                              |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                       |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_transform_feedback VK_EXT_transform_feedback>,
-- 'Vulkan.Core10.Handles.Buffer', 'Vulkan.Core10.Handles.CommandBuffer',
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize'
cmdDrawIndirectByteCountEXT :: forall io
                             . (MonadIO io)
                            => -- | @commandBuffer@ is the command buffer into which the command is
                               -- recorded.
                               CommandBuffer
                            -> -- | @instanceCount@ is the number of instances to draw.
                               ("instanceCount" ::: Word32)
                            -> -- | @firstInstance@ is the instance ID of the first instance to draw.
                               ("firstInstance" ::: Word32)
                            -> -- | @counterBuffer@ is the buffer handle from where the byte count is read.
                               ("counterBuffer" ::: Buffer)
                            -> -- | @counterBufferOffset@ is the offset into the buffer used to read the
                               -- byte count, which is used to calculate the vertex count for this draw
                               -- call.
                               ("counterBufferOffset" ::: DeviceSize)
                            -> -- | @counterOffset@ is subtracted from the byte count read from the
                               -- @counterBuffer@ at the @counterBufferOffset@
                               ("counterOffset" ::: Word32)
                            -> -- | @vertexStride@ is the stride in bytes between each element of the vertex
                               -- data that is used to calculate the vertex count from the counter value.
                               -- This value is typically the same value that was used in the graphics
                               -- pipeline state when the transform feedback was captured as the
                               -- @XfbStride@.
                               ("vertexStride" ::: Word32)
                            -> io ()
cmdDrawIndirectByteCountEXT :: CommandBuffer
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> Buffer
-> DeviceSize
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> io ()
cmdDrawIndirectByteCountEXT CommandBuffer
commandBuffer "firstBinding" ::: Word32
instanceCount "firstBinding" ::: Word32
firstInstance Buffer
counterBuffer DeviceSize
counterBufferOffset "firstBinding" ::: Word32
counterOffset "firstBinding" ::: Word32
vertexStride = 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 vkCmdDrawIndirectByteCountEXTPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> Buffer
   -> DeviceSize
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> IO ())
vkCmdDrawIndirectByteCountEXTPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("firstBinding" ::: Word32)
      -> ("firstBinding" ::: Word32)
      -> Buffer
      -> DeviceSize
      -> ("firstBinding" ::: Word32)
      -> ("firstBinding" ::: Word32)
      -> IO ())
pVkCmdDrawIndirectByteCountEXT (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr CommandBuffer_T
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> Buffer
   -> DeviceSize
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> IO ())
vkCmdDrawIndirectByteCountEXTPtr FunPtr
  (Ptr CommandBuffer_T
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> Buffer
   -> DeviceSize
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("firstBinding" ::: Word32)
      -> ("firstBinding" ::: Word32)
      -> Buffer
      -> DeviceSize
      -> ("firstBinding" ::: Word32)
      -> ("firstBinding" ::: Word32)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> Buffer
   -> DeviceSize
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: 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 vkCmdDrawIndirectByteCountEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdDrawIndirectByteCountEXT' :: Ptr CommandBuffer_T
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> Buffer
-> DeviceSize
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> IO ()
vkCmdDrawIndirectByteCountEXT' = FunPtr
  (Ptr CommandBuffer_T
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> Buffer
   -> DeviceSize
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> IO ())
-> Ptr CommandBuffer_T
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> Buffer
-> DeviceSize
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> IO ()
mkVkCmdDrawIndirectByteCountEXT FunPtr
  (Ptr CommandBuffer_T
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> Buffer
   -> DeviceSize
   -> ("firstBinding" ::: Word32)
   -> ("firstBinding" ::: Word32)
   -> IO ())
vkCmdDrawIndirectByteCountEXTPtr
  String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdDrawIndirectByteCountEXT" (Ptr CommandBuffer_T
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> Buffer
-> DeviceSize
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> IO ()
vkCmdDrawIndirectByteCountEXT' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) ("firstBinding" ::: Word32
instanceCount) ("firstBinding" ::: Word32
firstInstance) (Buffer
counterBuffer) (DeviceSize
counterBufferOffset) ("firstBinding" ::: Word32
counterOffset) ("firstBinding" ::: Word32
vertexStride))
  () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ ()


-- | VkPhysicalDeviceTransformFeedbackFeaturesEXT - Structure describing
-- transform feedback features that can be supported by an implementation
--
-- = Members
--
-- This structure describes the following features:
--
-- = Description
--
-- If the 'PhysicalDeviceTransformFeedbackFeaturesEXT' 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. 'PhysicalDeviceTransformFeedbackFeaturesEXT' /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_EXT_transform_feedback VK_EXT_transform_feedback>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceTransformFeedbackFeaturesEXT = PhysicalDeviceTransformFeedbackFeaturesEXT
  { -- | #features-transformFeedback# @transformFeedback@ indicates whether the
    -- implementation supports transform feedback and shader modules /can/
    -- declare the @TransformFeedback@ capability.
    PhysicalDeviceTransformFeedbackFeaturesEXT -> Bool
transformFeedback :: Bool
  , -- | #features-geometryStreams# @geometryStreams@ indicates whether the
    -- implementation supports the @GeometryStreams@ SPIR-V capability.
    PhysicalDeviceTransformFeedbackFeaturesEXT -> Bool
geometryStreams :: Bool
  }
  deriving (Typeable, PhysicalDeviceTransformFeedbackFeaturesEXT
-> PhysicalDeviceTransformFeedbackFeaturesEXT -> Bool
(PhysicalDeviceTransformFeedbackFeaturesEXT
 -> PhysicalDeviceTransformFeedbackFeaturesEXT -> Bool)
-> (PhysicalDeviceTransformFeedbackFeaturesEXT
    -> PhysicalDeviceTransformFeedbackFeaturesEXT -> Bool)
-> Eq PhysicalDeviceTransformFeedbackFeaturesEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceTransformFeedbackFeaturesEXT
-> PhysicalDeviceTransformFeedbackFeaturesEXT -> Bool
$c/= :: PhysicalDeviceTransformFeedbackFeaturesEXT
-> PhysicalDeviceTransformFeedbackFeaturesEXT -> Bool
== :: PhysicalDeviceTransformFeedbackFeaturesEXT
-> PhysicalDeviceTransformFeedbackFeaturesEXT -> Bool
$c== :: PhysicalDeviceTransformFeedbackFeaturesEXT
-> PhysicalDeviceTransformFeedbackFeaturesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceTransformFeedbackFeaturesEXT)
#endif
deriving instance Show PhysicalDeviceTransformFeedbackFeaturesEXT

instance ToCStruct PhysicalDeviceTransformFeedbackFeaturesEXT where
  withCStruct :: PhysicalDeviceTransformFeedbackFeaturesEXT
-> (Ptr PhysicalDeviceTransformFeedbackFeaturesEXT -> IO b) -> IO b
withCStruct PhysicalDeviceTransformFeedbackFeaturesEXT
x Ptr PhysicalDeviceTransformFeedbackFeaturesEXT -> IO b
f = Int
-> (Ptr PhysicalDeviceTransformFeedbackFeaturesEXT -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr PhysicalDeviceTransformFeedbackFeaturesEXT -> IO b) -> IO b)
-> (Ptr PhysicalDeviceTransformFeedbackFeaturesEXT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceTransformFeedbackFeaturesEXT
p -> Ptr PhysicalDeviceTransformFeedbackFeaturesEXT
-> PhysicalDeviceTransformFeedbackFeaturesEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceTransformFeedbackFeaturesEXT
p PhysicalDeviceTransformFeedbackFeaturesEXT
x (Ptr PhysicalDeviceTransformFeedbackFeaturesEXT -> IO b
f Ptr PhysicalDeviceTransformFeedbackFeaturesEXT
p)
  pokeCStruct :: Ptr PhysicalDeviceTransformFeedbackFeaturesEXT
-> PhysicalDeviceTransformFeedbackFeaturesEXT -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceTransformFeedbackFeaturesEXT
p PhysicalDeviceTransformFeedbackFeaturesEXT{Bool
geometryStreams :: Bool
transformFeedback :: Bool
$sel:geometryStreams:PhysicalDeviceTransformFeedbackFeaturesEXT :: PhysicalDeviceTransformFeedbackFeaturesEXT -> Bool
$sel:transformFeedback:PhysicalDeviceTransformFeedbackFeaturesEXT :: PhysicalDeviceTransformFeedbackFeaturesEXT -> Bool
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackFeaturesEXT
p Ptr PhysicalDeviceTransformFeedbackFeaturesEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_TRANSFORM_FEEDBACK_FEATURES_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackFeaturesEXT
p Ptr PhysicalDeviceTransformFeedbackFeaturesEXT
-> 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 PhysicalDeviceTransformFeedbackFeaturesEXT
p Ptr PhysicalDeviceTransformFeedbackFeaturesEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
transformFeedback))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackFeaturesEXT
p Ptr PhysicalDeviceTransformFeedbackFeaturesEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
geometryStreams))
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr PhysicalDeviceTransformFeedbackFeaturesEXT -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceTransformFeedbackFeaturesEXT
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackFeaturesEXT
p Ptr PhysicalDeviceTransformFeedbackFeaturesEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_TRANSFORM_FEEDBACK_FEATURES_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackFeaturesEXT
p Ptr PhysicalDeviceTransformFeedbackFeaturesEXT
-> 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 PhysicalDeviceTransformFeedbackFeaturesEXT
p Ptr PhysicalDeviceTransformFeedbackFeaturesEXT -> 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))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackFeaturesEXT
p Ptr PhysicalDeviceTransformFeedbackFeaturesEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO b
f

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

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

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


-- | VkPhysicalDeviceTransformFeedbackPropertiesEXT - Structure describing
-- transform feedback properties that can be supported by an implementation
--
-- = Description
--
-- If the 'PhysicalDeviceTransformFeedbackPropertiesEXT' 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_EXT_transform_feedback VK_EXT_transform_feedback>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceTransformFeedbackPropertiesEXT = PhysicalDeviceTransformFeedbackPropertiesEXT
  { -- | #limits-maxTransformFeedbackStreams# @maxTransformFeedbackStreams@ is
    -- the maximum number of vertex streams that can be output from geometry
    -- shaders declared with the @GeometryStreams@ capability. If the
    -- implementation does not support
    -- 'PhysicalDeviceTransformFeedbackFeaturesEXT'::@geometryStreams@ then
    -- @maxTransformFeedbackStreams@ /must/ be set to @1@.
    PhysicalDeviceTransformFeedbackPropertiesEXT
-> "firstBinding" ::: Word32
maxTransformFeedbackStreams :: Word32
  , -- | #limits-maxTransformFeedbackBuffers# @maxTransformFeedbackBuffers@ is
    -- the maximum number of transform feedback buffers that can be bound for
    -- capturing shader outputs from the last
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#pipeline-graphics-subsets-pre-rasterization pre-rasterization shader stage>.
    PhysicalDeviceTransformFeedbackPropertiesEXT
-> "firstBinding" ::: Word32
maxTransformFeedbackBuffers :: Word32
  , -- | #limits-maxTransformFeedbackBufferSize# @maxTransformFeedbackBufferSize@
    -- is the maximum size that can be specified when binding a buffer for
    -- transform feedback in 'cmdBindTransformFeedbackBuffersEXT'.
    PhysicalDeviceTransformFeedbackPropertiesEXT -> DeviceSize
maxTransformFeedbackBufferSize :: DeviceSize
  , -- | #limits-maxTransformFeedbackStreamDataSize#
    -- @maxTransformFeedbackStreamDataSize@ is the maximum amount of data in
    -- bytes for each vertex that captured to one or more transform feedback
    -- buffers associated with a specific vertex stream.
    PhysicalDeviceTransformFeedbackPropertiesEXT
-> "firstBinding" ::: Word32
maxTransformFeedbackStreamDataSize :: Word32
  , -- | #limits-maxTransformFeedbackBufferDataSize#
    -- @maxTransformFeedbackBufferDataSize@ is the maximum amount of data in
    -- bytes for each vertex that can be captured to a specific transform
    -- feedback buffer.
    PhysicalDeviceTransformFeedbackPropertiesEXT
-> "firstBinding" ::: Word32
maxTransformFeedbackBufferDataSize :: Word32
  , -- | #limits-maxTransformFeedbackBufferDataStride#
    -- @maxTransformFeedbackBufferDataStride@ is the maximum stride between
    -- each capture of vertex data to the buffer.
    PhysicalDeviceTransformFeedbackPropertiesEXT
-> "firstBinding" ::: Word32
maxTransformFeedbackBufferDataStride :: Word32
  , -- | #limits-transformFeedbackQueries# @transformFeedbackQueries@ is
    -- 'Vulkan.Core10.FundamentalTypes.TRUE' if the implementation supports the
    -- 'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_TRANSFORM_FEEDBACK_STREAM_EXT'
    -- query type. @transformFeedbackQueries@ is
    -- 'Vulkan.Core10.FundamentalTypes.FALSE' if queries of this type /cannot/
    -- be created.
    PhysicalDeviceTransformFeedbackPropertiesEXT -> Bool
transformFeedbackQueries :: Bool
  , -- | #limits-transformFeedbackStreamsLinesTriangles#
    -- @transformFeedbackStreamsLinesTriangles@ is
    -- 'Vulkan.Core10.FundamentalTypes.TRUE' if the implementation supports the
    -- geometry shader @OpExecutionMode@ of @OutputLineStrip@ and
    -- @OutputTriangleStrip@ in addition to @OutputPoints@ when more than one
    -- vertex stream is output. If @transformFeedbackStreamsLinesTriangles@ is
    -- 'Vulkan.Core10.FundamentalTypes.FALSE' the implementation only supports
    -- an @OpExecutionMode@ of @OutputPoints@ when more than one vertex stream
    -- is output from the geometry shader.
    PhysicalDeviceTransformFeedbackPropertiesEXT -> Bool
transformFeedbackStreamsLinesTriangles :: Bool
  , -- | #limits-transformFeedbackRasterizationStreamSelect#
    -- @transformFeedbackRasterizationStreamSelect@ is
    -- 'Vulkan.Core10.FundamentalTypes.TRUE' if the implementation supports the
    -- @GeometryStreams@ SPIR-V capability and the application can use
    -- 'PipelineRasterizationStateStreamCreateInfoEXT' to modify which vertex
    -- stream output is used for rasterization. Otherwise vertex stream @0@
    -- /must/ always be used for rasterization.
    PhysicalDeviceTransformFeedbackPropertiesEXT -> Bool
transformFeedbackRasterizationStreamSelect :: Bool
  , -- | #limits-transformFeedbackDraw# @transformFeedbackDraw@ is
    -- 'Vulkan.Core10.FundamentalTypes.TRUE' if the implementation supports the
    -- 'cmdDrawIndirectByteCountEXT' function otherwise the function /must/ not
    -- be called.
    PhysicalDeviceTransformFeedbackPropertiesEXT -> Bool
transformFeedbackDraw :: Bool
  }
  deriving (Typeable, PhysicalDeviceTransformFeedbackPropertiesEXT
-> PhysicalDeviceTransformFeedbackPropertiesEXT -> Bool
(PhysicalDeviceTransformFeedbackPropertiesEXT
 -> PhysicalDeviceTransformFeedbackPropertiesEXT -> Bool)
-> (PhysicalDeviceTransformFeedbackPropertiesEXT
    -> PhysicalDeviceTransformFeedbackPropertiesEXT -> Bool)
-> Eq PhysicalDeviceTransformFeedbackPropertiesEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceTransformFeedbackPropertiesEXT
-> PhysicalDeviceTransformFeedbackPropertiesEXT -> Bool
$c/= :: PhysicalDeviceTransformFeedbackPropertiesEXT
-> PhysicalDeviceTransformFeedbackPropertiesEXT -> Bool
== :: PhysicalDeviceTransformFeedbackPropertiesEXT
-> PhysicalDeviceTransformFeedbackPropertiesEXT -> Bool
$c== :: PhysicalDeviceTransformFeedbackPropertiesEXT
-> PhysicalDeviceTransformFeedbackPropertiesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceTransformFeedbackPropertiesEXT)
#endif
deriving instance Show PhysicalDeviceTransformFeedbackPropertiesEXT

instance ToCStruct PhysicalDeviceTransformFeedbackPropertiesEXT where
  withCStruct :: PhysicalDeviceTransformFeedbackPropertiesEXT
-> (Ptr PhysicalDeviceTransformFeedbackPropertiesEXT -> IO b)
-> IO b
withCStruct PhysicalDeviceTransformFeedbackPropertiesEXT
x Ptr PhysicalDeviceTransformFeedbackPropertiesEXT -> IO b
f = Int
-> (Ptr PhysicalDeviceTransformFeedbackPropertiesEXT -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
64 ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT -> IO b)
 -> IO b)
-> (Ptr PhysicalDeviceTransformFeedbackPropertiesEXT -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p -> Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> PhysicalDeviceTransformFeedbackPropertiesEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p PhysicalDeviceTransformFeedbackPropertiesEXT
x (Ptr PhysicalDeviceTransformFeedbackPropertiesEXT -> IO b
f Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p)
  pokeCStruct :: Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> PhysicalDeviceTransformFeedbackPropertiesEXT -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p PhysicalDeviceTransformFeedbackPropertiesEXT{Bool
"firstBinding" ::: Word32
DeviceSize
transformFeedbackDraw :: Bool
transformFeedbackRasterizationStreamSelect :: Bool
transformFeedbackStreamsLinesTriangles :: Bool
transformFeedbackQueries :: Bool
maxTransformFeedbackBufferDataStride :: "firstBinding" ::: Word32
maxTransformFeedbackBufferDataSize :: "firstBinding" ::: Word32
maxTransformFeedbackStreamDataSize :: "firstBinding" ::: Word32
maxTransformFeedbackBufferSize :: DeviceSize
maxTransformFeedbackBuffers :: "firstBinding" ::: Word32
maxTransformFeedbackStreams :: "firstBinding" ::: Word32
$sel:transformFeedbackDraw:PhysicalDeviceTransformFeedbackPropertiesEXT :: PhysicalDeviceTransformFeedbackPropertiesEXT -> Bool
$sel:transformFeedbackRasterizationStreamSelect:PhysicalDeviceTransformFeedbackPropertiesEXT :: PhysicalDeviceTransformFeedbackPropertiesEXT -> Bool
$sel:transformFeedbackStreamsLinesTriangles:PhysicalDeviceTransformFeedbackPropertiesEXT :: PhysicalDeviceTransformFeedbackPropertiesEXT -> Bool
$sel:transformFeedbackQueries:PhysicalDeviceTransformFeedbackPropertiesEXT :: PhysicalDeviceTransformFeedbackPropertiesEXT -> Bool
$sel:maxTransformFeedbackBufferDataStride:PhysicalDeviceTransformFeedbackPropertiesEXT :: PhysicalDeviceTransformFeedbackPropertiesEXT
-> "firstBinding" ::: Word32
$sel:maxTransformFeedbackBufferDataSize:PhysicalDeviceTransformFeedbackPropertiesEXT :: PhysicalDeviceTransformFeedbackPropertiesEXT
-> "firstBinding" ::: Word32
$sel:maxTransformFeedbackStreamDataSize:PhysicalDeviceTransformFeedbackPropertiesEXT :: PhysicalDeviceTransformFeedbackPropertiesEXT
-> "firstBinding" ::: Word32
$sel:maxTransformFeedbackBufferSize:PhysicalDeviceTransformFeedbackPropertiesEXT :: PhysicalDeviceTransformFeedbackPropertiesEXT -> DeviceSize
$sel:maxTransformFeedbackBuffers:PhysicalDeviceTransformFeedbackPropertiesEXT :: PhysicalDeviceTransformFeedbackPropertiesEXT
-> "firstBinding" ::: Word32
$sel:maxTransformFeedbackStreams:PhysicalDeviceTransformFeedbackPropertiesEXT :: PhysicalDeviceTransformFeedbackPropertiesEXT
-> "firstBinding" ::: Word32
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_TRANSFORM_FEEDBACK_PROPERTIES_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr ("firstBinding" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) ("firstBinding" ::: Word32
maxTransformFeedbackStreams)
    Ptr ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr ("firstBinding" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) ("firstBinding" ::: Word32
maxTransformFeedbackBuffers)
    ("pOffsets" ::: Ptr DeviceSize) -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> "pOffsets" ::: Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DeviceSize)) (DeviceSize
maxTransformFeedbackBufferSize)
    Ptr ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr ("firstBinding" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) ("firstBinding" ::: Word32
maxTransformFeedbackStreamDataSize)
    Ptr ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr ("firstBinding" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32)) ("firstBinding" ::: Word32
maxTransformFeedbackBufferDataSize)
    Ptr ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr ("firstBinding" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word32)) ("firstBinding" ::: Word32
maxTransformFeedbackBufferDataStride)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
transformFeedbackQueries))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
transformFeedbackStreamsLinesTriangles))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
52 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
transformFeedbackRasterizationStreamSelect))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
transformFeedbackDraw))
    IO b
f
  cStructSize :: Int
cStructSize = Int
64
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr PhysicalDeviceTransformFeedbackPropertiesEXT -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_TRANSFORM_FEEDBACK_PROPERTIES_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr ("firstBinding" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) ("firstBinding" ::: Word32
forall a. Zero a => a
zero)
    Ptr ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr ("firstBinding" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) ("firstBinding" ::: Word32
forall a. Zero a => a
zero)
    ("pOffsets" ::: Ptr DeviceSize) -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> "pOffsets" ::: Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DeviceSize)) (DeviceSize
forall a. Zero a => a
zero)
    Ptr ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr ("firstBinding" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) ("firstBinding" ::: Word32
forall a. Zero a => a
zero)
    Ptr ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr ("firstBinding" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32)) ("firstBinding" ::: Word32
forall a. Zero a => a
zero)
    Ptr ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr ("firstBinding" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word32)) ("firstBinding" ::: Word32
forall a. Zero a => a
zero)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
52 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct PhysicalDeviceTransformFeedbackPropertiesEXT where
  peekCStruct :: Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> IO PhysicalDeviceTransformFeedbackPropertiesEXT
peekCStruct Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p = do
    "firstBinding" ::: Word32
maxTransformFeedbackStreams <- Ptr ("firstBinding" ::: Word32) -> IO ("firstBinding" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr ("firstBinding" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    "firstBinding" ::: Word32
maxTransformFeedbackBuffers <- Ptr ("firstBinding" ::: Word32) -> IO ("firstBinding" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr ("firstBinding" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
    DeviceSize
maxTransformFeedbackBufferSize <- ("pOffsets" ::: Ptr DeviceSize) -> IO DeviceSize
forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> "pOffsets" ::: Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DeviceSize))
    "firstBinding" ::: Word32
maxTransformFeedbackStreamDataSize <- Ptr ("firstBinding" ::: Word32) -> IO ("firstBinding" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr ("firstBinding" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32))
    "firstBinding" ::: Word32
maxTransformFeedbackBufferDataSize <- Ptr ("firstBinding" ::: Word32) -> IO ("firstBinding" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr ("firstBinding" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32))
    "firstBinding" ::: Word32
maxTransformFeedbackBufferDataStride <- Ptr ("firstBinding" ::: Word32) -> IO ("firstBinding" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr ("firstBinding" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word32))
    Bool32
transformFeedbackQueries <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Bool32))
    Bool32
transformFeedbackStreamsLinesTriangles <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Bool32))
    Bool32
transformFeedbackRasterizationStreamSelect <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
52 :: Ptr Bool32))
    Bool32
transformFeedbackDraw <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
p Ptr PhysicalDeviceTransformFeedbackPropertiesEXT
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr Bool32))
    PhysicalDeviceTransformFeedbackPropertiesEXT
-> IO PhysicalDeviceTransformFeedbackPropertiesEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceTransformFeedbackPropertiesEXT
 -> IO PhysicalDeviceTransformFeedbackPropertiesEXT)
-> PhysicalDeviceTransformFeedbackPropertiesEXT
-> IO PhysicalDeviceTransformFeedbackPropertiesEXT
forall a b. (a -> b) -> a -> b
$ ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> DeviceSize
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> Bool
-> Bool
-> Bool
-> Bool
-> PhysicalDeviceTransformFeedbackPropertiesEXT
PhysicalDeviceTransformFeedbackPropertiesEXT
             "firstBinding" ::: Word32
maxTransformFeedbackStreams "firstBinding" ::: Word32
maxTransformFeedbackBuffers DeviceSize
maxTransformFeedbackBufferSize "firstBinding" ::: Word32
maxTransformFeedbackStreamDataSize "firstBinding" ::: Word32
maxTransformFeedbackBufferDataSize "firstBinding" ::: Word32
maxTransformFeedbackBufferDataStride (Bool32 -> Bool
bool32ToBool Bool32
transformFeedbackQueries) (Bool32 -> Bool
bool32ToBool Bool32
transformFeedbackStreamsLinesTriangles) (Bool32 -> Bool
bool32ToBool Bool32
transformFeedbackRasterizationStreamSelect) (Bool32 -> Bool
bool32ToBool Bool32
transformFeedbackDraw)

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

instance Zero PhysicalDeviceTransformFeedbackPropertiesEXT where
  zero :: PhysicalDeviceTransformFeedbackPropertiesEXT
zero = ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> DeviceSize
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32)
-> Bool
-> Bool
-> Bool
-> Bool
-> PhysicalDeviceTransformFeedbackPropertiesEXT
PhysicalDeviceTransformFeedbackPropertiesEXT
           "firstBinding" ::: Word32
forall a. Zero a => a
zero
           "firstBinding" ::: Word32
forall a. Zero a => a
zero
           DeviceSize
forall a. Zero a => a
zero
           "firstBinding" ::: Word32
forall a. Zero a => a
zero
           "firstBinding" ::: Word32
forall a. Zero a => a
zero
           "firstBinding" ::: Word32
forall a. Zero a => a
zero
           Bool
forall a. Zero a => a
zero
           Bool
forall a. Zero a => a
zero
           Bool
forall a. Zero a => a
zero
           Bool
forall a. Zero a => a
zero


-- | VkPipelineRasterizationStateStreamCreateInfoEXT - Structure defining the
-- geometry stream used for rasterization
--
-- = Description
--
-- If this structure is not present, @rasterizationStream@ is assumed to be
-- zero.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_transform_feedback VK_EXT_transform_feedback>,
-- 'PipelineRasterizationStateStreamCreateFlagsEXT',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PipelineRasterizationStateStreamCreateInfoEXT = PipelineRasterizationStateStreamCreateInfoEXT
  { -- | @flags@ is reserved for future use.
    --
    -- #VUID-VkPipelineRasterizationStateStreamCreateInfoEXT-flags-zerobitmask#
    -- @flags@ /must/ be @0@
    PipelineRasterizationStateStreamCreateInfoEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
flags :: PipelineRasterizationStateStreamCreateFlagsEXT
  , -- | @rasterizationStream@ is the vertex stream selected for rasterization.
    --
    -- #VUID-VkPipelineRasterizationStateStreamCreateInfoEXT-rasterizationStream-02325#
    -- @rasterizationStream@ /must/ be less than
    -- 'PhysicalDeviceTransformFeedbackPropertiesEXT'::@maxTransformFeedbackStreams@
    --
    -- #VUID-VkPipelineRasterizationStateStreamCreateInfoEXT-rasterizationStream-02326#
    -- @rasterizationStream@ /must/ be zero if
    -- 'PhysicalDeviceTransformFeedbackPropertiesEXT'::@transformFeedbackRasterizationStreamSelect@
    -- is 'Vulkan.Core10.FundamentalTypes.FALSE'
    PipelineRasterizationStateStreamCreateInfoEXT
-> "firstBinding" ::: Word32
rasterizationStream :: Word32
  }
  deriving (Typeable, PipelineRasterizationStateStreamCreateInfoEXT
-> PipelineRasterizationStateStreamCreateInfoEXT -> Bool
(PipelineRasterizationStateStreamCreateInfoEXT
 -> PipelineRasterizationStateStreamCreateInfoEXT -> Bool)
-> (PipelineRasterizationStateStreamCreateInfoEXT
    -> PipelineRasterizationStateStreamCreateInfoEXT -> Bool)
-> Eq PipelineRasterizationStateStreamCreateInfoEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PipelineRasterizationStateStreamCreateInfoEXT
-> PipelineRasterizationStateStreamCreateInfoEXT -> Bool
$c/= :: PipelineRasterizationStateStreamCreateInfoEXT
-> PipelineRasterizationStateStreamCreateInfoEXT -> Bool
== :: PipelineRasterizationStateStreamCreateInfoEXT
-> PipelineRasterizationStateStreamCreateInfoEXT -> Bool
$c== :: PipelineRasterizationStateStreamCreateInfoEXT
-> PipelineRasterizationStateStreamCreateInfoEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineRasterizationStateStreamCreateInfoEXT)
#endif
deriving instance Show PipelineRasterizationStateStreamCreateInfoEXT

instance ToCStruct PipelineRasterizationStateStreamCreateInfoEXT where
  withCStruct :: PipelineRasterizationStateStreamCreateInfoEXT
-> (Ptr PipelineRasterizationStateStreamCreateInfoEXT -> IO b)
-> IO b
withCStruct PipelineRasterizationStateStreamCreateInfoEXT
x Ptr PipelineRasterizationStateStreamCreateInfoEXT -> IO b
f = Int
-> (Ptr PipelineRasterizationStateStreamCreateInfoEXT -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr PipelineRasterizationStateStreamCreateInfoEXT -> IO b)
 -> IO b)
-> (Ptr PipelineRasterizationStateStreamCreateInfoEXT -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PipelineRasterizationStateStreamCreateInfoEXT
p -> Ptr PipelineRasterizationStateStreamCreateInfoEXT
-> PipelineRasterizationStateStreamCreateInfoEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PipelineRasterizationStateStreamCreateInfoEXT
p PipelineRasterizationStateStreamCreateInfoEXT
x (Ptr PipelineRasterizationStateStreamCreateInfoEXT -> IO b
f Ptr PipelineRasterizationStateStreamCreateInfoEXT
p)
  pokeCStruct :: Ptr PipelineRasterizationStateStreamCreateInfoEXT
-> PipelineRasterizationStateStreamCreateInfoEXT -> IO b -> IO b
pokeCStruct Ptr PipelineRasterizationStateStreamCreateInfoEXT
p PipelineRasterizationStateStreamCreateInfoEXT{"firstBinding" ::: Word32
PipelineRasterizationStateStreamCreateFlagsEXT
rasterizationStream :: "firstBinding" ::: Word32
flags :: PipelineRasterizationStateStreamCreateFlagsEXT
$sel:rasterizationStream:PipelineRasterizationStateStreamCreateInfoEXT :: PipelineRasterizationStateStreamCreateInfoEXT
-> "firstBinding" ::: Word32
$sel:flags:PipelineRasterizationStateStreamCreateInfoEXT :: PipelineRasterizationStateStreamCreateInfoEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineRasterizationStateStreamCreateInfoEXT
p Ptr PipelineRasterizationStateStreamCreateInfoEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_RASTERIZATION_STATE_STREAM_CREATE_INFO_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineRasterizationStateStreamCreateInfoEXT
p Ptr PipelineRasterizationStateStreamCreateInfoEXT
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineRasterizationStateStreamCreateInfoEXT
p Ptr PipelineRasterizationStateStreamCreateInfoEXT
-> Int -> Ptr PipelineRasterizationStateStreamCreateFlagsEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PipelineRasterizationStateStreamCreateFlagsEXT)) (PipelineRasterizationStateStreamCreateFlagsEXT
flags)
    Ptr ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineRasterizationStateStreamCreateInfoEXT
p Ptr PipelineRasterizationStateStreamCreateInfoEXT
-> Int -> Ptr ("firstBinding" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) ("firstBinding" ::: Word32
rasterizationStream)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr PipelineRasterizationStateStreamCreateInfoEXT -> IO b -> IO b
pokeZeroCStruct Ptr PipelineRasterizationStateStreamCreateInfoEXT
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineRasterizationStateStreamCreateInfoEXT
p Ptr PipelineRasterizationStateStreamCreateInfoEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_RASTERIZATION_STATE_STREAM_CREATE_INFO_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineRasterizationStateStreamCreateInfoEXT
p Ptr PipelineRasterizationStateStreamCreateInfoEXT
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ("firstBinding" ::: Word32)
-> ("firstBinding" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineRasterizationStateStreamCreateInfoEXT
p Ptr PipelineRasterizationStateStreamCreateInfoEXT
-> Int -> Ptr ("firstBinding" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) ("firstBinding" ::: Word32
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct PipelineRasterizationStateStreamCreateInfoEXT where
  peekCStruct :: Ptr PipelineRasterizationStateStreamCreateInfoEXT
-> IO PipelineRasterizationStateStreamCreateInfoEXT
peekCStruct Ptr PipelineRasterizationStateStreamCreateInfoEXT
p = do
    PipelineRasterizationStateStreamCreateFlagsEXT
flags <- Ptr PipelineRasterizationStateStreamCreateFlagsEXT
-> IO PipelineRasterizationStateStreamCreateFlagsEXT
forall a. Storable a => Ptr a -> IO a
peek @PipelineRasterizationStateStreamCreateFlagsEXT ((Ptr PipelineRasterizationStateStreamCreateInfoEXT
p Ptr PipelineRasterizationStateStreamCreateInfoEXT
-> Int -> Ptr PipelineRasterizationStateStreamCreateFlagsEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PipelineRasterizationStateStreamCreateFlagsEXT))
    "firstBinding" ::: Word32
rasterizationStream <- Ptr ("firstBinding" ::: Word32) -> IO ("firstBinding" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PipelineRasterizationStateStreamCreateInfoEXT
p Ptr PipelineRasterizationStateStreamCreateInfoEXT
-> Int -> Ptr ("firstBinding" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
    PipelineRasterizationStateStreamCreateInfoEXT
-> IO PipelineRasterizationStateStreamCreateInfoEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PipelineRasterizationStateStreamCreateInfoEXT
 -> IO PipelineRasterizationStateStreamCreateInfoEXT)
-> PipelineRasterizationStateStreamCreateInfoEXT
-> IO PipelineRasterizationStateStreamCreateInfoEXT
forall a b. (a -> b) -> a -> b
$ PipelineRasterizationStateStreamCreateFlagsEXT
-> ("firstBinding" ::: Word32)
-> PipelineRasterizationStateStreamCreateInfoEXT
PipelineRasterizationStateStreamCreateInfoEXT
             PipelineRasterizationStateStreamCreateFlagsEXT
flags "firstBinding" ::: Word32
rasterizationStream

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

instance Zero PipelineRasterizationStateStreamCreateInfoEXT where
  zero :: PipelineRasterizationStateStreamCreateInfoEXT
zero = PipelineRasterizationStateStreamCreateFlagsEXT
-> ("firstBinding" ::: Word32)
-> PipelineRasterizationStateStreamCreateInfoEXT
PipelineRasterizationStateStreamCreateInfoEXT
           PipelineRasterizationStateStreamCreateFlagsEXT
forall a. Zero a => a
zero
           "firstBinding" ::: Word32
forall a. Zero a => a
zero


-- | VkPipelineRasterizationStateStreamCreateFlagsEXT - Reserved for future
-- use
--
-- = Description
--
-- 'PipelineRasterizationStateStreamCreateFlagsEXT' is a bitmask type for
-- setting a mask, but is currently reserved for future use.
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_transform_feedback VK_EXT_transform_feedback>,
-- 'PipelineRasterizationStateStreamCreateInfoEXT'
newtype PipelineRasterizationStateStreamCreateFlagsEXT = PipelineRasterizationStateStreamCreateFlagsEXT Flags
  deriving newtype (PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT -> Bool
(PipelineRasterizationStateStreamCreateFlagsEXT
 -> PipelineRasterizationStateStreamCreateFlagsEXT -> Bool)
-> (PipelineRasterizationStateStreamCreateFlagsEXT
    -> PipelineRasterizationStateStreamCreateFlagsEXT -> Bool)
-> Eq PipelineRasterizationStateStreamCreateFlagsEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT -> Bool
$c/= :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT -> Bool
== :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT -> Bool
$c== :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT -> Bool
Eq, Eq PipelineRasterizationStateStreamCreateFlagsEXT
Eq PipelineRasterizationStateStreamCreateFlagsEXT
-> (PipelineRasterizationStateStreamCreateFlagsEXT
    -> PipelineRasterizationStateStreamCreateFlagsEXT -> Ordering)
-> (PipelineRasterizationStateStreamCreateFlagsEXT
    -> PipelineRasterizationStateStreamCreateFlagsEXT -> Bool)
-> (PipelineRasterizationStateStreamCreateFlagsEXT
    -> PipelineRasterizationStateStreamCreateFlagsEXT -> Bool)
-> (PipelineRasterizationStateStreamCreateFlagsEXT
    -> PipelineRasterizationStateStreamCreateFlagsEXT -> Bool)
-> (PipelineRasterizationStateStreamCreateFlagsEXT
    -> PipelineRasterizationStateStreamCreateFlagsEXT -> Bool)
-> (PipelineRasterizationStateStreamCreateFlagsEXT
    -> PipelineRasterizationStateStreamCreateFlagsEXT
    -> PipelineRasterizationStateStreamCreateFlagsEXT)
-> (PipelineRasterizationStateStreamCreateFlagsEXT
    -> PipelineRasterizationStateStreamCreateFlagsEXT
    -> PipelineRasterizationStateStreamCreateFlagsEXT)
-> Ord PipelineRasterizationStateStreamCreateFlagsEXT
PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT -> Bool
PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT -> Ordering
PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
$cmin :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
max :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
$cmax :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
>= :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT -> Bool
$c>= :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT -> Bool
> :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT -> Bool
$c> :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT -> Bool
<= :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT -> Bool
$c<= :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT -> Bool
< :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT -> Bool
$c< :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT -> Bool
compare :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT -> Ordering
$ccompare :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT -> Ordering
$cp1Ord :: Eq PipelineRasterizationStateStreamCreateFlagsEXT
Ord, Ptr b -> Int -> IO PipelineRasterizationStateStreamCreateFlagsEXT
Ptr b
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT -> IO ()
Ptr PipelineRasterizationStateStreamCreateFlagsEXT
-> IO PipelineRasterizationStateStreamCreateFlagsEXT
Ptr PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> IO PipelineRasterizationStateStreamCreateFlagsEXT
Ptr PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT -> IO ()
Ptr PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT -> IO ()
PipelineRasterizationStateStreamCreateFlagsEXT -> Int
(PipelineRasterizationStateStreamCreateFlagsEXT -> Int)
-> (PipelineRasterizationStateStreamCreateFlagsEXT -> Int)
-> (Ptr PipelineRasterizationStateStreamCreateFlagsEXT
    -> Int -> IO PipelineRasterizationStateStreamCreateFlagsEXT)
-> (Ptr PipelineRasterizationStateStreamCreateFlagsEXT
    -> Int -> PipelineRasterizationStateStreamCreateFlagsEXT -> IO ())
-> (forall b.
    Ptr b -> Int -> IO PipelineRasterizationStateStreamCreateFlagsEXT)
-> (forall b.
    Ptr b
    -> Int -> PipelineRasterizationStateStreamCreateFlagsEXT -> IO ())
-> (Ptr PipelineRasterizationStateStreamCreateFlagsEXT
    -> IO PipelineRasterizationStateStreamCreateFlagsEXT)
-> (Ptr PipelineRasterizationStateStreamCreateFlagsEXT
    -> PipelineRasterizationStateStreamCreateFlagsEXT -> IO ())
-> Storable PipelineRasterizationStateStreamCreateFlagsEXT
forall b.
Ptr b -> Int -> IO PipelineRasterizationStateStreamCreateFlagsEXT
forall b.
Ptr b
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT -> IO ()
$cpoke :: Ptr PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT -> IO ()
peek :: Ptr PipelineRasterizationStateStreamCreateFlagsEXT
-> IO PipelineRasterizationStateStreamCreateFlagsEXT
$cpeek :: Ptr PipelineRasterizationStateStreamCreateFlagsEXT
-> IO PipelineRasterizationStateStreamCreateFlagsEXT
pokeByteOff :: Ptr b
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT -> IO ()
$cpokeByteOff :: forall b.
Ptr b
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT -> IO ()
peekByteOff :: Ptr b -> Int -> IO PipelineRasterizationStateStreamCreateFlagsEXT
$cpeekByteOff :: forall b.
Ptr b -> Int -> IO PipelineRasterizationStateStreamCreateFlagsEXT
pokeElemOff :: Ptr PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT -> IO ()
$cpokeElemOff :: Ptr PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT -> IO ()
peekElemOff :: Ptr PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> IO PipelineRasterizationStateStreamCreateFlagsEXT
$cpeekElemOff :: Ptr PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> IO PipelineRasterizationStateStreamCreateFlagsEXT
alignment :: PipelineRasterizationStateStreamCreateFlagsEXT -> Int
$calignment :: PipelineRasterizationStateStreamCreateFlagsEXT -> Int
sizeOf :: PipelineRasterizationStateStreamCreateFlagsEXT -> Int
$csizeOf :: PipelineRasterizationStateStreamCreateFlagsEXT -> Int
Storable, PipelineRasterizationStateStreamCreateFlagsEXT
PipelineRasterizationStateStreamCreateFlagsEXT
-> Zero PipelineRasterizationStateStreamCreateFlagsEXT
forall a. a -> Zero a
zero :: PipelineRasterizationStateStreamCreateFlagsEXT
$czero :: PipelineRasterizationStateStreamCreateFlagsEXT
Zero, Eq PipelineRasterizationStateStreamCreateFlagsEXT
PipelineRasterizationStateStreamCreateFlagsEXT
Eq PipelineRasterizationStateStreamCreateFlagsEXT
-> (PipelineRasterizationStateStreamCreateFlagsEXT
    -> PipelineRasterizationStateStreamCreateFlagsEXT
    -> PipelineRasterizationStateStreamCreateFlagsEXT)
-> (PipelineRasterizationStateStreamCreateFlagsEXT
    -> PipelineRasterizationStateStreamCreateFlagsEXT
    -> PipelineRasterizationStateStreamCreateFlagsEXT)
-> (PipelineRasterizationStateStreamCreateFlagsEXT
    -> PipelineRasterizationStateStreamCreateFlagsEXT
    -> PipelineRasterizationStateStreamCreateFlagsEXT)
-> (PipelineRasterizationStateStreamCreateFlagsEXT
    -> PipelineRasterizationStateStreamCreateFlagsEXT)
-> (PipelineRasterizationStateStreamCreateFlagsEXT
    -> Int -> PipelineRasterizationStateStreamCreateFlagsEXT)
-> (PipelineRasterizationStateStreamCreateFlagsEXT
    -> Int -> PipelineRasterizationStateStreamCreateFlagsEXT)
-> PipelineRasterizationStateStreamCreateFlagsEXT
-> (Int -> PipelineRasterizationStateStreamCreateFlagsEXT)
-> (PipelineRasterizationStateStreamCreateFlagsEXT
    -> Int -> PipelineRasterizationStateStreamCreateFlagsEXT)
-> (PipelineRasterizationStateStreamCreateFlagsEXT
    -> Int -> PipelineRasterizationStateStreamCreateFlagsEXT)
-> (PipelineRasterizationStateStreamCreateFlagsEXT
    -> Int -> PipelineRasterizationStateStreamCreateFlagsEXT)
-> (PipelineRasterizationStateStreamCreateFlagsEXT -> Int -> Bool)
-> (PipelineRasterizationStateStreamCreateFlagsEXT -> Maybe Int)
-> (PipelineRasterizationStateStreamCreateFlagsEXT -> Int)
-> (PipelineRasterizationStateStreamCreateFlagsEXT -> Bool)
-> (PipelineRasterizationStateStreamCreateFlagsEXT
    -> Int -> PipelineRasterizationStateStreamCreateFlagsEXT)
-> (PipelineRasterizationStateStreamCreateFlagsEXT
    -> Int -> PipelineRasterizationStateStreamCreateFlagsEXT)
-> (PipelineRasterizationStateStreamCreateFlagsEXT
    -> Int -> PipelineRasterizationStateStreamCreateFlagsEXT)
-> (PipelineRasterizationStateStreamCreateFlagsEXT
    -> Int -> PipelineRasterizationStateStreamCreateFlagsEXT)
-> (PipelineRasterizationStateStreamCreateFlagsEXT
    -> Int -> PipelineRasterizationStateStreamCreateFlagsEXT)
-> (PipelineRasterizationStateStreamCreateFlagsEXT
    -> Int -> PipelineRasterizationStateStreamCreateFlagsEXT)
-> (PipelineRasterizationStateStreamCreateFlagsEXT -> Int)
-> Bits PipelineRasterizationStateStreamCreateFlagsEXT
Int -> PipelineRasterizationStateStreamCreateFlagsEXT
PipelineRasterizationStateStreamCreateFlagsEXT -> Bool
PipelineRasterizationStateStreamCreateFlagsEXT -> Int
PipelineRasterizationStateStreamCreateFlagsEXT -> Maybe Int
PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
PipelineRasterizationStateStreamCreateFlagsEXT -> Int -> Bool
PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT
PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: PipelineRasterizationStateStreamCreateFlagsEXT -> Int
$cpopCount :: PipelineRasterizationStateStreamCreateFlagsEXT -> Int
rotateR :: PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT
$crotateR :: PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT
rotateL :: PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT
$crotateL :: PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT
unsafeShiftR :: PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT
$cunsafeShiftR :: PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT
shiftR :: PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT
$cshiftR :: PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT
unsafeShiftL :: PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT
$cunsafeShiftL :: PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT
shiftL :: PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT
$cshiftL :: PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT
isSigned :: PipelineRasterizationStateStreamCreateFlagsEXT -> Bool
$cisSigned :: PipelineRasterizationStateStreamCreateFlagsEXT -> Bool
bitSize :: PipelineRasterizationStateStreamCreateFlagsEXT -> Int
$cbitSize :: PipelineRasterizationStateStreamCreateFlagsEXT -> Int
bitSizeMaybe :: PipelineRasterizationStateStreamCreateFlagsEXT -> Maybe Int
$cbitSizeMaybe :: PipelineRasterizationStateStreamCreateFlagsEXT -> Maybe Int
testBit :: PipelineRasterizationStateStreamCreateFlagsEXT -> Int -> Bool
$ctestBit :: PipelineRasterizationStateStreamCreateFlagsEXT -> Int -> Bool
complementBit :: PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT
$ccomplementBit :: PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT
clearBit :: PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT
$cclearBit :: PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT
setBit :: PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT
$csetBit :: PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT
bit :: Int -> PipelineRasterizationStateStreamCreateFlagsEXT
$cbit :: Int -> PipelineRasterizationStateStreamCreateFlagsEXT
zeroBits :: PipelineRasterizationStateStreamCreateFlagsEXT
$czeroBits :: PipelineRasterizationStateStreamCreateFlagsEXT
rotate :: PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT
$crotate :: PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT
shift :: PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT
$cshift :: PipelineRasterizationStateStreamCreateFlagsEXT
-> Int -> PipelineRasterizationStateStreamCreateFlagsEXT
complement :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
$ccomplement :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
xor :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
$cxor :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
.|. :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
$c.|. :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
.&. :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
$c.&. :: PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
-> PipelineRasterizationStateStreamCreateFlagsEXT
$cp1Bits :: Eq PipelineRasterizationStateStreamCreateFlagsEXT
Bits, Bits PipelineRasterizationStateStreamCreateFlagsEXT
Bits PipelineRasterizationStateStreamCreateFlagsEXT
-> (PipelineRasterizationStateStreamCreateFlagsEXT -> Int)
-> (PipelineRasterizationStateStreamCreateFlagsEXT -> Int)
-> (PipelineRasterizationStateStreamCreateFlagsEXT -> Int)
-> FiniteBits PipelineRasterizationStateStreamCreateFlagsEXT
PipelineRasterizationStateStreamCreateFlagsEXT -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: PipelineRasterizationStateStreamCreateFlagsEXT -> Int
$ccountTrailingZeros :: PipelineRasterizationStateStreamCreateFlagsEXT -> Int
countLeadingZeros :: PipelineRasterizationStateStreamCreateFlagsEXT -> Int
$ccountLeadingZeros :: PipelineRasterizationStateStreamCreateFlagsEXT -> Int
finiteBitSize :: PipelineRasterizationStateStreamCreateFlagsEXT -> Int
$cfiniteBitSize :: PipelineRasterizationStateStreamCreateFlagsEXT -> Int
$cp1FiniteBits :: Bits PipelineRasterizationStateStreamCreateFlagsEXT
FiniteBits)



conNamePipelineRasterizationStateStreamCreateFlagsEXT :: String
conNamePipelineRasterizationStateStreamCreateFlagsEXT :: String
conNamePipelineRasterizationStateStreamCreateFlagsEXT = String
"PipelineRasterizationStateStreamCreateFlagsEXT"

enumPrefixPipelineRasterizationStateStreamCreateFlagsEXT :: String
enumPrefixPipelineRasterizationStateStreamCreateFlagsEXT :: String
enumPrefixPipelineRasterizationStateStreamCreateFlagsEXT = String
""

showTablePipelineRasterizationStateStreamCreateFlagsEXT :: [(PipelineRasterizationStateStreamCreateFlagsEXT, String)]
showTablePipelineRasterizationStateStreamCreateFlagsEXT :: [(PipelineRasterizationStateStreamCreateFlagsEXT, String)]
showTablePipelineRasterizationStateStreamCreateFlagsEXT = []

instance Show PipelineRasterizationStateStreamCreateFlagsEXT where
  showsPrec :: Int -> PipelineRasterizationStateStreamCreateFlagsEXT -> ShowS
showsPrec = String
-> [(PipelineRasterizationStateStreamCreateFlagsEXT, String)]
-> String
-> (PipelineRasterizationStateStreamCreateFlagsEXT
    -> "firstBinding" ::: Word32)
-> (("firstBinding" ::: Word32) -> ShowS)
-> Int
-> PipelineRasterizationStateStreamCreateFlagsEXT
-> ShowS
forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec String
enumPrefixPipelineRasterizationStateStreamCreateFlagsEXT
                            [(PipelineRasterizationStateStreamCreateFlagsEXT, String)]
showTablePipelineRasterizationStateStreamCreateFlagsEXT
                            String
conNamePipelineRasterizationStateStreamCreateFlagsEXT
                            (\(PipelineRasterizationStateStreamCreateFlagsEXT "firstBinding" ::: Word32
x) -> "firstBinding" ::: Word32
x)
                            (\"firstBinding" ::: Word32
x -> String -> ShowS
showString String
"0x" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("firstBinding" ::: Word32) -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex "firstBinding" ::: Word32
x)

instance Read PipelineRasterizationStateStreamCreateFlagsEXT where
  readPrec :: ReadPrec PipelineRasterizationStateStreamCreateFlagsEXT
readPrec = String
-> [(PipelineRasterizationStateStreamCreateFlagsEXT, String)]
-> String
-> (("firstBinding" ::: Word32)
    -> PipelineRasterizationStateStreamCreateFlagsEXT)
-> ReadPrec PipelineRasterizationStateStreamCreateFlagsEXT
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec String
enumPrefixPipelineRasterizationStateStreamCreateFlagsEXT
                          [(PipelineRasterizationStateStreamCreateFlagsEXT, String)]
showTablePipelineRasterizationStateStreamCreateFlagsEXT
                          String
conNamePipelineRasterizationStateStreamCreateFlagsEXT
                          ("firstBinding" ::: Word32)
-> PipelineRasterizationStateStreamCreateFlagsEXT
PipelineRasterizationStateStreamCreateFlagsEXT


type EXT_TRANSFORM_FEEDBACK_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_EXT_TRANSFORM_FEEDBACK_SPEC_VERSION"
pattern EXT_TRANSFORM_FEEDBACK_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_TRANSFORM_FEEDBACK_SPEC_VERSION :: a
$mEXT_TRANSFORM_FEEDBACK_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
EXT_TRANSFORM_FEEDBACK_SPEC_VERSION = 1


type EXT_TRANSFORM_FEEDBACK_EXTENSION_NAME = "VK_EXT_transform_feedback"

-- No documentation found for TopLevel "VK_EXT_TRANSFORM_FEEDBACK_EXTENSION_NAME"
pattern EXT_TRANSFORM_FEEDBACK_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_TRANSFORM_FEEDBACK_EXTENSION_NAME :: a
$mEXT_TRANSFORM_FEEDBACK_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
EXT_TRANSFORM_FEEDBACK_EXTENSION_NAME = "VK_EXT_transform_feedback"