{-# language CPP #-}
-- | = Name
--
-- VK_EXT_vertex_input_dynamic_state - device extension
--
-- == VK_EXT_vertex_input_dynamic_state
--
-- [__Name String__]
--     @VK_EXT_vertex_input_dynamic_state@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     353
--
-- [__Revision__]
--     2
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires support for Vulkan 1.0
--
--     -   Requires @VK_KHR_get_physical_device_properties2@ to be enabled
--         for any device-level functionality
--
-- [__Contact__]
--
--     -   Piers Daniell
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_EXT_vertex_input_dynamic_state] @pdaniell-nv%0A*Here describe the issue or question you have about the VK_EXT_vertex_input_dynamic_state extension* >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2020-08-21
--
-- [__IP Status__]
--     No known IP claims.
--
-- [__Contributors__]
--
--     -   Jeff Bolz, NVIDIA
--
--     -   Spencer Fricke, Samsung
--
--     -   Stu Smith, AMD
--
-- == Description
--
-- One of the states that contributes to the combinatorial explosion of
-- pipeline state objects that need to be created, is the vertex input
-- binding and attribute descriptions. By allowing them to be dynamic
-- applications may reduce the number of pipeline objects they need to
-- create.
--
-- This extension adds dynamic state support for what is normally static
-- state in 'Vulkan.Core10.Pipeline.PipelineVertexInputStateCreateInfo'.
--
-- == New Commands
--
-- -   'cmdSetVertexInputEXT'
--
-- == New Structures
--
-- -   'VertexInputAttributeDescription2EXT'
--
-- -   'VertexInputBindingDescription2EXT'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDeviceVertexInputDynamicStateFeaturesEXT'
--
-- == New Enum Constants
--
-- -   'EXT_VERTEX_INPUT_DYNAMIC_STATE_EXTENSION_NAME'
--
-- -   'EXT_VERTEX_INPUT_DYNAMIC_STATE_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.DynamicState.DynamicState':
--
--     -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VERTEX_INPUT_EXT'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_VERTEX_INPUT_DYNAMIC_STATE_FEATURES_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_VERTEX_INPUT_ATTRIBUTE_DESCRIPTION_2_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_VERTEX_INPUT_BINDING_DESCRIPTION_2_EXT'
--
-- == Version History
--
-- -   Revision 2, 2020-11-05 (Piers Daniell)
--
--     -   Make 'VertexInputBindingDescription2EXT' extensible
--
--     -   Add new 'VertexInputAttributeDescription2EXT' struct for the
--         @pVertexAttributeDescriptions@ parameter to
--         'cmdSetVertexInputEXT' so it is also extensible
--
-- -   Revision 1, 2020-08-21 (Piers Daniell)
--
--     -   Internal revisions
--
-- == See Also
--
-- 'PhysicalDeviceVertexInputDynamicStateFeaturesEXT',
-- 'VertexInputAttributeDescription2EXT',
-- 'VertexInputBindingDescription2EXT', 'cmdSetVertexInputEXT'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_EXT_vertex_input_dynamic_state 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_vertex_input_dynamic_state  ( cmdSetVertexInputEXT
                                                            , PhysicalDeviceVertexInputDynamicStateFeaturesEXT(..)
                                                            , VertexInputBindingDescription2EXT(..)
                                                            , VertexInputAttributeDescription2EXT(..)
                                                            , EXT_VERTEX_INPUT_DYNAMIC_STATE_SPEC_VERSION
                                                            , pattern EXT_VERTEX_INPUT_DYNAMIC_STATE_SPEC_VERSION
                                                            , EXT_VERTEX_INPUT_DYNAMIC_STATE_EXTENSION_NAME
                                                            , pattern EXT_VERTEX_INPUT_DYNAMIC_STATE_EXTENSION_NAME
                                                            ) where

import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytes)
import GHC.IO (throwIO)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Handles (CommandBuffer)
import Vulkan.Core10.Handles (CommandBuffer(..))
import Vulkan.Core10.Handles (CommandBuffer(CommandBuffer))
import Vulkan.Core10.Handles (CommandBuffer_T)
import Vulkan.Dynamic (DeviceCmds(pVkCmdSetVertexInputEXT))
import Vulkan.Core10.Enums.Format (Format)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.VertexInputRate (VertexInputRate)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_VERTEX_INPUT_DYNAMIC_STATE_FEATURES_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_VERTEX_INPUT_ATTRIBUTE_DESCRIPTION_2_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_VERTEX_INPUT_BINDING_DESCRIPTION_2_EXT))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdSetVertexInputEXT
  :: FunPtr (Ptr CommandBuffer_T -> Word32 -> Ptr VertexInputBindingDescription2EXT -> Word32 -> Ptr VertexInputAttributeDescription2EXT -> IO ()) -> Ptr CommandBuffer_T -> Word32 -> Ptr VertexInputBindingDescription2EXT -> Word32 -> Ptr VertexInputAttributeDescription2EXT -> IO ()

-- | vkCmdSetVertexInputEXT - Set the vertex input state dynamically for a
-- command buffer
--
-- = Description
--
-- This command sets the vertex input attribute and vertex input binding
-- descriptions state for subsequent drawing commands when the graphics
-- pipeline is created with
-- 'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VERTEX_INPUT_EXT' set in
-- 'Vulkan.Core10.Pipeline.PipelineDynamicStateCreateInfo'::@pDynamicStates@.
-- Otherwise, this state is specified by the
-- 'Vulkan.Core10.Pipeline.GraphicsPipelineCreateInfo'::@pVertexInputState@
-- values used to create the currently active pipeline.
--
-- If the bound pipeline state object was also created with the
-- 'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VERTEX_INPUT_BINDING_STRIDE'
-- dynamic state enabled, then
-- 'Vulkan.Core13.Promoted_From_VK_EXT_extended_dynamic_state.cmdBindVertexBuffers2'
-- can be used instead of 'cmdSetVertexInputEXT' to dynamically set the
-- stride.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdSetVertexInputEXT-None-04790# The
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-vertexInputDynamicState vertexInputDynamicState>
--     feature /must/ be enabled
--
-- -   #VUID-vkCmdSetVertexInputEXT-vertexBindingDescriptionCount-04791#
--     @vertexBindingDescriptionCount@ /must/ be less than or equal to
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxVertexInputBindings@
--
-- -   #VUID-vkCmdSetVertexInputEXT-vertexAttributeDescriptionCount-04792#
--     @vertexAttributeDescriptionCount@ /must/ be less than or equal to
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxVertexInputAttributes@
--
-- -   #VUID-vkCmdSetVertexInputEXT-binding-04793# For every @binding@
--     specified by each element of @pVertexAttributeDescriptions@, a
--     'VertexInputBindingDescription2EXT' /must/ exist in
--     @pVertexBindingDescriptions@ with the same value of @binding@
--
-- -   #VUID-vkCmdSetVertexInputEXT-pVertexBindingDescriptions-04794# All
--     elements of @pVertexBindingDescriptions@ /must/ describe distinct
--     binding numbers
--
-- -   #VUID-vkCmdSetVertexInputEXT-pVertexAttributeDescriptions-04795# All
--     elements of @pVertexAttributeDescriptions@ /must/ describe distinct
--     attribute locations
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdSetVertexInputEXT-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdSetVertexInputEXT-pVertexBindingDescriptions-parameter#
--     If @vertexBindingDescriptionCount@ is not @0@,
--     @pVertexBindingDescriptions@ /must/ be a valid pointer to an array
--     of @vertexBindingDescriptionCount@ valid
--     'VertexInputBindingDescription2EXT' structures
--
-- -   #VUID-vkCmdSetVertexInputEXT-pVertexAttributeDescriptions-parameter#
--     If @vertexAttributeDescriptionCount@ is not @0@,
--     @pVertexAttributeDescriptions@ /must/ be a valid pointer to an array
--     of @vertexAttributeDescriptionCount@ valid
--     'VertexInputAttributeDescription2EXT' structures
--
-- -   #VUID-vkCmdSetVertexInputEXT-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-vkCmdSetVertexInputEXT-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- -   #VUID-vkCmdSetVertexInputEXT-videocoding# This command /must/ only
--     be called outside of a video coding scope
--
-- == Host Synchronization
--
-- -   Host access to @commandBuffer@ /must/ be externally synchronized
--
-- -   Host access to the 'Vulkan.Core10.Handles.CommandPool' that
--     @commandBuffer@ was allocated from /must/ be externally synchronized
--
-- == Command Properties
--
-- \'
--
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
-- | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkCommandBufferLevel Command Buffer Levels> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginRenderPass Render Pass Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginVideoCodingKHR Video Coding Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkQueueFlagBits Supported Queue Types> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-queueoperation-command-types Command Type> |
-- +============================================================================================================================+========================================================================================================================+=============================================================================================================================+=======================================================================================================================+========================================================================================================================================+
-- | Primary                                                                                                                    | Both                                                                                                                   | Outside                                                                                                                     | Graphics                                                                                                              | State                                                                                                                                  |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                             |                                                                                                                       |                                                                                                                                        |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_vertex_input_dynamic_state VK_EXT_vertex_input_dynamic_state>,
-- 'Vulkan.Core10.Handles.CommandBuffer',
-- 'VertexInputAttributeDescription2EXT',
-- 'VertexInputBindingDescription2EXT'
cmdSetVertexInputEXT :: forall io
                      . (MonadIO io)
                     => -- | @commandBuffer@ is the command buffer into which the command will be
                        -- recorded.
                        CommandBuffer
                     -> -- | @pVertexBindingDescriptions@ is a pointer to an array of
                        -- 'VertexInputBindingDescription2EXT' structures.
                        ("vertexBindingDescriptions" ::: Vector VertexInputBindingDescription2EXT)
                     -> -- | @pVertexAttributeDescriptions@ is a pointer to an array of
                        -- 'VertexInputAttributeDescription2EXT' structures.
                        ("vertexAttributeDescriptions" ::: Vector VertexInputAttributeDescription2EXT)
                     -> io ()
cmdSetVertexInputEXT :: forall (io :: * -> *).
MonadIO io =>
CommandBuffer
-> ("vertexBindingDescriptions"
    ::: Vector VertexInputBindingDescription2EXT)
-> ("vertexAttributeDescriptions"
    ::: Vector VertexInputAttributeDescription2EXT)
-> io ()
cmdSetVertexInputEXT CommandBuffer
commandBuffer
                       "vertexBindingDescriptions"
::: Vector VertexInputBindingDescription2EXT
vertexBindingDescriptions
                       "vertexAttributeDescriptions"
::: Vector VertexInputAttributeDescription2EXT
vertexAttributeDescriptions = 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 vkCmdSetVertexInputEXTPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("vertexBindingDescriptionCount" ::: Word32)
   -> ("pVertexBindingDescriptions"
       ::: Ptr VertexInputBindingDescription2EXT)
   -> ("vertexBindingDescriptionCount" ::: Word32)
   -> ("pVertexAttributeDescriptions"
       ::: Ptr VertexInputAttributeDescription2EXT)
   -> IO ())
vkCmdSetVertexInputEXTPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("vertexBindingDescriptionCount" ::: Word32)
      -> ("pVertexBindingDescriptions"
          ::: Ptr VertexInputBindingDescription2EXT)
      -> ("vertexBindingDescriptionCount" ::: Word32)
      -> ("pVertexAttributeDescriptions"
          ::: Ptr VertexInputAttributeDescription2EXT)
      -> IO ())
pVkCmdSetVertexInputEXT (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
   -> ("vertexBindingDescriptionCount" ::: Word32)
   -> ("pVertexBindingDescriptions"
       ::: Ptr VertexInputBindingDescription2EXT)
   -> ("vertexBindingDescriptionCount" ::: Word32)
   -> ("pVertexAttributeDescriptions"
       ::: Ptr VertexInputAttributeDescription2EXT)
   -> IO ())
vkCmdSetVertexInputEXTPtr FunPtr
  (Ptr CommandBuffer_T
   -> ("vertexBindingDescriptionCount" ::: Word32)
   -> ("pVertexBindingDescriptions"
       ::: Ptr VertexInputBindingDescription2EXT)
   -> ("vertexBindingDescriptionCount" ::: Word32)
   -> ("pVertexAttributeDescriptions"
       ::: Ptr VertexInputAttributeDescription2EXT)
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("vertexBindingDescriptionCount" ::: Word32)
      -> ("pVertexBindingDescriptions"
          ::: Ptr VertexInputBindingDescription2EXT)
      -> ("vertexBindingDescriptionCount" ::: Word32)
      -> ("pVertexAttributeDescriptions"
          ::: Ptr VertexInputAttributeDescription2EXT)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("vertexBindingDescriptionCount" ::: Word32)
   -> ("pVertexBindingDescriptions"
       ::: Ptr VertexInputBindingDescription2EXT)
   -> ("vertexBindingDescriptionCount" ::: Word32)
   -> ("pVertexAttributeDescriptions"
       ::: Ptr VertexInputAttributeDescription2EXT)
   -> 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 vkCmdSetVertexInputEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdSetVertexInputEXT' :: Ptr CommandBuffer_T
-> ("vertexBindingDescriptionCount" ::: Word32)
-> ("pVertexBindingDescriptions"
    ::: Ptr VertexInputBindingDescription2EXT)
-> ("vertexBindingDescriptionCount" ::: Word32)
-> ("pVertexAttributeDescriptions"
    ::: Ptr VertexInputAttributeDescription2EXT)
-> IO ()
vkCmdSetVertexInputEXT' = FunPtr
  (Ptr CommandBuffer_T
   -> ("vertexBindingDescriptionCount" ::: Word32)
   -> ("pVertexBindingDescriptions"
       ::: Ptr VertexInputBindingDescription2EXT)
   -> ("vertexBindingDescriptionCount" ::: Word32)
   -> ("pVertexAttributeDescriptions"
       ::: Ptr VertexInputAttributeDescription2EXT)
   -> IO ())
-> Ptr CommandBuffer_T
-> ("vertexBindingDescriptionCount" ::: Word32)
-> ("pVertexBindingDescriptions"
    ::: Ptr VertexInputBindingDescription2EXT)
-> ("vertexBindingDescriptionCount" ::: Word32)
-> ("pVertexAttributeDescriptions"
    ::: Ptr VertexInputAttributeDescription2EXT)
-> IO ()
mkVkCmdSetVertexInputEXT FunPtr
  (Ptr CommandBuffer_T
   -> ("vertexBindingDescriptionCount" ::: Word32)
   -> ("pVertexBindingDescriptions"
       ::: Ptr VertexInputBindingDescription2EXT)
   -> ("vertexBindingDescriptionCount" ::: Word32)
   -> ("pVertexAttributeDescriptions"
       ::: Ptr VertexInputAttributeDescription2EXT)
   -> IO ())
vkCmdSetVertexInputEXTPtr
  "pVertexBindingDescriptions"
::: Ptr VertexInputBindingDescription2EXT
pPVertexBindingDescriptions <- ((("pVertexBindingDescriptions"
   ::: Ptr VertexInputBindingDescription2EXT)
  -> IO ())
 -> IO ())
-> ContT
     ()
     IO
     ("pVertexBindingDescriptions"
      ::: Ptr VertexInputBindingDescription2EXT)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pVertexBindingDescriptions"
    ::: Ptr VertexInputBindingDescription2EXT)
   -> IO ())
  -> IO ())
 -> ContT
      ()
      IO
      ("pVertexBindingDescriptions"
       ::: Ptr VertexInputBindingDescription2EXT))
-> ((("pVertexBindingDescriptions"
      ::: Ptr VertexInputBindingDescription2EXT)
     -> IO ())
    -> IO ())
-> ContT
     ()
     IO
     ("pVertexBindingDescriptions"
      ::: Ptr VertexInputBindingDescription2EXT)
forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @VertexInputBindingDescription2EXT ((("vertexBindingDescriptions"
 ::: Vector VertexInputBindingDescription2EXT)
-> Int
forall a. Vector a -> Int
Data.Vector.length ("vertexBindingDescriptions"
::: Vector VertexInputBindingDescription2EXT
vertexBindingDescriptions)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
32)
  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 -> VertexInputBindingDescription2EXT -> IO ())
-> ("vertexBindingDescriptions"
    ::: Vector VertexInputBindingDescription2EXT)
-> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i VertexInputBindingDescription2EXT
e -> ("pVertexBindingDescriptions"
 ::: Ptr VertexInputBindingDescription2EXT)
-> VertexInputBindingDescription2EXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pVertexBindingDescriptions"
::: Ptr VertexInputBindingDescription2EXT
pPVertexBindingDescriptions ("pVertexBindingDescriptions"
 ::: Ptr VertexInputBindingDescription2EXT)
-> Int
-> "pVertexBindingDescriptions"
   ::: Ptr VertexInputBindingDescription2EXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr VertexInputBindingDescription2EXT) (VertexInputBindingDescription2EXT
e)) ("vertexBindingDescriptions"
::: Vector VertexInputBindingDescription2EXT
vertexBindingDescriptions)
  "pVertexAttributeDescriptions"
::: Ptr VertexInputAttributeDescription2EXT
pPVertexAttributeDescriptions <- ((("pVertexAttributeDescriptions"
   ::: Ptr VertexInputAttributeDescription2EXT)
  -> IO ())
 -> IO ())
-> ContT
     ()
     IO
     ("pVertexAttributeDescriptions"
      ::: Ptr VertexInputAttributeDescription2EXT)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pVertexAttributeDescriptions"
    ::: Ptr VertexInputAttributeDescription2EXT)
   -> IO ())
  -> IO ())
 -> ContT
      ()
      IO
      ("pVertexAttributeDescriptions"
       ::: Ptr VertexInputAttributeDescription2EXT))
-> ((("pVertexAttributeDescriptions"
      ::: Ptr VertexInputAttributeDescription2EXT)
     -> IO ())
    -> IO ())
-> ContT
     ()
     IO
     ("pVertexAttributeDescriptions"
      ::: Ptr VertexInputAttributeDescription2EXT)
forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @VertexInputAttributeDescription2EXT ((("vertexAttributeDescriptions"
 ::: Vector VertexInputAttributeDescription2EXT)
-> Int
forall a. Vector a -> Int
Data.Vector.length ("vertexAttributeDescriptions"
::: Vector VertexInputAttributeDescription2EXT
vertexAttributeDescriptions)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
32)
  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 -> VertexInputAttributeDescription2EXT -> IO ())
-> ("vertexAttributeDescriptions"
    ::: Vector VertexInputAttributeDescription2EXT)
-> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i VertexInputAttributeDescription2EXT
e -> ("pVertexAttributeDescriptions"
 ::: Ptr VertexInputAttributeDescription2EXT)
-> VertexInputAttributeDescription2EXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pVertexAttributeDescriptions"
::: Ptr VertexInputAttributeDescription2EXT
pPVertexAttributeDescriptions ("pVertexAttributeDescriptions"
 ::: Ptr VertexInputAttributeDescription2EXT)
-> Int
-> "pVertexAttributeDescriptions"
   ::: Ptr VertexInputAttributeDescription2EXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr VertexInputAttributeDescription2EXT) (VertexInputAttributeDescription2EXT
e)) ("vertexAttributeDescriptions"
::: Vector VertexInputAttributeDescription2EXT
vertexAttributeDescriptions)
  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
"vkCmdSetVertexInputEXT" (Ptr CommandBuffer_T
-> ("vertexBindingDescriptionCount" ::: Word32)
-> ("pVertexBindingDescriptions"
    ::: Ptr VertexInputBindingDescription2EXT)
-> ("vertexBindingDescriptionCount" ::: Word32)
-> ("pVertexAttributeDescriptions"
    ::: Ptr VertexInputAttributeDescription2EXT)
-> IO ()
vkCmdSetVertexInputEXT'
                                                      (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer))
                                                      ((Int -> "vertexBindingDescriptionCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("vertexBindingDescriptions"
 ::: Vector VertexInputBindingDescription2EXT)
-> Int
forall a. Vector a -> Int
Data.Vector.length (("vertexBindingDescriptions"
  ::: Vector VertexInputBindingDescription2EXT)
 -> Int)
-> ("vertexBindingDescriptions"
    ::: Vector VertexInputBindingDescription2EXT)
-> Int
forall a b. (a -> b) -> a -> b
$ ("vertexBindingDescriptions"
::: Vector VertexInputBindingDescription2EXT
vertexBindingDescriptions)) :: Word32))
                                                      ("pVertexBindingDescriptions"
::: Ptr VertexInputBindingDescription2EXT
pPVertexBindingDescriptions)
                                                      ((Int -> "vertexBindingDescriptionCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("vertexAttributeDescriptions"
 ::: Vector VertexInputAttributeDescription2EXT)
-> Int
forall a. Vector a -> Int
Data.Vector.length (("vertexAttributeDescriptions"
  ::: Vector VertexInputAttributeDescription2EXT)
 -> Int)
-> ("vertexAttributeDescriptions"
    ::: Vector VertexInputAttributeDescription2EXT)
-> Int
forall a b. (a -> b) -> a -> b
$ ("vertexAttributeDescriptions"
::: Vector VertexInputAttributeDescription2EXT
vertexAttributeDescriptions)) :: Word32))
                                                      ("pVertexAttributeDescriptions"
::: Ptr VertexInputAttributeDescription2EXT
pPVertexAttributeDescriptions))
  () -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()


-- | VkPhysicalDeviceVertexInputDynamicStateFeaturesEXT - Structure
-- describing whether the dynamic vertex input state can be used
--
-- = Members
--
-- This structure describes the following feature:
--
-- = Description
--
-- If the 'PhysicalDeviceVertexInputDynamicStateFeaturesEXT' 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. 'PhysicalDeviceVertexInputDynamicStateFeaturesEXT' /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_vertex_input_dynamic_state VK_EXT_vertex_input_dynamic_state>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceVertexInputDynamicStateFeaturesEXT = PhysicalDeviceVertexInputDynamicStateFeaturesEXT
  { -- | #features-vertexInputDynamicState# @vertexInputDynamicState@ indicates
    -- that the implementation supports the following dynamic states:
    --
    -- -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VERTEX_INPUT_EXT'
    PhysicalDeviceVertexInputDynamicStateFeaturesEXT -> Bool
vertexInputDynamicState :: Bool }
  deriving (Typeable, PhysicalDeviceVertexInputDynamicStateFeaturesEXT
-> PhysicalDeviceVertexInputDynamicStateFeaturesEXT -> Bool
(PhysicalDeviceVertexInputDynamicStateFeaturesEXT
 -> PhysicalDeviceVertexInputDynamicStateFeaturesEXT -> Bool)
-> (PhysicalDeviceVertexInputDynamicStateFeaturesEXT
    -> PhysicalDeviceVertexInputDynamicStateFeaturesEXT -> Bool)
-> Eq PhysicalDeviceVertexInputDynamicStateFeaturesEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceVertexInputDynamicStateFeaturesEXT
-> PhysicalDeviceVertexInputDynamicStateFeaturesEXT -> Bool
$c/= :: PhysicalDeviceVertexInputDynamicStateFeaturesEXT
-> PhysicalDeviceVertexInputDynamicStateFeaturesEXT -> Bool
== :: PhysicalDeviceVertexInputDynamicStateFeaturesEXT
-> PhysicalDeviceVertexInputDynamicStateFeaturesEXT -> Bool
$c== :: PhysicalDeviceVertexInputDynamicStateFeaturesEXT
-> PhysicalDeviceVertexInputDynamicStateFeaturesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceVertexInputDynamicStateFeaturesEXT)
#endif
deriving instance Show PhysicalDeviceVertexInputDynamicStateFeaturesEXT

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

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

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

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


-- | VkVertexInputBindingDescription2EXT - Structure specifying the extended
-- vertex input binding description
--
-- == Valid Usage
--
-- -   #VUID-VkVertexInputBindingDescription2EXT-binding-04796# @binding@
--     /must/ be less than
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxVertexInputBindings@
--
-- -   #VUID-VkVertexInputBindingDescription2EXT-stride-04797# @stride@
--     /must/ be less than or equal to
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxVertexInputBindingStride@
--
-- -   #VUID-VkVertexInputBindingDescription2EXT-divisor-04798# If the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-vertexAttributeInstanceRateZeroDivisor vertexAttributeInstanceRateZeroDivisor>
--     feature is not enabled, @divisor@ /must/ not be @0@
--
-- -   #VUID-VkVertexInputBindingDescription2EXT-divisor-04799# If the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-vertexAttributeInstanceRateDivisor vertexAttributeInstanceRateDivisor>
--     feature is not enabled, @divisor@ /must/ be @1@
--
-- -   #VUID-VkVertexInputBindingDescription2EXT-divisor-06226# @divisor@
--     /must/ be a value between @0@ and
--     'Vulkan.Extensions.VK_EXT_vertex_attribute_divisor.PhysicalDeviceVertexAttributeDivisorPropertiesEXT'::@maxVertexAttribDivisor@,
--     inclusive
--
-- -   #VUID-VkVertexInputBindingDescription2EXT-divisor-06227# If
--     @divisor@ is not @1@ then @inputRate@ /must/ be of type
--     'Vulkan.Core10.Enums.VertexInputRate.VERTEX_INPUT_RATE_INSTANCE'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkVertexInputBindingDescription2EXT-sType-sType# @sType@
--     /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_VERTEX_INPUT_BINDING_DESCRIPTION_2_EXT'
--
-- -   #VUID-VkVertexInputBindingDescription2EXT-inputRate-parameter#
--     @inputRate@ /must/ be a valid
--     'Vulkan.Core10.Enums.VertexInputRate.VertexInputRate' value
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_vertex_input_dynamic_state VK_EXT_vertex_input_dynamic_state>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'Vulkan.Core10.Enums.VertexInputRate.VertexInputRate',
-- 'cmdSetVertexInputEXT'
data VertexInputBindingDescription2EXT = VertexInputBindingDescription2EXT
  { -- | @binding@ is the binding number that this structure describes.
    VertexInputBindingDescription2EXT
-> "vertexBindingDescriptionCount" ::: Word32
binding :: Word32
  , -- | @stride@ is the byte stride between consecutive elements within the
    -- buffer.
    VertexInputBindingDescription2EXT
-> "vertexBindingDescriptionCount" ::: Word32
stride :: Word32
  , -- | @inputRate@ is a 'Vulkan.Core10.Enums.VertexInputRate.VertexInputRate'
    -- value specifying whether vertex attribute addressing is a function of
    -- the vertex index or of the instance index.
    VertexInputBindingDescription2EXT -> VertexInputRate
inputRate :: VertexInputRate
  , -- | @divisor@ is the number of successive instances that will use the same
    -- value of the vertex attribute when instanced rendering is enabled. This
    -- member /can/ be set to a value other than @1@ if the
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-vertexAttributeInstanceRateDivisor vertexAttributeInstanceRateDivisor>
    -- feature is enabled. For example, if the divisor is N, the same vertex
    -- attribute will be applied to N successive instances before moving on to
    -- the next vertex attribute. The maximum value of @divisor@ is
    -- implementation-dependent and can be queried using
    -- 'Vulkan.Extensions.VK_EXT_vertex_attribute_divisor.PhysicalDeviceVertexAttributeDivisorPropertiesEXT'::@maxVertexAttribDivisor@.
    -- A value of @0@ /can/ be used for the divisor if the
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-vertexAttributeInstanceRateZeroDivisor vertexAttributeInstanceRateZeroDivisor>
    -- feature is enabled. In this case, the same vertex attribute will be
    -- applied to all instances.
    VertexInputBindingDescription2EXT
-> "vertexBindingDescriptionCount" ::: Word32
divisor :: Word32
  }
  deriving (Typeable, VertexInputBindingDescription2EXT
-> VertexInputBindingDescription2EXT -> Bool
(VertexInputBindingDescription2EXT
 -> VertexInputBindingDescription2EXT -> Bool)
-> (VertexInputBindingDescription2EXT
    -> VertexInputBindingDescription2EXT -> Bool)
-> Eq VertexInputBindingDescription2EXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VertexInputBindingDescription2EXT
-> VertexInputBindingDescription2EXT -> Bool
$c/= :: VertexInputBindingDescription2EXT
-> VertexInputBindingDescription2EXT -> Bool
== :: VertexInputBindingDescription2EXT
-> VertexInputBindingDescription2EXT -> Bool
$c== :: VertexInputBindingDescription2EXT
-> VertexInputBindingDescription2EXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (VertexInputBindingDescription2EXT)
#endif
deriving instance Show VertexInputBindingDescription2EXT

instance ToCStruct VertexInputBindingDescription2EXT where
  withCStruct :: forall b.
VertexInputBindingDescription2EXT
-> (("pVertexBindingDescriptions"
     ::: Ptr VertexInputBindingDescription2EXT)
    -> IO b)
-> IO b
withCStruct VertexInputBindingDescription2EXT
x ("pVertexBindingDescriptions"
 ::: Ptr VertexInputBindingDescription2EXT)
-> IO b
f = Int
-> (("pVertexBindingDescriptions"
     ::: Ptr VertexInputBindingDescription2EXT)
    -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((("pVertexBindingDescriptions"
   ::: Ptr VertexInputBindingDescription2EXT)
  -> IO b)
 -> IO b)
-> (("pVertexBindingDescriptions"
     ::: Ptr VertexInputBindingDescription2EXT)
    -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \"pVertexBindingDescriptions"
::: Ptr VertexInputBindingDescription2EXT
p -> ("pVertexBindingDescriptions"
 ::: Ptr VertexInputBindingDescription2EXT)
-> VertexInputBindingDescription2EXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pVertexBindingDescriptions"
::: Ptr VertexInputBindingDescription2EXT
p VertexInputBindingDescription2EXT
x (("pVertexBindingDescriptions"
 ::: Ptr VertexInputBindingDescription2EXT)
-> IO b
f "pVertexBindingDescriptions"
::: Ptr VertexInputBindingDescription2EXT
p)
  pokeCStruct :: forall b.
("pVertexBindingDescriptions"
 ::: Ptr VertexInputBindingDescription2EXT)
-> VertexInputBindingDescription2EXT -> IO b -> IO b
pokeCStruct "pVertexBindingDescriptions"
::: Ptr VertexInputBindingDescription2EXT
p VertexInputBindingDescription2EXT{"vertexBindingDescriptionCount" ::: Word32
VertexInputRate
divisor :: "vertexBindingDescriptionCount" ::: Word32
inputRate :: VertexInputRate
stride :: "vertexBindingDescriptionCount" ::: Word32
binding :: "vertexBindingDescriptionCount" ::: Word32
$sel:divisor:VertexInputBindingDescription2EXT :: VertexInputBindingDescription2EXT
-> "vertexBindingDescriptionCount" ::: Word32
$sel:inputRate:VertexInputBindingDescription2EXT :: VertexInputBindingDescription2EXT -> VertexInputRate
$sel:stride:VertexInputBindingDescription2EXT :: VertexInputBindingDescription2EXT
-> "vertexBindingDescriptionCount" ::: Word32
$sel:binding:VertexInputBindingDescription2EXT :: VertexInputBindingDescription2EXT
-> "vertexBindingDescriptionCount" ::: Word32
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pVertexBindingDescriptions"
::: Ptr VertexInputBindingDescription2EXT
p ("pVertexBindingDescriptions"
 ::: Ptr VertexInputBindingDescription2EXT)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_VERTEX_INPUT_BINDING_DESCRIPTION_2_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pVertexBindingDescriptions"
::: Ptr VertexInputBindingDescription2EXT
p ("pVertexBindingDescriptions"
 ::: Ptr VertexInputBindingDescription2EXT)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ("vertexBindingDescriptionCount" ::: Word32)
-> ("vertexBindingDescriptionCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pVertexBindingDescriptions"
::: Ptr VertexInputBindingDescription2EXT
p ("pVertexBindingDescriptions"
 ::: Ptr VertexInputBindingDescription2EXT)
-> Int -> Ptr ("vertexBindingDescriptionCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) ("vertexBindingDescriptionCount" ::: Word32
binding)
    Ptr ("vertexBindingDescriptionCount" ::: Word32)
-> ("vertexBindingDescriptionCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pVertexBindingDescriptions"
::: Ptr VertexInputBindingDescription2EXT
p ("pVertexBindingDescriptions"
 ::: Ptr VertexInputBindingDescription2EXT)
-> Int -> Ptr ("vertexBindingDescriptionCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) ("vertexBindingDescriptionCount" ::: Word32
stride)
    Ptr VertexInputRate -> VertexInputRate -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pVertexBindingDescriptions"
::: Ptr VertexInputBindingDescription2EXT
p ("pVertexBindingDescriptions"
 ::: Ptr VertexInputBindingDescription2EXT)
-> Int -> Ptr VertexInputRate
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr VertexInputRate)) (VertexInputRate
inputRate)
    Ptr ("vertexBindingDescriptionCount" ::: Word32)
-> ("vertexBindingDescriptionCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pVertexBindingDescriptions"
::: Ptr VertexInputBindingDescription2EXT
p ("pVertexBindingDescriptions"
 ::: Ptr VertexInputBindingDescription2EXT)
-> Int -> Ptr ("vertexBindingDescriptionCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) ("vertexBindingDescriptionCount" ::: Word32
divisor)
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pVertexBindingDescriptions"
 ::: Ptr VertexInputBindingDescription2EXT)
-> IO b -> IO b
pokeZeroCStruct "pVertexBindingDescriptions"
::: Ptr VertexInputBindingDescription2EXT
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pVertexBindingDescriptions"
::: Ptr VertexInputBindingDescription2EXT
p ("pVertexBindingDescriptions"
 ::: Ptr VertexInputBindingDescription2EXT)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_VERTEX_INPUT_BINDING_DESCRIPTION_2_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pVertexBindingDescriptions"
::: Ptr VertexInputBindingDescription2EXT
p ("pVertexBindingDescriptions"
 ::: Ptr VertexInputBindingDescription2EXT)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ("vertexBindingDescriptionCount" ::: Word32)
-> ("vertexBindingDescriptionCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pVertexBindingDescriptions"
::: Ptr VertexInputBindingDescription2EXT
p ("pVertexBindingDescriptions"
 ::: Ptr VertexInputBindingDescription2EXT)
-> Int -> Ptr ("vertexBindingDescriptionCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) ("vertexBindingDescriptionCount" ::: Word32
forall a. Zero a => a
zero)
    Ptr ("vertexBindingDescriptionCount" ::: Word32)
-> ("vertexBindingDescriptionCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pVertexBindingDescriptions"
::: Ptr VertexInputBindingDescription2EXT
p ("pVertexBindingDescriptions"
 ::: Ptr VertexInputBindingDescription2EXT)
-> Int -> Ptr ("vertexBindingDescriptionCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) ("vertexBindingDescriptionCount" ::: Word32
forall a. Zero a => a
zero)
    Ptr VertexInputRate -> VertexInputRate -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pVertexBindingDescriptions"
::: Ptr VertexInputBindingDescription2EXT
p ("pVertexBindingDescriptions"
 ::: Ptr VertexInputBindingDescription2EXT)
-> Int -> Ptr VertexInputRate
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr VertexInputRate)) (VertexInputRate
forall a. Zero a => a
zero)
    Ptr ("vertexBindingDescriptionCount" ::: Word32)
-> ("vertexBindingDescriptionCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pVertexBindingDescriptions"
::: Ptr VertexInputBindingDescription2EXT
p ("pVertexBindingDescriptions"
 ::: Ptr VertexInputBindingDescription2EXT)
-> Int -> Ptr ("vertexBindingDescriptionCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) ("vertexBindingDescriptionCount" ::: Word32
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct VertexInputBindingDescription2EXT where
  peekCStruct :: ("pVertexBindingDescriptions"
 ::: Ptr VertexInputBindingDescription2EXT)
-> IO VertexInputBindingDescription2EXT
peekCStruct "pVertexBindingDescriptions"
::: Ptr VertexInputBindingDescription2EXT
p = do
    "vertexBindingDescriptionCount" ::: Word32
binding <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pVertexBindingDescriptions"
::: Ptr VertexInputBindingDescription2EXT
p ("pVertexBindingDescriptions"
 ::: Ptr VertexInputBindingDescription2EXT)
-> Int -> Ptr ("vertexBindingDescriptionCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    "vertexBindingDescriptionCount" ::: Word32
stride <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pVertexBindingDescriptions"
::: Ptr VertexInputBindingDescription2EXT
p ("pVertexBindingDescriptions"
 ::: Ptr VertexInputBindingDescription2EXT)
-> Int -> Ptr ("vertexBindingDescriptionCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
    VertexInputRate
inputRate <- forall a. Storable a => Ptr a -> IO a
peek @VertexInputRate (("pVertexBindingDescriptions"
::: Ptr VertexInputBindingDescription2EXT
p ("pVertexBindingDescriptions"
 ::: Ptr VertexInputBindingDescription2EXT)
-> Int -> Ptr VertexInputRate
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr VertexInputRate))
    "vertexBindingDescriptionCount" ::: Word32
divisor <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pVertexBindingDescriptions"
::: Ptr VertexInputBindingDescription2EXT
p ("pVertexBindingDescriptions"
 ::: Ptr VertexInputBindingDescription2EXT)
-> Int -> Ptr ("vertexBindingDescriptionCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32))
    VertexInputBindingDescription2EXT
-> IO VertexInputBindingDescription2EXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VertexInputBindingDescription2EXT
 -> IO VertexInputBindingDescription2EXT)
-> VertexInputBindingDescription2EXT
-> IO VertexInputBindingDescription2EXT
forall a b. (a -> b) -> a -> b
$ ("vertexBindingDescriptionCount" ::: Word32)
-> ("vertexBindingDescriptionCount" ::: Word32)
-> VertexInputRate
-> ("vertexBindingDescriptionCount" ::: Word32)
-> VertexInputBindingDescription2EXT
VertexInputBindingDescription2EXT
             "vertexBindingDescriptionCount" ::: Word32
binding "vertexBindingDescriptionCount" ::: Word32
stride VertexInputRate
inputRate "vertexBindingDescriptionCount" ::: Word32
divisor

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

instance Zero VertexInputBindingDescription2EXT where
  zero :: VertexInputBindingDescription2EXT
zero = ("vertexBindingDescriptionCount" ::: Word32)
-> ("vertexBindingDescriptionCount" ::: Word32)
-> VertexInputRate
-> ("vertexBindingDescriptionCount" ::: Word32)
-> VertexInputBindingDescription2EXT
VertexInputBindingDescription2EXT
           "vertexBindingDescriptionCount" ::: Word32
forall a. Zero a => a
zero
           "vertexBindingDescriptionCount" ::: Word32
forall a. Zero a => a
zero
           VertexInputRate
forall a. Zero a => a
zero
           "vertexBindingDescriptionCount" ::: Word32
forall a. Zero a => a
zero


-- | VkVertexInputAttributeDescription2EXT - Structure specifying the
-- extended vertex input attribute description
--
-- == Valid Usage
--
-- -   #VUID-VkVertexInputAttributeDescription2EXT-location-06228#
--     @location@ /must/ be less than
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxVertexInputAttributes@
--
-- -   #VUID-VkVertexInputAttributeDescription2EXT-binding-06229# @binding@
--     /must/ be less than
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxVertexInputBindings@
--
-- -   #VUID-VkVertexInputAttributeDescription2EXT-offset-06230# @offset@
--     /must/ be less than or equal to
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxVertexInputAttributeOffset@
--
-- -   #VUID-VkVertexInputAttributeDescription2EXT-format-04805# @format@
--     /must/ be allowed as a vertex buffer format, as specified by the
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_VERTEX_BUFFER_BIT'
--     flag in
--     'Vulkan.Core10.DeviceInitialization.FormatProperties'::@bufferFeatures@
--     returned by
--     'Vulkan.Core10.DeviceInitialization.getPhysicalDeviceFormatProperties'
--
-- -   #VUID-VkVertexInputAttributeDescription2EXT-vertexAttributeAccessBeyondStride-04806#
--     If the @VK_KHR_portability_subset@ extension is enabled, and
--     'Vulkan.Extensions.VK_KHR_portability_subset.PhysicalDevicePortabilitySubsetFeaturesKHR'::@vertexAttributeAccessBeyondStride@
--     is 'Vulkan.Core10.FundamentalTypes.FALSE', the sum of @offset@ plus
--     the size of the vertex attribute data described by @format@ /must/
--     not be greater than @stride@ in the
--     'VertexInputBindingDescription2EXT' referenced in @binding@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkVertexInputAttributeDescription2EXT-sType-sType# @sType@
--     /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_VERTEX_INPUT_ATTRIBUTE_DESCRIPTION_2_EXT'
--
-- -   #VUID-VkVertexInputAttributeDescription2EXT-format-parameter#
--     @format@ /must/ be a valid 'Vulkan.Core10.Enums.Format.Format' value
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_vertex_input_dynamic_state VK_EXT_vertex_input_dynamic_state>,
-- 'Vulkan.Core10.Enums.Format.Format',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'cmdSetVertexInputEXT'
data VertexInputAttributeDescription2EXT = VertexInputAttributeDescription2EXT
  { -- | @location@ is the shader input location number for this attribute.
    VertexInputAttributeDescription2EXT
-> "vertexBindingDescriptionCount" ::: Word32
location :: Word32
  , -- | @binding@ is the binding number which this attribute takes its data
    -- from.
    VertexInputAttributeDescription2EXT
-> "vertexBindingDescriptionCount" ::: Word32
binding :: Word32
  , -- | @format@ is the size and type of the vertex attribute data.
    VertexInputAttributeDescription2EXT -> Format
format :: Format
  , -- | @offset@ is a byte offset of this attribute relative to the start of an
    -- element in the vertex input binding.
    VertexInputAttributeDescription2EXT
-> "vertexBindingDescriptionCount" ::: Word32
offset :: Word32
  }
  deriving (Typeable, VertexInputAttributeDescription2EXT
-> VertexInputAttributeDescription2EXT -> Bool
(VertexInputAttributeDescription2EXT
 -> VertexInputAttributeDescription2EXT -> Bool)
-> (VertexInputAttributeDescription2EXT
    -> VertexInputAttributeDescription2EXT -> Bool)
-> Eq VertexInputAttributeDescription2EXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VertexInputAttributeDescription2EXT
-> VertexInputAttributeDescription2EXT -> Bool
$c/= :: VertexInputAttributeDescription2EXT
-> VertexInputAttributeDescription2EXT -> Bool
== :: VertexInputAttributeDescription2EXT
-> VertexInputAttributeDescription2EXT -> Bool
$c== :: VertexInputAttributeDescription2EXT
-> VertexInputAttributeDescription2EXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (VertexInputAttributeDescription2EXT)
#endif
deriving instance Show VertexInputAttributeDescription2EXT

instance ToCStruct VertexInputAttributeDescription2EXT where
  withCStruct :: forall b.
VertexInputAttributeDescription2EXT
-> (("pVertexAttributeDescriptions"
     ::: Ptr VertexInputAttributeDescription2EXT)
    -> IO b)
-> IO b
withCStruct VertexInputAttributeDescription2EXT
x ("pVertexAttributeDescriptions"
 ::: Ptr VertexInputAttributeDescription2EXT)
-> IO b
f = Int
-> (("pVertexAttributeDescriptions"
     ::: Ptr VertexInputAttributeDescription2EXT)
    -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((("pVertexAttributeDescriptions"
   ::: Ptr VertexInputAttributeDescription2EXT)
  -> IO b)
 -> IO b)
-> (("pVertexAttributeDescriptions"
     ::: Ptr VertexInputAttributeDescription2EXT)
    -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \"pVertexAttributeDescriptions"
::: Ptr VertexInputAttributeDescription2EXT
p -> ("pVertexAttributeDescriptions"
 ::: Ptr VertexInputAttributeDescription2EXT)
-> VertexInputAttributeDescription2EXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pVertexAttributeDescriptions"
::: Ptr VertexInputAttributeDescription2EXT
p VertexInputAttributeDescription2EXT
x (("pVertexAttributeDescriptions"
 ::: Ptr VertexInputAttributeDescription2EXT)
-> IO b
f "pVertexAttributeDescriptions"
::: Ptr VertexInputAttributeDescription2EXT
p)
  pokeCStruct :: forall b.
("pVertexAttributeDescriptions"
 ::: Ptr VertexInputAttributeDescription2EXT)
-> VertexInputAttributeDescription2EXT -> IO b -> IO b
pokeCStruct "pVertexAttributeDescriptions"
::: Ptr VertexInputAttributeDescription2EXT
p VertexInputAttributeDescription2EXT{"vertexBindingDescriptionCount" ::: Word32
Format
offset :: "vertexBindingDescriptionCount" ::: Word32
format :: Format
binding :: "vertexBindingDescriptionCount" ::: Word32
location :: "vertexBindingDescriptionCount" ::: Word32
$sel:offset:VertexInputAttributeDescription2EXT :: VertexInputAttributeDescription2EXT
-> "vertexBindingDescriptionCount" ::: Word32
$sel:format:VertexInputAttributeDescription2EXT :: VertexInputAttributeDescription2EXT -> Format
$sel:binding:VertexInputAttributeDescription2EXT :: VertexInputAttributeDescription2EXT
-> "vertexBindingDescriptionCount" ::: Word32
$sel:location:VertexInputAttributeDescription2EXT :: VertexInputAttributeDescription2EXT
-> "vertexBindingDescriptionCount" ::: Word32
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pVertexAttributeDescriptions"
::: Ptr VertexInputAttributeDescription2EXT
p ("pVertexAttributeDescriptions"
 ::: Ptr VertexInputAttributeDescription2EXT)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_VERTEX_INPUT_ATTRIBUTE_DESCRIPTION_2_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pVertexAttributeDescriptions"
::: Ptr VertexInputAttributeDescription2EXT
p ("pVertexAttributeDescriptions"
 ::: Ptr VertexInputAttributeDescription2EXT)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ("vertexBindingDescriptionCount" ::: Word32)
-> ("vertexBindingDescriptionCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pVertexAttributeDescriptions"
::: Ptr VertexInputAttributeDescription2EXT
p ("pVertexAttributeDescriptions"
 ::: Ptr VertexInputAttributeDescription2EXT)
-> Int -> Ptr ("vertexBindingDescriptionCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) ("vertexBindingDescriptionCount" ::: Word32
location)
    Ptr ("vertexBindingDescriptionCount" ::: Word32)
-> ("vertexBindingDescriptionCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pVertexAttributeDescriptions"
::: Ptr VertexInputAttributeDescription2EXT
p ("pVertexAttributeDescriptions"
 ::: Ptr VertexInputAttributeDescription2EXT)
-> Int -> Ptr ("vertexBindingDescriptionCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) ("vertexBindingDescriptionCount" ::: Word32
binding)
    Ptr Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pVertexAttributeDescriptions"
::: Ptr VertexInputAttributeDescription2EXT
p ("pVertexAttributeDescriptions"
 ::: Ptr VertexInputAttributeDescription2EXT)
-> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Format)) (Format
format)
    Ptr ("vertexBindingDescriptionCount" ::: Word32)
-> ("vertexBindingDescriptionCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pVertexAttributeDescriptions"
::: Ptr VertexInputAttributeDescription2EXT
p ("pVertexAttributeDescriptions"
 ::: Ptr VertexInputAttributeDescription2EXT)
-> Int -> Ptr ("vertexBindingDescriptionCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) ("vertexBindingDescriptionCount" ::: Word32
offset)
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pVertexAttributeDescriptions"
 ::: Ptr VertexInputAttributeDescription2EXT)
-> IO b -> IO b
pokeZeroCStruct "pVertexAttributeDescriptions"
::: Ptr VertexInputAttributeDescription2EXT
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pVertexAttributeDescriptions"
::: Ptr VertexInputAttributeDescription2EXT
p ("pVertexAttributeDescriptions"
 ::: Ptr VertexInputAttributeDescription2EXT)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_VERTEX_INPUT_ATTRIBUTE_DESCRIPTION_2_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pVertexAttributeDescriptions"
::: Ptr VertexInputAttributeDescription2EXT
p ("pVertexAttributeDescriptions"
 ::: Ptr VertexInputAttributeDescription2EXT)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ("vertexBindingDescriptionCount" ::: Word32)
-> ("vertexBindingDescriptionCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pVertexAttributeDescriptions"
::: Ptr VertexInputAttributeDescription2EXT
p ("pVertexAttributeDescriptions"
 ::: Ptr VertexInputAttributeDescription2EXT)
-> Int -> Ptr ("vertexBindingDescriptionCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) ("vertexBindingDescriptionCount" ::: Word32
forall a. Zero a => a
zero)
    Ptr ("vertexBindingDescriptionCount" ::: Word32)
-> ("vertexBindingDescriptionCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pVertexAttributeDescriptions"
::: Ptr VertexInputAttributeDescription2EXT
p ("pVertexAttributeDescriptions"
 ::: Ptr VertexInputAttributeDescription2EXT)
-> Int -> Ptr ("vertexBindingDescriptionCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) ("vertexBindingDescriptionCount" ::: Word32
forall a. Zero a => a
zero)
    Ptr Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pVertexAttributeDescriptions"
::: Ptr VertexInputAttributeDescription2EXT
p ("pVertexAttributeDescriptions"
 ::: Ptr VertexInputAttributeDescription2EXT)
-> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Format)) (Format
forall a. Zero a => a
zero)
    Ptr ("vertexBindingDescriptionCount" ::: Word32)
-> ("vertexBindingDescriptionCount" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pVertexAttributeDescriptions"
::: Ptr VertexInputAttributeDescription2EXT
p ("pVertexAttributeDescriptions"
 ::: Ptr VertexInputAttributeDescription2EXT)
-> Int -> Ptr ("vertexBindingDescriptionCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) ("vertexBindingDescriptionCount" ::: Word32
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct VertexInputAttributeDescription2EXT where
  peekCStruct :: ("pVertexAttributeDescriptions"
 ::: Ptr VertexInputAttributeDescription2EXT)
-> IO VertexInputAttributeDescription2EXT
peekCStruct "pVertexAttributeDescriptions"
::: Ptr VertexInputAttributeDescription2EXT
p = do
    "vertexBindingDescriptionCount" ::: Word32
location <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pVertexAttributeDescriptions"
::: Ptr VertexInputAttributeDescription2EXT
p ("pVertexAttributeDescriptions"
 ::: Ptr VertexInputAttributeDescription2EXT)
-> Int -> Ptr ("vertexBindingDescriptionCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    "vertexBindingDescriptionCount" ::: Word32
binding <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pVertexAttributeDescriptions"
::: Ptr VertexInputAttributeDescription2EXT
p ("pVertexAttributeDescriptions"
 ::: Ptr VertexInputAttributeDescription2EXT)
-> Int -> Ptr ("vertexBindingDescriptionCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
    Format
format <- forall a. Storable a => Ptr a -> IO a
peek @Format (("pVertexAttributeDescriptions"
::: Ptr VertexInputAttributeDescription2EXT
p ("pVertexAttributeDescriptions"
 ::: Ptr VertexInputAttributeDescription2EXT)
-> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Format))
    "vertexBindingDescriptionCount" ::: Word32
offset <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pVertexAttributeDescriptions"
::: Ptr VertexInputAttributeDescription2EXT
p ("pVertexAttributeDescriptions"
 ::: Ptr VertexInputAttributeDescription2EXT)
-> Int -> Ptr ("vertexBindingDescriptionCount" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32))
    VertexInputAttributeDescription2EXT
-> IO VertexInputAttributeDescription2EXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VertexInputAttributeDescription2EXT
 -> IO VertexInputAttributeDescription2EXT)
-> VertexInputAttributeDescription2EXT
-> IO VertexInputAttributeDescription2EXT
forall a b. (a -> b) -> a -> b
$ ("vertexBindingDescriptionCount" ::: Word32)
-> ("vertexBindingDescriptionCount" ::: Word32)
-> Format
-> ("vertexBindingDescriptionCount" ::: Word32)
-> VertexInputAttributeDescription2EXT
VertexInputAttributeDescription2EXT
             "vertexBindingDescriptionCount" ::: Word32
location "vertexBindingDescriptionCount" ::: Word32
binding Format
format "vertexBindingDescriptionCount" ::: Word32
offset

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

instance Zero VertexInputAttributeDescription2EXT where
  zero :: VertexInputAttributeDescription2EXT
zero = ("vertexBindingDescriptionCount" ::: Word32)
-> ("vertexBindingDescriptionCount" ::: Word32)
-> Format
-> ("vertexBindingDescriptionCount" ::: Word32)
-> VertexInputAttributeDescription2EXT
VertexInputAttributeDescription2EXT
           "vertexBindingDescriptionCount" ::: Word32
forall a. Zero a => a
zero
           "vertexBindingDescriptionCount" ::: Word32
forall a. Zero a => a
zero
           Format
forall a. Zero a => a
zero
           "vertexBindingDescriptionCount" ::: Word32
forall a. Zero a => a
zero


type EXT_VERTEX_INPUT_DYNAMIC_STATE_SPEC_VERSION = 2

-- No documentation found for TopLevel "VK_EXT_VERTEX_INPUT_DYNAMIC_STATE_SPEC_VERSION"
pattern EXT_VERTEX_INPUT_DYNAMIC_STATE_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_VERTEX_INPUT_DYNAMIC_STATE_SPEC_VERSION :: forall a. Integral a => a
$mEXT_VERTEX_INPUT_DYNAMIC_STATE_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> (Void# -> r) -> (Void# -> r) -> r
EXT_VERTEX_INPUT_DYNAMIC_STATE_SPEC_VERSION = 2


type EXT_VERTEX_INPUT_DYNAMIC_STATE_EXTENSION_NAME = "VK_EXT_vertex_input_dynamic_state"

-- No documentation found for TopLevel "VK_EXT_VERTEX_INPUT_DYNAMIC_STATE_EXTENSION_NAME"
pattern EXT_VERTEX_INPUT_DYNAMIC_STATE_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_VERTEX_INPUT_DYNAMIC_STATE_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mEXT_VERTEX_INPUT_DYNAMIC_STATE_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
EXT_VERTEX_INPUT_DYNAMIC_STATE_EXTENSION_NAME = "VK_EXT_vertex_input_dynamic_state"