{-# language CPP #-}
-- | = Name
--
-- VK_EXT_extended_dynamic_state - device extension
--
-- == VK_EXT_extended_dynamic_state
--
-- [__Name String__]
--     @VK_EXT_extended_dynamic_state@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     268
--
-- [__Revision__]
--     1
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires Vulkan 1.0
--
--     -   Requires @VK_KHR_get_physical_device_properties2@
--
-- [__Contact__]
--
--     -   Piers Daniell
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_EXT_extended_dynamic_state] @pdaniell-nv%0A<<Here describe the issue or question you have about the VK_EXT_extended_dynamic_state extension>> >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2019-12-09
--
-- [__IP Status__]
--     No known IP claims.
--
-- [__Contributors__]
--
--     -   Dan Ginsburg, Valve Corporation
--
--     -   Graeme Leese, Broadcom
--
--     -   Hans-Kristian Arntzen, Valve Corporation
--
--     -   Jan-Harald Fredriksen, Arm Limited
--
--     -   Jason Ekstrand, Intel
--
--     -   Jeff Bolz, NVIDIA
--
--     -   Jesse Hall, Google
--
--     -   Philip Rebohle, Valve Corporation
--
--     -   Stuart Smith, Imagination Technologies
--
--     -   Tobias Hector, AMD
--
-- == Description
--
-- This extension adds some more dynamic state to support applications that
-- need to reduce the number of pipeline state objects they compile and
-- bind.
--
-- == New Commands
--
-- -   'cmdBindVertexBuffers2EXT'
--
-- -   'cmdSetCullModeEXT'
--
-- -   'cmdSetDepthBoundsTestEnableEXT'
--
-- -   'cmdSetDepthCompareOpEXT'
--
-- -   'cmdSetDepthTestEnableEXT'
--
-- -   'cmdSetDepthWriteEnableEXT'
--
-- -   'cmdSetFrontFaceEXT'
--
-- -   'cmdSetPrimitiveTopologyEXT'
--
-- -   'cmdSetScissorWithCountEXT'
--
-- -   'cmdSetStencilOpEXT'
--
-- -   'cmdSetStencilTestEnableEXT'
--
-- -   'cmdSetViewportWithCountEXT'
--
-- == New Structures
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDeviceExtendedDynamicStateFeaturesEXT'
--
-- == New Enum Constants
--
-- -   'EXT_EXTENDED_DYNAMIC_STATE_EXTENSION_NAME'
--
-- -   'EXT_EXTENDED_DYNAMIC_STATE_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.DynamicState.DynamicState':
--
--     -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_CULL_MODE_EXT'
--
--     -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_DEPTH_BOUNDS_TEST_ENABLE_EXT'
--
--     -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_DEPTH_COMPARE_OP_EXT'
--
--     -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_DEPTH_TEST_ENABLE_EXT'
--
--     -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_DEPTH_WRITE_ENABLE_EXT'
--
--     -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_FRONT_FACE_EXT'
--
--     -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_PRIMITIVE_TOPOLOGY_EXT'
--
--     -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_SCISSOR_WITH_COUNT_EXT'
--
--     -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_STENCIL_OP_EXT'
--
--     -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_STENCIL_TEST_ENABLE_EXT'
--
--     -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VERTEX_INPUT_BINDING_STRIDE_EXT'
--
--     -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VIEWPORT_WITH_COUNT_EXT'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_EXTENDED_DYNAMIC_STATE_FEATURES_EXT'
--
-- == Version History
--
-- -   Revision 1, 2019-12-09 (Piers Daniell)
--
--     -   Internal revisions
--
-- == See Also
--
-- 'PhysicalDeviceExtendedDynamicStateFeaturesEXT',
-- 'cmdBindVertexBuffers2EXT', 'cmdSetCullModeEXT',
-- 'cmdSetDepthBoundsTestEnableEXT', 'cmdSetDepthCompareOpEXT',
-- 'cmdSetDepthTestEnableEXT', 'cmdSetDepthWriteEnableEXT',
-- 'cmdSetFrontFaceEXT', 'cmdSetPrimitiveTopologyEXT',
-- 'cmdSetScissorWithCountEXT', 'cmdSetStencilOpEXT',
-- 'cmdSetStencilTestEnableEXT', 'cmdSetViewportWithCountEXT'
--
-- == Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_extended_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_extended_dynamic_state  ( cmdSetCullModeEXT
                                                        , cmdSetFrontFaceEXT
                                                        , cmdSetPrimitiveTopologyEXT
                                                        , cmdSetViewportWithCountEXT
                                                        , cmdSetScissorWithCountEXT
                                                        , cmdBindVertexBuffers2EXT
                                                        , cmdSetDepthTestEnableEXT
                                                        , cmdSetDepthWriteEnableEXT
                                                        , cmdSetDepthCompareOpEXT
                                                        , cmdSetDepthBoundsTestEnableEXT
                                                        , cmdSetStencilTestEnableEXT
                                                        , cmdSetStencilOpEXT
                                                        , PhysicalDeviceExtendedDynamicStateFeaturesEXT(..)
                                                        , EXT_EXTENDED_DYNAMIC_STATE_SPEC_VERSION
                                                        , pattern EXT_EXTENDED_DYNAMIC_STATE_SPEC_VERSION
                                                        , EXT_EXTENDED_DYNAMIC_STATE_EXTENSION_NAME
                                                        , pattern EXT_EXTENDED_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 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 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.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.Core10.Enums.CompareOp (CompareOp)
import Vulkan.Core10.Enums.CompareOp (CompareOp(..))
import Vulkan.Core10.Enums.CullModeFlagBits (CullModeFlagBits(..))
import Vulkan.Core10.Enums.CullModeFlagBits (CullModeFlags)
import Vulkan.Dynamic (DeviceCmds(pVkCmdBindVertexBuffers2EXT))
import Vulkan.Dynamic (DeviceCmds(pVkCmdSetCullModeEXT))
import Vulkan.Dynamic (DeviceCmds(pVkCmdSetDepthBoundsTestEnableEXT))
import Vulkan.Dynamic (DeviceCmds(pVkCmdSetDepthCompareOpEXT))
import Vulkan.Dynamic (DeviceCmds(pVkCmdSetDepthTestEnableEXT))
import Vulkan.Dynamic (DeviceCmds(pVkCmdSetDepthWriteEnableEXT))
import Vulkan.Dynamic (DeviceCmds(pVkCmdSetFrontFaceEXT))
import Vulkan.Dynamic (DeviceCmds(pVkCmdSetPrimitiveTopologyEXT))
import Vulkan.Dynamic (DeviceCmds(pVkCmdSetScissorWithCountEXT))
import Vulkan.Dynamic (DeviceCmds(pVkCmdSetStencilOpEXT))
import Vulkan.Dynamic (DeviceCmds(pVkCmdSetStencilTestEnableEXT))
import Vulkan.Dynamic (DeviceCmds(pVkCmdSetViewportWithCountEXT))
import Vulkan.Core10.FundamentalTypes (DeviceSize)
import Vulkan.Core10.Enums.FrontFace (FrontFace)
import Vulkan.Core10.Enums.FrontFace (FrontFace(..))
import Vulkan.Core10.Enums.PrimitiveTopology (PrimitiveTopology)
import Vulkan.Core10.Enums.PrimitiveTopology (PrimitiveTopology(..))
import Vulkan.Core10.FundamentalTypes (Rect2D)
import Vulkan.Core10.Enums.StencilFaceFlagBits (StencilFaceFlagBits(..))
import Vulkan.Core10.Enums.StencilFaceFlagBits (StencilFaceFlags)
import Vulkan.Core10.Enums.StencilOp (StencilOp)
import Vulkan.Core10.Enums.StencilOp (StencilOp(..))
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Pipeline (Viewport)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_EXTENDED_DYNAMIC_STATE_FEATURES_EXT))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdSetCullModeEXT
  :: FunPtr (Ptr CommandBuffer_T -> CullModeFlags -> IO ()) -> Ptr CommandBuffer_T -> CullModeFlags -> IO ()

-- | vkCmdSetCullModeEXT - Set cull mode dynamically for a command buffer
--
-- = Description
--
-- This command sets the cull mode for subsequent drawing commands when the
-- graphics pipeline is created with
-- 'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_CULL_MODE_EXT' set in
-- 'Vulkan.Core10.Pipeline.PipelineDynamicStateCreateInfo'::@pDynamicStates@.
-- Otherwise, this state is specified by the
-- 'Vulkan.Core10.Pipeline.PipelineRasterizationStateCreateInfo'::@cullMode@
-- value used to create the currently active pipeline.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdSetCullModeEXT-None-03384# The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-extendedDynamicState extendedDynamicState>
--     feature /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdSetCullModeEXT-commandBuffer-parameter# @commandBuffer@
--     /must/ be a valid 'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdSetCullModeEXT-cullMode-parameter# @cullMode@ /must/ be a
--     valid combination of
--     'Vulkan.Core10.Enums.CullModeFlagBits.CullModeFlagBits' values
--
-- -   #VUID-vkCmdSetCullModeEXT-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-vkCmdSetCullModeEXT-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- == 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_extended_dynamic_state VK_EXT_extended_dynamic_state>,
-- 'Vulkan.Core10.Handles.CommandBuffer',
-- 'Vulkan.Core10.Enums.CullModeFlagBits.CullModeFlags'
cmdSetCullModeEXT :: forall io
                   . (MonadIO io)
                  => -- | @commandBuffer@ is the command buffer into which the command will be
                     -- recorded.
                     CommandBuffer
                  -> -- | @cullMode@ specifies the cull mode property to use for drawing.
                     CullModeFlags
                  -> io ()
cmdSetCullModeEXT :: CommandBuffer -> CullModeFlags -> io ()
cmdSetCullModeEXT CommandBuffer
commandBuffer CullModeFlags
cullMode = 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 vkCmdSetCullModeEXTPtr :: FunPtr (Ptr CommandBuffer_T -> CullModeFlags -> IO ())
vkCmdSetCullModeEXTPtr = DeviceCmds
-> FunPtr (Ptr CommandBuffer_T -> CullModeFlags -> IO ())
pVkCmdSetCullModeEXT (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr (Ptr CommandBuffer_T -> CullModeFlags -> IO ())
vkCmdSetCullModeEXTPtr FunPtr (Ptr CommandBuffer_T -> CullModeFlags -> IO ())
-> FunPtr (Ptr CommandBuffer_T -> CullModeFlags -> IO ()) -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr (Ptr CommandBuffer_T -> CullModeFlags -> 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 vkCmdSetCullModeEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdSetCullModeEXT' :: Ptr CommandBuffer_T -> CullModeFlags -> IO ()
vkCmdSetCullModeEXT' = FunPtr (Ptr CommandBuffer_T -> CullModeFlags -> IO ())
-> Ptr CommandBuffer_T -> CullModeFlags -> IO ()
mkVkCmdSetCullModeEXT FunPtr (Ptr CommandBuffer_T -> CullModeFlags -> IO ())
vkCmdSetCullModeEXTPtr
  String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdSetCullModeEXT" (Ptr CommandBuffer_T -> CullModeFlags -> IO ()
vkCmdSetCullModeEXT' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) (CullModeFlags
cullMode))
  () -> 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" mkVkCmdSetFrontFaceEXT
  :: FunPtr (Ptr CommandBuffer_T -> FrontFace -> IO ()) -> Ptr CommandBuffer_T -> FrontFace -> IO ()

-- | vkCmdSetFrontFaceEXT - Set front face orientation dynamically for a
-- command buffer
--
-- = Description
--
-- This command sets the front face orientation for subsequent drawing
-- commands when the graphics pipeline is created with
-- 'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_FRONT_FACE_EXT' set in
-- 'Vulkan.Core10.Pipeline.PipelineDynamicStateCreateInfo'::@pDynamicStates@.
-- Otherwise, this state is specified by the
-- 'Vulkan.Core10.Pipeline.PipelineRasterizationStateCreateInfo'::@frontFace@
-- value used to create the currently active pipeline.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdSetFrontFaceEXT-None-03383# The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-extendedDynamicState extendedDynamicState>
--     feature /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdSetFrontFaceEXT-commandBuffer-parameter# @commandBuffer@
--     /must/ be a valid 'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdSetFrontFaceEXT-frontFace-parameter# @frontFace@ /must/
--     be a valid 'Vulkan.Core10.Enums.FrontFace.FrontFace' value
--
-- -   #VUID-vkCmdSetFrontFaceEXT-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-vkCmdSetFrontFaceEXT-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- == 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_extended_dynamic_state VK_EXT_extended_dynamic_state>,
-- 'Vulkan.Core10.Handles.CommandBuffer',
-- 'Vulkan.Core10.Enums.FrontFace.FrontFace'
cmdSetFrontFaceEXT :: forall io
                    . (MonadIO io)
                   => -- | @commandBuffer@ is the command buffer into which the command will be
                      -- recorded.
                      CommandBuffer
                   -> -- | @frontFace@ is a 'Vulkan.Core10.Enums.FrontFace.FrontFace' value
                      -- specifying the front-facing triangle orientation to be used for culling.
                      FrontFace
                   -> io ()
cmdSetFrontFaceEXT :: CommandBuffer -> FrontFace -> io ()
cmdSetFrontFaceEXT CommandBuffer
commandBuffer FrontFace
frontFace = 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 vkCmdSetFrontFaceEXTPtr :: FunPtr (Ptr CommandBuffer_T -> FrontFace -> IO ())
vkCmdSetFrontFaceEXTPtr = DeviceCmds -> FunPtr (Ptr CommandBuffer_T -> FrontFace -> IO ())
pVkCmdSetFrontFaceEXT (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 -> FrontFace -> IO ())
vkCmdSetFrontFaceEXTPtr FunPtr (Ptr CommandBuffer_T -> FrontFace -> IO ())
-> FunPtr (Ptr CommandBuffer_T -> FrontFace -> IO ()) -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr (Ptr CommandBuffer_T -> FrontFace -> 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 vkCmdSetFrontFaceEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdSetFrontFaceEXT' :: Ptr CommandBuffer_T -> FrontFace -> IO ()
vkCmdSetFrontFaceEXT' = FunPtr (Ptr CommandBuffer_T -> FrontFace -> IO ())
-> Ptr CommandBuffer_T -> FrontFace -> IO ()
mkVkCmdSetFrontFaceEXT FunPtr (Ptr CommandBuffer_T -> FrontFace -> IO ())
vkCmdSetFrontFaceEXTPtr
  String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdSetFrontFaceEXT" (Ptr CommandBuffer_T -> FrontFace -> IO ()
vkCmdSetFrontFaceEXT' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) (FrontFace
frontFace))
  () -> 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" mkVkCmdSetPrimitiveTopologyEXT
  :: FunPtr (Ptr CommandBuffer_T -> PrimitiveTopology -> IO ()) -> Ptr CommandBuffer_T -> PrimitiveTopology -> IO ()

-- | vkCmdSetPrimitiveTopologyEXT - Set primitive topology state dynamically
-- for a command buffer
--
-- = Description
--
-- This command sets the primitive topology for subsequent drawing commands
-- when the graphics pipeline is created with
-- 'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_PRIMITIVE_TOPOLOGY_EXT'
-- set in
-- 'Vulkan.Core10.Pipeline.PipelineDynamicStateCreateInfo'::@pDynamicStates@.
-- Otherwise, this state is specified by the
-- 'Vulkan.Core10.Pipeline.PipelineInputAssemblyStateCreateInfo'::@topology@
-- value used to create the currently active pipeline.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdSetPrimitiveTopologyEXT-None-03347# The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-extendedDynamicState extendedDynamicState>
--     feature /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdSetPrimitiveTopologyEXT-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdSetPrimitiveTopologyEXT-primitiveTopology-parameter#
--     @primitiveTopology@ /must/ be a valid
--     'Vulkan.Core10.Enums.PrimitiveTopology.PrimitiveTopology' value
--
-- -   #VUID-vkCmdSetPrimitiveTopologyEXT-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-vkCmdSetPrimitiveTopologyEXT-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- == 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_extended_dynamic_state VK_EXT_extended_dynamic_state>,
-- 'Vulkan.Core10.Handles.CommandBuffer',
-- 'Vulkan.Core10.Enums.PrimitiveTopology.PrimitiveTopology'
cmdSetPrimitiveTopologyEXT :: forall io
                            . (MonadIO io)
                           => -- | @commandBuffer@ is the command buffer into which the command will be
                              -- recorded.
                              CommandBuffer
                           -> -- | @primitiveTopology@ specifies the primitive topology to use for drawing.
                              PrimitiveTopology
                           -> io ()
cmdSetPrimitiveTopologyEXT :: CommandBuffer -> PrimitiveTopology -> io ()
cmdSetPrimitiveTopologyEXT CommandBuffer
commandBuffer PrimitiveTopology
primitiveTopology = 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 vkCmdSetPrimitiveTopologyEXTPtr :: FunPtr (Ptr CommandBuffer_T -> PrimitiveTopology -> IO ())
vkCmdSetPrimitiveTopologyEXTPtr = DeviceCmds
-> FunPtr (Ptr CommandBuffer_T -> PrimitiveTopology -> IO ())
pVkCmdSetPrimitiveTopologyEXT (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 -> PrimitiveTopology -> IO ())
vkCmdSetPrimitiveTopologyEXTPtr FunPtr (Ptr CommandBuffer_T -> PrimitiveTopology -> IO ())
-> FunPtr (Ptr CommandBuffer_T -> PrimitiveTopology -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr (Ptr CommandBuffer_T -> PrimitiveTopology -> 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 vkCmdSetPrimitiveTopologyEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdSetPrimitiveTopologyEXT' :: Ptr CommandBuffer_T -> PrimitiveTopology -> IO ()
vkCmdSetPrimitiveTopologyEXT' = FunPtr (Ptr CommandBuffer_T -> PrimitiveTopology -> IO ())
-> Ptr CommandBuffer_T -> PrimitiveTopology -> IO ()
mkVkCmdSetPrimitiveTopologyEXT FunPtr (Ptr CommandBuffer_T -> PrimitiveTopology -> IO ())
vkCmdSetPrimitiveTopologyEXTPtr
  String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdSetPrimitiveTopologyEXT" (Ptr CommandBuffer_T -> PrimitiveTopology -> IO ()
vkCmdSetPrimitiveTopologyEXT' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) (PrimitiveTopology
primitiveTopology))
  () -> 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" mkVkCmdSetViewportWithCountEXT
  :: FunPtr (Ptr CommandBuffer_T -> Word32 -> Ptr Viewport -> IO ()) -> Ptr CommandBuffer_T -> Word32 -> Ptr Viewport -> IO ()

-- | vkCmdSetViewportWithCountEXT - Set the viewport count and viewports
-- dynamically for a command buffer
--
-- = Description
--
-- This command sets the viewport count and viewports state for subsequent
-- drawing commands when the graphics pipeline is created with
-- 'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VIEWPORT_WITH_COUNT_EXT'
-- set in
-- 'Vulkan.Core10.Pipeline.PipelineDynamicStateCreateInfo'::@pDynamicStates@.
-- Otherwise, this state is specified by the corresponding
-- 'Vulkan.Core10.Pipeline.PipelineViewportStateCreateInfo'::@viewportCount@
-- and @pViewports@ values used to create the currently active pipeline.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdSetViewportWithCountEXT-None-03393# The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-extendedDynamicState extendedDynamicState>
--     feature /must/ be enabled
--
-- -   #VUID-vkCmdSetViewportWithCountEXT-viewportCount-03394#
--     @viewportCount@ /must/ be between @1@ and
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxViewports@,
--     inclusive
--
-- -   #VUID-vkCmdSetViewportWithCountEXT-viewportCount-03395# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-multiViewport multiple viewports>
--     feature is not enabled, @viewportCount@ /must/ be @1@
--
-- -   #VUID-vkCmdSetViewportWithCountEXT-commandBuffer-04819#
--     @commandBuffer@ /must/ not have
--     'Vulkan.Extensions.VK_NV_inherited_viewport_scissor.CommandBufferInheritanceViewportScissorInfoNV'::@viewportScissor2D@
--     enabled
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdSetViewportWithCountEXT-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdSetViewportWithCountEXT-pViewports-parameter#
--     @pViewports@ /must/ be a valid pointer to an array of
--     @viewportCount@ valid 'Vulkan.Core10.Pipeline.Viewport' structures
--
-- -   #VUID-vkCmdSetViewportWithCountEXT-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-vkCmdSetViewportWithCountEXT-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- -   #VUID-vkCmdSetViewportWithCountEXT-viewportCount-arraylength#
--     @viewportCount@ /must/ be greater than @0@
--
-- == 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_extended_dynamic_state VK_EXT_extended_dynamic_state>,
-- 'Vulkan.Core10.Handles.CommandBuffer', 'Vulkan.Core10.Pipeline.Viewport'
cmdSetViewportWithCountEXT :: forall io
                            . (MonadIO io)
                           => -- | @commandBuffer@ is the command buffer into which the command will be
                              -- recorded.
                              CommandBuffer
                           -> -- | @pViewports@ specifies the viewports to use for drawing.
                              ("viewports" ::: Vector Viewport)
                           -> io ()
cmdSetViewportWithCountEXT :: CommandBuffer -> ("viewports" ::: Vector Viewport) -> io ()
cmdSetViewportWithCountEXT CommandBuffer
commandBuffer "viewports" ::: Vector Viewport
viewports = 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 vkCmdSetViewportWithCountEXTPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("viewportCount" ::: Word32)
   -> ("pViewports" ::: Ptr Viewport)
   -> IO ())
vkCmdSetViewportWithCountEXTPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("viewportCount" ::: Word32)
      -> ("pViewports" ::: Ptr Viewport)
      -> IO ())
pVkCmdSetViewportWithCountEXT (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
   -> ("viewportCount" ::: Word32)
   -> ("pViewports" ::: Ptr Viewport)
   -> IO ())
vkCmdSetViewportWithCountEXTPtr FunPtr
  (Ptr CommandBuffer_T
   -> ("viewportCount" ::: Word32)
   -> ("pViewports" ::: Ptr Viewport)
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("viewportCount" ::: Word32)
      -> ("pViewports" ::: Ptr Viewport)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("viewportCount" ::: Word32)
   -> ("pViewports" ::: Ptr Viewport)
   -> 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 vkCmdSetViewportWithCountEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdSetViewportWithCountEXT' :: Ptr CommandBuffer_T
-> ("viewportCount" ::: Word32)
-> ("pViewports" ::: Ptr Viewport)
-> IO ()
vkCmdSetViewportWithCountEXT' = FunPtr
  (Ptr CommandBuffer_T
   -> ("viewportCount" ::: Word32)
   -> ("pViewports" ::: Ptr Viewport)
   -> IO ())
-> Ptr CommandBuffer_T
-> ("viewportCount" ::: Word32)
-> ("pViewports" ::: Ptr Viewport)
-> IO ()
mkVkCmdSetViewportWithCountEXT FunPtr
  (Ptr CommandBuffer_T
   -> ("viewportCount" ::: Word32)
   -> ("pViewports" ::: Ptr Viewport)
   -> IO ())
vkCmdSetViewportWithCountEXTPtr
  "pViewports" ::: Ptr Viewport
pPViewports <- ((("pViewports" ::: Ptr Viewport) -> IO ()) -> IO ())
-> ContT () IO ("pViewports" ::: Ptr Viewport)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pViewports" ::: Ptr Viewport) -> IO ()) -> IO ())
 -> ContT () IO ("pViewports" ::: Ptr Viewport))
-> ((("pViewports" ::: Ptr Viewport) -> IO ()) -> IO ())
-> ContT () IO ("pViewports" ::: Ptr Viewport)
forall a b. (a -> b) -> a -> b
$ Int -> (("pViewports" ::: Ptr Viewport) -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @Viewport ((("viewports" ::: Vector Viewport) -> Int
forall a. Vector a -> Int
Data.Vector.length ("viewports" ::: Vector Viewport
viewports)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
24)
  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 -> Viewport -> IO ())
-> ("viewports" ::: Vector Viewport) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Viewport
e -> ("pViewports" ::: Ptr Viewport) -> Viewport -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pViewports" ::: Ptr Viewport
pPViewports ("pViewports" ::: Ptr Viewport)
-> Int -> "pViewports" ::: Ptr Viewport
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
24 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Viewport) (Viewport
e)) ("viewports" ::: Vector Viewport
viewports)
  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
"vkCmdSetViewportWithCountEXT" (Ptr CommandBuffer_T
-> ("viewportCount" ::: Word32)
-> ("pViewports" ::: Ptr Viewport)
-> IO ()
vkCmdSetViewportWithCountEXT' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) ((Int -> "viewportCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("viewports" ::: Vector Viewport) -> Int
forall a. Vector a -> Int
Data.Vector.length (("viewports" ::: Vector Viewport) -> Int)
-> ("viewports" ::: Vector Viewport) -> Int
forall a b. (a -> b) -> a -> b
$ ("viewports" ::: Vector Viewport
viewports)) :: Word32)) ("pViewports" ::: Ptr Viewport
pPViewports))
  () -> 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" mkVkCmdSetScissorWithCountEXT
  :: FunPtr (Ptr CommandBuffer_T -> Word32 -> Ptr Rect2D -> IO ()) -> Ptr CommandBuffer_T -> Word32 -> Ptr Rect2D -> IO ()

-- | vkCmdSetScissorWithCountEXT - Set the scissor count and scissor
-- rectangular bounds dynamically for a command buffer
--
-- = Description
--
-- This command sets the scissor count and scissor rectangular bounds state
-- for subsequence drawing commands when the graphics pipeline is created
-- with
-- 'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_SCISSOR_WITH_COUNT_EXT'
-- set in
-- 'Vulkan.Core10.Pipeline.PipelineDynamicStateCreateInfo'::@pDynamicStates@.
-- Otherwise, this state is specified by the corresponding
-- 'Vulkan.Core10.Pipeline.PipelineViewportStateCreateInfo'::@scissorCount@
-- and @pScissors@ values used to create the currently active pipeline.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdSetScissorWithCountEXT-None-03396# The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-extendedDynamicState extendedDynamicState>
--     feature /must/ be enabled
--
-- -   #VUID-vkCmdSetScissorWithCountEXT-scissorCount-03397# @scissorCount@
--     /must/ be between @1@ and
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxViewports@,
--     inclusive
--
-- -   #VUID-vkCmdSetScissorWithCountEXT-scissorCount-03398# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-multiViewport multiple viewports>
--     feature is not enabled, @scissorCount@ /must/ be @1@
--
-- -   #VUID-vkCmdSetScissorWithCountEXT-x-03399# The @x@ and @y@ members
--     of @offset@ member of any element of @pScissors@ /must/ be greater
--     than or equal to @0@
--
-- -   #VUID-vkCmdSetScissorWithCountEXT-offset-03400# Evaluation of
--     (@offset.x@ + @extent.width@) /must/ not cause a signed integer
--     addition overflow for any element of @pScissors@
--
-- -   #VUID-vkCmdSetScissorWithCountEXT-offset-03401# Evaluation of
--     (@offset.y@ + @extent.height@) /must/ not cause a signed integer
--     addition overflow for any element of @pScissors@
--
-- -   #VUID-vkCmdSetScissorWithCountEXT-commandBuffer-04820#
--     @commandBuffer@ /must/ not have
--     'Vulkan.Extensions.VK_NV_inherited_viewport_scissor.CommandBufferInheritanceViewportScissorInfoNV'::@viewportScissor2D@
--     enabled
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdSetScissorWithCountEXT-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdSetScissorWithCountEXT-pScissors-parameter# @pScissors@
--     /must/ be a valid pointer to an array of @scissorCount@
--     'Vulkan.Core10.FundamentalTypes.Rect2D' structures
--
-- -   #VUID-vkCmdSetScissorWithCountEXT-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-vkCmdSetScissorWithCountEXT-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- -   #VUID-vkCmdSetScissorWithCountEXT-scissorCount-arraylength#
--     @scissorCount@ /must/ be greater than @0@
--
-- == 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_extended_dynamic_state VK_EXT_extended_dynamic_state>,
-- 'Vulkan.Core10.Handles.CommandBuffer',
-- 'Vulkan.Core10.FundamentalTypes.Rect2D'
cmdSetScissorWithCountEXT :: forall io
                           . (MonadIO io)
                          => -- | @commandBuffer@ is the command buffer into which the command will be
                             -- recorded.
                             CommandBuffer
                          -> -- | @pScissors@ specifies the scissors to use for drawing.
                             ("scissors" ::: Vector Rect2D)
                          -> io ()
cmdSetScissorWithCountEXT :: CommandBuffer -> ("scissors" ::: Vector Rect2D) -> io ()
cmdSetScissorWithCountEXT CommandBuffer
commandBuffer "scissors" ::: Vector Rect2D
scissors = 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 vkCmdSetScissorWithCountEXTPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("viewportCount" ::: Word32)
   -> ("pScissors" ::: Ptr Rect2D)
   -> IO ())
vkCmdSetScissorWithCountEXTPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("viewportCount" ::: Word32)
      -> ("pScissors" ::: Ptr Rect2D)
      -> IO ())
pVkCmdSetScissorWithCountEXT (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
   -> ("viewportCount" ::: Word32)
   -> ("pScissors" ::: Ptr Rect2D)
   -> IO ())
vkCmdSetScissorWithCountEXTPtr FunPtr
  (Ptr CommandBuffer_T
   -> ("viewportCount" ::: Word32)
   -> ("pScissors" ::: Ptr Rect2D)
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("viewportCount" ::: Word32)
      -> ("pScissors" ::: Ptr Rect2D)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("viewportCount" ::: Word32)
   -> ("pScissors" ::: Ptr Rect2D)
   -> 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 vkCmdSetScissorWithCountEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdSetScissorWithCountEXT' :: Ptr CommandBuffer_T
-> ("viewportCount" ::: Word32)
-> ("pScissors" ::: Ptr Rect2D)
-> IO ()
vkCmdSetScissorWithCountEXT' = FunPtr
  (Ptr CommandBuffer_T
   -> ("viewportCount" ::: Word32)
   -> ("pScissors" ::: Ptr Rect2D)
   -> IO ())
-> Ptr CommandBuffer_T
-> ("viewportCount" ::: Word32)
-> ("pScissors" ::: Ptr Rect2D)
-> IO ()
mkVkCmdSetScissorWithCountEXT FunPtr
  (Ptr CommandBuffer_T
   -> ("viewportCount" ::: Word32)
   -> ("pScissors" ::: Ptr Rect2D)
   -> IO ())
vkCmdSetScissorWithCountEXTPtr
  "pScissors" ::: Ptr Rect2D
pPScissors <- ((("pScissors" ::: Ptr Rect2D) -> IO ()) -> IO ())
-> ContT () IO ("pScissors" ::: Ptr Rect2D)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pScissors" ::: Ptr Rect2D) -> IO ()) -> IO ())
 -> ContT () IO ("pScissors" ::: Ptr Rect2D))
-> ((("pScissors" ::: Ptr Rect2D) -> IO ()) -> IO ())
-> ContT () IO ("pScissors" ::: Ptr Rect2D)
forall a b. (a -> b) -> a -> b
$ Int -> (("pScissors" ::: Ptr Rect2D) -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @Rect2D ((("scissors" ::: Vector Rect2D) -> Int
forall a. Vector a -> Int
Data.Vector.length ("scissors" ::: Vector Rect2D
scissors)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16)
  IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> Rect2D -> IO ()) -> ("scissors" ::: Vector Rect2D) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Rect2D
e -> ("pScissors" ::: Ptr Rect2D) -> Rect2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pScissors" ::: Ptr Rect2D
pPScissors ("pScissors" ::: Ptr Rect2D) -> Int -> "pScissors" ::: Ptr Rect2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Rect2D) (Rect2D
e)) ("scissors" ::: Vector Rect2D
scissors)
  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
"vkCmdSetScissorWithCountEXT" (Ptr CommandBuffer_T
-> ("viewportCount" ::: Word32)
-> ("pScissors" ::: Ptr Rect2D)
-> IO ()
vkCmdSetScissorWithCountEXT' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) ((Int -> "viewportCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("scissors" ::: Vector Rect2D) -> Int
forall a. Vector a -> Int
Data.Vector.length (("scissors" ::: Vector Rect2D) -> Int)
-> ("scissors" ::: Vector Rect2D) -> Int
forall a b. (a -> b) -> a -> b
$ ("scissors" ::: Vector Rect2D
scissors)) :: Word32)) ("pScissors" ::: Ptr Rect2D
pPScissors))
  () -> 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" mkVkCmdBindVertexBuffers2EXT
  :: FunPtr (Ptr CommandBuffer_T -> Word32 -> Word32 -> Ptr Buffer -> Ptr DeviceSize -> Ptr DeviceSize -> Ptr DeviceSize -> IO ()) -> Ptr CommandBuffer_T -> Word32 -> Word32 -> Ptr Buffer -> Ptr DeviceSize -> Ptr DeviceSize -> Ptr DeviceSize -> IO ()

-- | vkCmdBindVertexBuffers2EXT - Bind vertex buffers to a command buffer and
-- dynamically set strides
--
-- = Description
--
-- The values taken from elements i of @pBuffers@ and @pOffsets@ replace
-- the current state for the vertex input binding @firstBinding@ + i, for i
-- in [0, @bindingCount@). The vertex input binding is updated to start at
-- the offset indicated by @pOffsets@[i] from the start of the buffer
-- @pBuffers@[i]. If @pSizes@ is not @NULL@ then @pSizes@[i] specifies the
-- bound size of the vertex buffer starting from the corresponding elements
-- of @pBuffers@[i] plus @pOffsets@[i]. All vertex input attributes that
-- use each of these bindings will use these updated addresses in their
-- address calculations for subsequent drawing commands. If the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-nullDescriptor nullDescriptor>
-- feature is enabled, elements of @pBuffers@ /can/ be
-- 'Vulkan.Core10.APIConstants.NULL_HANDLE', and /can/ be used by the
-- vertex shader. If a vertex input attribute is bound to a vertex input
-- binding that is 'Vulkan.Core10.APIConstants.NULL_HANDLE', the values
-- taken from memory are considered to be zero, and missing G, B, or A
-- components are
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fxvertex-input-extraction filled with (0,0,1)>.
--
-- This command also \<pipelines-dynamic-state, dynamically sets>> the byte
-- strides between consecutive elements within buffer @pBuffers@[i] to the
-- corresponding @pStrides@[i] value when the graphics pipeline is created
-- with
-- 'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VERTEX_INPUT_BINDING_STRIDE_EXT'
-- set in
-- 'Vulkan.Core10.Pipeline.PipelineDynamicStateCreateInfo'::@pDynamicStates@.
-- Otherwise, strides are specified by the
-- 'Vulkan.Core10.Pipeline.VertexInputBindingDescription'::@stride@ 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_EXT'
-- dynamic state enabled then
-- 'Vulkan.Extensions.VK_EXT_vertex_input_dynamic_state.cmdSetVertexInputEXT'
-- /can/ be used instead of 'cmdBindVertexBuffers2EXT' to set the stride.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdBindVertexBuffers2EXT-firstBinding-03355# @firstBinding@
--     /must/ be less than
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxVertexInputBindings@
--
-- -   #VUID-vkCmdBindVertexBuffers2EXT-firstBinding-03356# The sum of
--     @firstBinding@ and @bindingCount@ /must/ be less than or equal to
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxVertexInputBindings@
--
-- -   #VUID-vkCmdBindVertexBuffers2EXT-pOffsets-03357# All elements of
--     @pOffsets@ /must/ be less than the size of the corresponding element
--     in @pBuffers@
--
-- -   #VUID-vkCmdBindVertexBuffers2EXT-pSizes-03358# If @pSizes@ is not
--     @NULL@, all elements of @pOffsets@ plus @pSizes@ /must/ be less than
--     or equal to the size of the corresponding element in @pBuffers@
--
-- -   #VUID-vkCmdBindVertexBuffers2EXT-pBuffers-03359# All elements of
--     @pBuffers@ /must/ have been created with the
--     'Vulkan.Core10.Enums.BufferUsageFlagBits.BUFFER_USAGE_VERTEX_BUFFER_BIT'
--     flag
--
-- -   #VUID-vkCmdBindVertexBuffers2EXT-pBuffers-03360# Each element of
--     @pBuffers@ that is non-sparse /must/ be bound completely and
--     contiguously to a single 'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   #VUID-vkCmdBindVertexBuffers2EXT-pBuffers-04111# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-nullDescriptor nullDescriptor>
--     feature is not enabled, all elements of @pBuffers@ /must/ not be
--     'Vulkan.Core10.APIConstants.NULL_HANDLE'
--
-- -   #VUID-vkCmdBindVertexBuffers2EXT-pBuffers-04112# If an element of
--     @pBuffers@ is 'Vulkan.Core10.APIConstants.NULL_HANDLE', then the
--     corresponding element of @pOffsets@ /must/ be zero
--
-- -   #VUID-vkCmdBindVertexBuffers2EXT-pStrides-03362# If @pStrides@ is
--     not @NULL@ each element of @pStrides@ /must/ be less than or equal
--     to
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxVertexInputBindingStride@
--
-- -   #VUID-vkCmdBindVertexBuffers2EXT-pStrides-06209# If @pStrides@ is
--     not @NULL@ each element of @pStrides@ /must/ be either 0 or greater
--     than or equal to the maximum extent of all vertex input attributes
--     fetched from the corresponding binding, where the extent is
--     calculated as the
--     'Vulkan.Core10.Pipeline.VertexInputAttributeDescription'::@offset@
--     plus
--     'Vulkan.Core10.Pipeline.VertexInputAttributeDescription'::@format@
--     size
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdBindVertexBuffers2EXT-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdBindVertexBuffers2EXT-pBuffers-parameter# @pBuffers@
--     /must/ be a valid pointer to an array of @bindingCount@ valid or
--     'Vulkan.Core10.APIConstants.NULL_HANDLE'
--     'Vulkan.Core10.Handles.Buffer' handles
--
-- -   #VUID-vkCmdBindVertexBuffers2EXT-pOffsets-parameter# @pOffsets@
--     /must/ be a valid pointer to an array of @bindingCount@
--     'Vulkan.Core10.FundamentalTypes.DeviceSize' values
--
-- -   #VUID-vkCmdBindVertexBuffers2EXT-pSizes-parameter# If @pSizes@ is
--     not @NULL@, @pSizes@ /must/ be a valid pointer to an array of
--     @bindingCount@ 'Vulkan.Core10.FundamentalTypes.DeviceSize' values
--
-- -   #VUID-vkCmdBindVertexBuffers2EXT-pStrides-parameter# If @pStrides@
--     is not @NULL@, @pStrides@ /must/ be a valid pointer to an array of
--     @bindingCount@ 'Vulkan.Core10.FundamentalTypes.DeviceSize' values
--
-- -   #VUID-vkCmdBindVertexBuffers2EXT-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-vkCmdBindVertexBuffers2EXT-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- -   #VUID-vkCmdBindVertexBuffers2EXT-bindingCount-arraylength# If any of
--     @pSizes@, or @pStrides@ are not @NULL@, @bindingCount@ /must/ be
--     greater than @0@
--
-- -   #VUID-vkCmdBindVertexBuffers2EXT-commonparent# Both of
--     @commandBuffer@, and the elements of @pBuffers@ 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                                                                                                                    | Both                                                                                                                   | Graphics                                                                                                              |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                       |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_extended_dynamic_state VK_EXT_extended_dynamic_state>,
-- 'Vulkan.Core10.Handles.Buffer', 'Vulkan.Core10.Handles.CommandBuffer',
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize'
cmdBindVertexBuffers2EXT :: forall io
                          . (MonadIO io)
                         => -- | @commandBuffer@ is the command buffer into which the command is
                            -- recorded.
                            CommandBuffer
                         -> -- | @firstBinding@ is the index of the first vertex input 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 the size in bytes of
                            -- vertex data bound from @pBuffers@.
                            ("sizes" ::: Vector DeviceSize)
                         -> -- | @pStrides@ is @NULL@ or a pointer to an array of buffer strides.
                            ("strides" ::: Vector DeviceSize)
                         -> io ()
cmdBindVertexBuffers2EXT :: CommandBuffer
-> ("viewportCount" ::: Word32)
-> ("buffers" ::: Vector Buffer)
-> ("offsets" ::: Vector DeviceSize)
-> ("offsets" ::: Vector DeviceSize)
-> ("offsets" ::: Vector DeviceSize)
-> io ()
cmdBindVertexBuffers2EXT CommandBuffer
commandBuffer "viewportCount" ::: Word32
firstBinding "buffers" ::: Vector Buffer
buffers "offsets" ::: Vector DeviceSize
offsets "offsets" ::: Vector DeviceSize
sizes "offsets" ::: Vector DeviceSize
strides = 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 vkCmdBindVertexBuffers2EXTPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("viewportCount" ::: Word32)
   -> ("viewportCount" ::: Word32)
   -> ("pBuffers" ::: Ptr Buffer)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> IO ())
vkCmdBindVertexBuffers2EXTPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("viewportCount" ::: Word32)
      -> ("viewportCount" ::: Word32)
      -> ("pBuffers" ::: Ptr Buffer)
      -> ("pOffsets" ::: Ptr DeviceSize)
      -> ("pOffsets" ::: Ptr DeviceSize)
      -> ("pOffsets" ::: Ptr DeviceSize)
      -> IO ())
pVkCmdBindVertexBuffers2EXT (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
   -> ("viewportCount" ::: Word32)
   -> ("viewportCount" ::: Word32)
   -> ("pBuffers" ::: Ptr Buffer)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> IO ())
vkCmdBindVertexBuffers2EXTPtr FunPtr
  (Ptr CommandBuffer_T
   -> ("viewportCount" ::: Word32)
   -> ("viewportCount" ::: Word32)
   -> ("pBuffers" ::: Ptr Buffer)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("viewportCount" ::: Word32)
      -> ("viewportCount" ::: Word32)
      -> ("pBuffers" ::: Ptr Buffer)
      -> ("pOffsets" ::: Ptr DeviceSize)
      -> ("pOffsets" ::: Ptr DeviceSize)
      -> ("pOffsets" ::: Ptr DeviceSize)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("viewportCount" ::: Word32)
   -> ("viewportCount" ::: Word32)
   -> ("pBuffers" ::: Ptr Buffer)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> ("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 vkCmdBindVertexBuffers2EXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdBindVertexBuffers2EXT' :: Ptr CommandBuffer_T
-> ("viewportCount" ::: Word32)
-> ("viewportCount" ::: Word32)
-> ("pBuffers" ::: Ptr Buffer)
-> ("pOffsets" ::: Ptr DeviceSize)
-> ("pOffsets" ::: Ptr DeviceSize)
-> ("pOffsets" ::: Ptr DeviceSize)
-> IO ()
vkCmdBindVertexBuffers2EXT' = FunPtr
  (Ptr CommandBuffer_T
   -> ("viewportCount" ::: Word32)
   -> ("viewportCount" ::: Word32)
   -> ("pBuffers" ::: Ptr Buffer)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> IO ())
-> Ptr CommandBuffer_T
-> ("viewportCount" ::: Word32)
-> ("viewportCount" ::: Word32)
-> ("pBuffers" ::: Ptr Buffer)
-> ("pOffsets" ::: Ptr DeviceSize)
-> ("pOffsets" ::: Ptr DeviceSize)
-> ("pOffsets" ::: Ptr DeviceSize)
-> IO ()
mkVkCmdBindVertexBuffers2EXT FunPtr
  (Ptr CommandBuffer_T
   -> ("viewportCount" ::: Word32)
   -> ("viewportCount" ::: Word32)
   -> ("pBuffers" ::: Ptr Buffer)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> ("pOffsets" ::: Ptr DeviceSize)
   -> IO ())
vkCmdBindVertexBuffers2EXTPtr
  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
  let pStridesLength :: Int
pStridesLength = ("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
strides)
  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
pStridesLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
pBuffersLength Bool -> Bool -> Bool
|| Int
pStridesLength 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
"pStrides 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
  "pOffsets" ::: Ptr DeviceSize
pStrides <- if ("offsets" ::: Vector DeviceSize) -> Bool
forall a. Vector a -> Bool
Data.Vector.null ("offsets" ::: Vector DeviceSize
strides)
    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
pPStrides <- ((("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
strides))) 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
pPStrides ("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
strides))
      ("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
pPStrides
  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
"vkCmdBindVertexBuffers2EXT" (Ptr CommandBuffer_T
-> ("viewportCount" ::: Word32)
-> ("viewportCount" ::: Word32)
-> ("pBuffers" ::: Ptr Buffer)
-> ("pOffsets" ::: Ptr DeviceSize)
-> ("pOffsets" ::: Ptr DeviceSize)
-> ("pOffsets" ::: Ptr DeviceSize)
-> IO ()
vkCmdBindVertexBuffers2EXT' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) ("viewportCount" ::: Word32
firstBinding) ((Int -> "viewportCount" ::: 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 "pOffsets" ::: Ptr DeviceSize
pStrides)
  () -> 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" mkVkCmdSetDepthTestEnableEXT
  :: FunPtr (Ptr CommandBuffer_T -> Bool32 -> IO ()) -> Ptr CommandBuffer_T -> Bool32 -> IO ()

-- | vkCmdSetDepthTestEnableEXT - Set depth test enable dynamically for a
-- command buffer
--
-- = Description
--
-- This command sets the depth test enable for subsequent drawing commands
-- when the graphics pipeline is created with
-- 'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_DEPTH_TEST_ENABLE_EXT'
-- set in
-- 'Vulkan.Core10.Pipeline.PipelineDynamicStateCreateInfo'::@pDynamicStates@.
-- Otherwise, this state is specified by the
-- 'Vulkan.Core10.Pipeline.PipelineDepthStencilStateCreateInfo'::@depthTestEnable@
-- value used to create the currently active pipeline.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdSetDepthTestEnableEXT-None-03352# The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-extendedDynamicState extendedDynamicState>
--     feature /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdSetDepthTestEnableEXT-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdSetDepthTestEnableEXT-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-vkCmdSetDepthTestEnableEXT-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- == 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_extended_dynamic_state VK_EXT_extended_dynamic_state>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Handles.CommandBuffer'
cmdSetDepthTestEnableEXT :: forall io
                          . (MonadIO io)
                         => -- | @commandBuffer@ is the command buffer into which the command will be
                            -- recorded.
                            CommandBuffer
                         -> -- | @depthTestEnable@ specifies if the depth test is enabled.
                            ("depthTestEnable" ::: Bool)
                         -> io ()
cmdSetDepthTestEnableEXT :: CommandBuffer -> Bool -> io ()
cmdSetDepthTestEnableEXT CommandBuffer
commandBuffer Bool
depthTestEnable = 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 vkCmdSetDepthTestEnableEXTPtr :: FunPtr
  (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ())
vkCmdSetDepthTestEnableEXTPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ())
pVkCmdSetDepthTestEnableEXT (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 -> ("depthTestEnable" ::: Bool32) -> IO ())
vkCmdSetDepthTestEnableEXTPtr FunPtr
  (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> 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 vkCmdSetDepthTestEnableEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdSetDepthTestEnableEXT' :: Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ()
vkCmdSetDepthTestEnableEXT' = FunPtr
  (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ())
-> Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ()
mkVkCmdSetDepthTestEnableEXT FunPtr
  (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ())
vkCmdSetDepthTestEnableEXTPtr
  String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdSetDepthTestEnableEXT" (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ()
vkCmdSetDepthTestEnableEXT' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) (Bool -> "depthTestEnable" ::: Bool32
boolToBool32 (Bool
depthTestEnable)))
  () -> 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" mkVkCmdSetDepthWriteEnableEXT
  :: FunPtr (Ptr CommandBuffer_T -> Bool32 -> IO ()) -> Ptr CommandBuffer_T -> Bool32 -> IO ()

-- | vkCmdSetDepthWriteEnableEXT - Set depth write enable dynamically for a
-- command buffer
--
-- = Description
--
-- This command sets the depth write enable for subsequent drawing commands
-- when the graphics pipeline is created with
-- 'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_DEPTH_WRITE_ENABLE_EXT'
-- set in
-- 'Vulkan.Core10.Pipeline.PipelineDynamicStateCreateInfo'::@pDynamicStates@.
-- Otherwise, this state is specified by the
-- 'Vulkan.Core10.Pipeline.PipelineDepthStencilStateCreateInfo'::@depthWriteEnable@
-- value used to create the currently active pipeline.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdSetDepthWriteEnableEXT-None-03354# The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-extendedDynamicState extendedDynamicState>
--     feature /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdSetDepthWriteEnableEXT-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdSetDepthWriteEnableEXT-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-vkCmdSetDepthWriteEnableEXT-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- == 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_extended_dynamic_state VK_EXT_extended_dynamic_state>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Handles.CommandBuffer'
cmdSetDepthWriteEnableEXT :: forall io
                           . (MonadIO io)
                          => -- | @commandBuffer@ is the command buffer into which the command will be
                             -- recorded.
                             CommandBuffer
                          -> -- | @depthWriteEnable@ specifies if depth writes are enabled.
                             ("depthWriteEnable" ::: Bool)
                          -> io ()
cmdSetDepthWriteEnableEXT :: CommandBuffer -> Bool -> io ()
cmdSetDepthWriteEnableEXT CommandBuffer
commandBuffer Bool
depthWriteEnable = 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 vkCmdSetDepthWriteEnableEXTPtr :: FunPtr
  (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ())
vkCmdSetDepthWriteEnableEXTPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ())
pVkCmdSetDepthWriteEnableEXT (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 -> ("depthTestEnable" ::: Bool32) -> IO ())
vkCmdSetDepthWriteEnableEXTPtr FunPtr
  (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> 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 vkCmdSetDepthWriteEnableEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdSetDepthWriteEnableEXT' :: Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ()
vkCmdSetDepthWriteEnableEXT' = FunPtr
  (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ())
-> Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ()
mkVkCmdSetDepthWriteEnableEXT FunPtr
  (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ())
vkCmdSetDepthWriteEnableEXTPtr
  String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdSetDepthWriteEnableEXT" (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ()
vkCmdSetDepthWriteEnableEXT' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) (Bool -> "depthTestEnable" ::: Bool32
boolToBool32 (Bool
depthWriteEnable)))
  () -> 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" mkVkCmdSetDepthCompareOpEXT
  :: FunPtr (Ptr CommandBuffer_T -> CompareOp -> IO ()) -> Ptr CommandBuffer_T -> CompareOp -> IO ()

-- | vkCmdSetDepthCompareOpEXT - Set depth comparison operator dynamically
-- for a command buffer
--
-- = Description
--
-- This command sets the depth comparison operator for subsequent drawing
-- commands when the graphics pipeline is created with
-- 'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_DEPTH_COMPARE_OP_EXT'
-- set in
-- 'Vulkan.Core10.Pipeline.PipelineDynamicStateCreateInfo'::@pDynamicStates@.
-- Otherwise, this state is specified by the
-- 'Vulkan.Core10.Pipeline.PipelineDepthStencilStateCreateInfo'::@depthCompareOp@
-- value used to create the currently active pipeline.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdSetDepthCompareOpEXT-None-03353# The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-extendedDynamicState extendedDynamicState>
--     feature /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdSetDepthCompareOpEXT-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdSetDepthCompareOpEXT-depthCompareOp-parameter#
--     @depthCompareOp@ /must/ be a valid
--     'Vulkan.Core10.Enums.CompareOp.CompareOp' value
--
-- -   #VUID-vkCmdSetDepthCompareOpEXT-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-vkCmdSetDepthCompareOpEXT-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- == 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_extended_dynamic_state VK_EXT_extended_dynamic_state>,
-- 'Vulkan.Core10.Handles.CommandBuffer',
-- 'Vulkan.Core10.Enums.CompareOp.CompareOp'
cmdSetDepthCompareOpEXT :: forall io
                         . (MonadIO io)
                        => -- | @commandBuffer@ is the command buffer into which the command will be
                           -- recorded.
                           CommandBuffer
                        -> -- | @depthCompareOp@ specifies the depth comparison operator.
                           ("depthCompareOp" ::: CompareOp)
                        -> io ()
cmdSetDepthCompareOpEXT :: CommandBuffer -> ("depthCompareOp" ::: CompareOp) -> io ()
cmdSetDepthCompareOpEXT CommandBuffer
commandBuffer "depthCompareOp" ::: CompareOp
depthCompareOp = 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 vkCmdSetDepthCompareOpEXTPtr :: FunPtr
  (Ptr CommandBuffer_T -> ("depthCompareOp" ::: CompareOp) -> IO ())
vkCmdSetDepthCompareOpEXTPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T -> ("depthCompareOp" ::: CompareOp) -> IO ())
pVkCmdSetDepthCompareOpEXT (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 -> ("depthCompareOp" ::: CompareOp) -> IO ())
vkCmdSetDepthCompareOpEXTPtr FunPtr
  (Ptr CommandBuffer_T -> ("depthCompareOp" ::: CompareOp) -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T -> ("depthCompareOp" ::: CompareOp) -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T -> ("depthCompareOp" ::: CompareOp) -> 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 vkCmdSetDepthCompareOpEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdSetDepthCompareOpEXT' :: Ptr CommandBuffer_T -> ("depthCompareOp" ::: CompareOp) -> IO ()
vkCmdSetDepthCompareOpEXT' = FunPtr
  (Ptr CommandBuffer_T -> ("depthCompareOp" ::: CompareOp) -> IO ())
-> Ptr CommandBuffer_T -> ("depthCompareOp" ::: CompareOp) -> IO ()
mkVkCmdSetDepthCompareOpEXT FunPtr
  (Ptr CommandBuffer_T -> ("depthCompareOp" ::: CompareOp) -> IO ())
vkCmdSetDepthCompareOpEXTPtr
  String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdSetDepthCompareOpEXT" (Ptr CommandBuffer_T -> ("depthCompareOp" ::: CompareOp) -> IO ()
vkCmdSetDepthCompareOpEXT' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) ("depthCompareOp" ::: CompareOp
depthCompareOp))
  () -> 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" mkVkCmdSetDepthBoundsTestEnableEXT
  :: FunPtr (Ptr CommandBuffer_T -> Bool32 -> IO ()) -> Ptr CommandBuffer_T -> Bool32 -> IO ()

-- | vkCmdSetDepthBoundsTestEnableEXT - Set depth bounds test enable
-- dynamically for a command buffer
--
-- = Description
--
-- This command sets the depth bounds enable for subsequent drawing
-- commands when the graphics pipeline is created with
-- 'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_DEPTH_BOUNDS_TEST_ENABLE_EXT'
-- set in
-- 'Vulkan.Core10.Pipeline.PipelineDynamicStateCreateInfo'::@pDynamicStates@.
-- Otherwise, this state is specified by the
-- 'Vulkan.Core10.Pipeline.PipelineDepthStencilStateCreateInfo'::@depthBoundsTestEnable@
-- value used to create the currently active pipeline.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdSetDepthBoundsTestEnableEXT-None-03349# The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-extendedDynamicState extendedDynamicState>
--     feature /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdSetDepthBoundsTestEnableEXT-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdSetDepthBoundsTestEnableEXT-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-vkCmdSetDepthBoundsTestEnableEXT-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- == 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_extended_dynamic_state VK_EXT_extended_dynamic_state>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Handles.CommandBuffer'
cmdSetDepthBoundsTestEnableEXT :: forall io
                                . (MonadIO io)
                               => -- | @commandBuffer@ is the command buffer into which the command will be
                                  -- recorded.
                                  CommandBuffer
                               -> -- | @depthBoundsTestEnable@ specifies if the depth bounds test is enabled.
                                  ("depthBoundsTestEnable" ::: Bool)
                               -> io ()
cmdSetDepthBoundsTestEnableEXT :: CommandBuffer -> Bool -> io ()
cmdSetDepthBoundsTestEnableEXT CommandBuffer
commandBuffer Bool
depthBoundsTestEnable = 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 vkCmdSetDepthBoundsTestEnableEXTPtr :: FunPtr
  (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ())
vkCmdSetDepthBoundsTestEnableEXTPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ())
pVkCmdSetDepthBoundsTestEnableEXT (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 -> ("depthTestEnable" ::: Bool32) -> IO ())
vkCmdSetDepthBoundsTestEnableEXTPtr FunPtr
  (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> 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 vkCmdSetDepthBoundsTestEnableEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdSetDepthBoundsTestEnableEXT' :: Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ()
vkCmdSetDepthBoundsTestEnableEXT' = FunPtr
  (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ())
-> Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ()
mkVkCmdSetDepthBoundsTestEnableEXT FunPtr
  (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ())
vkCmdSetDepthBoundsTestEnableEXTPtr
  String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdSetDepthBoundsTestEnableEXT" (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ()
vkCmdSetDepthBoundsTestEnableEXT' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) (Bool -> "depthTestEnable" ::: Bool32
boolToBool32 (Bool
depthBoundsTestEnable)))
  () -> 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" mkVkCmdSetStencilTestEnableEXT
  :: FunPtr (Ptr CommandBuffer_T -> Bool32 -> IO ()) -> Ptr CommandBuffer_T -> Bool32 -> IO ()

-- | vkCmdSetStencilTestEnableEXT - Set stencil test enable dynamically for a
-- command buffer
--
-- = Description
--
-- This command sets the stencil test enable for subsequent drawing
-- commands when the graphics pipeline is created with
-- 'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_STENCIL_TEST_ENABLE_EXT'
-- set in
-- 'Vulkan.Core10.Pipeline.PipelineDynamicStateCreateInfo'::@pDynamicStates@.
-- Otherwise, this state is specified by the
-- 'Vulkan.Core10.Pipeline.PipelineDepthStencilStateCreateInfo'::@stencilTestEnable@
-- value used to create the currently active pipeline.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdSetStencilTestEnableEXT-None-03350# The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-extendedDynamicState extendedDynamicState>
--     feature /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdSetStencilTestEnableEXT-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdSetStencilTestEnableEXT-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-vkCmdSetStencilTestEnableEXT-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- == 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_extended_dynamic_state VK_EXT_extended_dynamic_state>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Handles.CommandBuffer'
cmdSetStencilTestEnableEXT :: forall io
                            . (MonadIO io)
                           => -- | @commandBuffer@ is the command buffer into which the command will be
                              -- recorded.
                              CommandBuffer
                           -> -- | @stencilTestEnable@ specifies if the stencil test is enabled.
                              ("stencilTestEnable" ::: Bool)
                           -> io ()
cmdSetStencilTestEnableEXT :: CommandBuffer -> Bool -> io ()
cmdSetStencilTestEnableEXT CommandBuffer
commandBuffer Bool
stencilTestEnable = 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 vkCmdSetStencilTestEnableEXTPtr :: FunPtr
  (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ())
vkCmdSetStencilTestEnableEXTPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ())
pVkCmdSetStencilTestEnableEXT (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 -> ("depthTestEnable" ::: Bool32) -> IO ())
vkCmdSetStencilTestEnableEXTPtr FunPtr
  (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> 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 vkCmdSetStencilTestEnableEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdSetStencilTestEnableEXT' :: Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ()
vkCmdSetStencilTestEnableEXT' = FunPtr
  (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ())
-> Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ()
mkVkCmdSetStencilTestEnableEXT FunPtr
  (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ())
vkCmdSetStencilTestEnableEXTPtr
  String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdSetStencilTestEnableEXT" (Ptr CommandBuffer_T -> ("depthTestEnable" ::: Bool32) -> IO ()
vkCmdSetStencilTestEnableEXT' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) (Bool -> "depthTestEnable" ::: Bool32
boolToBool32 (Bool
stencilTestEnable)))
  () -> 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" mkVkCmdSetStencilOpEXT
  :: FunPtr (Ptr CommandBuffer_T -> StencilFaceFlags -> StencilOp -> StencilOp -> StencilOp -> CompareOp -> IO ()) -> Ptr CommandBuffer_T -> StencilFaceFlags -> StencilOp -> StencilOp -> StencilOp -> CompareOp -> IO ()

-- | vkCmdSetStencilOpEXT - Set stencil operation dynamically for a command
-- buffer
--
-- = Description
--
-- This command sets the stencil operation for subsequent drawing commands
-- when the graphics pipeline is created with
-- 'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_STENCIL_OP_EXT' set in
-- 'Vulkan.Core10.Pipeline.PipelineDynamicStateCreateInfo'::@pDynamicStates@.
-- Otherwise, this state is specified by the corresponding
-- 'Vulkan.Core10.Pipeline.PipelineDepthStencilStateCreateInfo'::@failOp@,
-- @passOp@, @depthFailOp@, and @compareOp@ values used to create the
-- currently active pipeline, for both front and back faces.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdSetStencilOpEXT-None-03351# The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-extendedDynamicState extendedDynamicState>
--     feature /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdSetStencilOpEXT-commandBuffer-parameter# @commandBuffer@
--     /must/ be a valid 'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdSetStencilOpEXT-faceMask-parameter# @faceMask@ /must/ be
--     a valid combination of
--     'Vulkan.Core10.Enums.StencilFaceFlagBits.StencilFaceFlagBits' values
--
-- -   #VUID-vkCmdSetStencilOpEXT-faceMask-requiredbitmask# @faceMask@
--     /must/ not be @0@
--
-- -   #VUID-vkCmdSetStencilOpEXT-failOp-parameter# @failOp@ /must/ be a
--     valid 'Vulkan.Core10.Enums.StencilOp.StencilOp' value
--
-- -   #VUID-vkCmdSetStencilOpEXT-passOp-parameter# @passOp@ /must/ be a
--     valid 'Vulkan.Core10.Enums.StencilOp.StencilOp' value
--
-- -   #VUID-vkCmdSetStencilOpEXT-depthFailOp-parameter# @depthFailOp@
--     /must/ be a valid 'Vulkan.Core10.Enums.StencilOp.StencilOp' value
--
-- -   #VUID-vkCmdSetStencilOpEXT-compareOp-parameter# @compareOp@ /must/
--     be a valid 'Vulkan.Core10.Enums.CompareOp.CompareOp' value
--
-- -   #VUID-vkCmdSetStencilOpEXT-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-vkCmdSetStencilOpEXT-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- == 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_extended_dynamic_state VK_EXT_extended_dynamic_state>,
-- 'Vulkan.Core10.Handles.CommandBuffer',
-- 'Vulkan.Core10.Enums.CompareOp.CompareOp',
-- 'Vulkan.Core10.Enums.StencilFaceFlagBits.StencilFaceFlags',
-- 'Vulkan.Core10.Enums.StencilOp.StencilOp'
cmdSetStencilOpEXT :: forall io
                    . (MonadIO io)
                   => -- | @commandBuffer@ is the command buffer into which the command will be
                      -- recorded.
                      CommandBuffer
                   -> -- | @faceMask@ is a bitmask of
                      -- 'Vulkan.Core10.Enums.StencilFaceFlagBits.StencilFaceFlagBits' specifying
                      -- the set of stencil state for which to update the stencil operation.
                      ("faceMask" ::: StencilFaceFlags)
                   -> -- | @failOp@ is a 'Vulkan.Core10.Enums.StencilOp.StencilOp' value specifying
                      -- the action performed on samples that fail the stencil test.
                      ("failOp" ::: StencilOp)
                   -> -- | @passOp@ is a 'Vulkan.Core10.Enums.StencilOp.StencilOp' value specifying
                      -- the action performed on samples that pass both the depth and stencil
                      -- tests.
                      ("passOp" ::: StencilOp)
                   -> -- | @depthFailOp@ is a 'Vulkan.Core10.Enums.StencilOp.StencilOp' value
                      -- specifying the action performed on samples that pass the stencil test
                      -- and fail the depth test.
                      ("depthFailOp" ::: StencilOp)
                   -> -- | @compareOp@ is a 'Vulkan.Core10.Enums.CompareOp.CompareOp' value
                      -- specifying the comparison operator used in the stencil test.
                      CompareOp
                   -> io ()
cmdSetStencilOpEXT :: CommandBuffer
-> ("faceMask" ::: StencilFaceFlags)
-> ("failOp" ::: StencilOp)
-> ("failOp" ::: StencilOp)
-> ("failOp" ::: StencilOp)
-> ("depthCompareOp" ::: CompareOp)
-> io ()
cmdSetStencilOpEXT CommandBuffer
commandBuffer "faceMask" ::: StencilFaceFlags
faceMask "failOp" ::: StencilOp
failOp "failOp" ::: StencilOp
passOp "failOp" ::: StencilOp
depthFailOp "depthCompareOp" ::: CompareOp
compareOp = 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 vkCmdSetStencilOpEXTPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("faceMask" ::: StencilFaceFlags)
   -> ("failOp" ::: StencilOp)
   -> ("failOp" ::: StencilOp)
   -> ("failOp" ::: StencilOp)
   -> ("depthCompareOp" ::: CompareOp)
   -> IO ())
vkCmdSetStencilOpEXTPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("faceMask" ::: StencilFaceFlags)
      -> ("failOp" ::: StencilOp)
      -> ("failOp" ::: StencilOp)
      -> ("failOp" ::: StencilOp)
      -> ("depthCompareOp" ::: CompareOp)
      -> IO ())
pVkCmdSetStencilOpEXT (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
   -> ("faceMask" ::: StencilFaceFlags)
   -> ("failOp" ::: StencilOp)
   -> ("failOp" ::: StencilOp)
   -> ("failOp" ::: StencilOp)
   -> ("depthCompareOp" ::: CompareOp)
   -> IO ())
vkCmdSetStencilOpEXTPtr FunPtr
  (Ptr CommandBuffer_T
   -> ("faceMask" ::: StencilFaceFlags)
   -> ("failOp" ::: StencilOp)
   -> ("failOp" ::: StencilOp)
   -> ("failOp" ::: StencilOp)
   -> ("depthCompareOp" ::: CompareOp)
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("faceMask" ::: StencilFaceFlags)
      -> ("failOp" ::: StencilOp)
      -> ("failOp" ::: StencilOp)
      -> ("failOp" ::: StencilOp)
      -> ("depthCompareOp" ::: CompareOp)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("faceMask" ::: StencilFaceFlags)
   -> ("failOp" ::: StencilOp)
   -> ("failOp" ::: StencilOp)
   -> ("failOp" ::: StencilOp)
   -> ("depthCompareOp" ::: CompareOp)
   -> 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 vkCmdSetStencilOpEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdSetStencilOpEXT' :: Ptr CommandBuffer_T
-> ("faceMask" ::: StencilFaceFlags)
-> ("failOp" ::: StencilOp)
-> ("failOp" ::: StencilOp)
-> ("failOp" ::: StencilOp)
-> ("depthCompareOp" ::: CompareOp)
-> IO ()
vkCmdSetStencilOpEXT' = FunPtr
  (Ptr CommandBuffer_T
   -> ("faceMask" ::: StencilFaceFlags)
   -> ("failOp" ::: StencilOp)
   -> ("failOp" ::: StencilOp)
   -> ("failOp" ::: StencilOp)
   -> ("depthCompareOp" ::: CompareOp)
   -> IO ())
-> Ptr CommandBuffer_T
-> ("faceMask" ::: StencilFaceFlags)
-> ("failOp" ::: StencilOp)
-> ("failOp" ::: StencilOp)
-> ("failOp" ::: StencilOp)
-> ("depthCompareOp" ::: CompareOp)
-> IO ()
mkVkCmdSetStencilOpEXT FunPtr
  (Ptr CommandBuffer_T
   -> ("faceMask" ::: StencilFaceFlags)
   -> ("failOp" ::: StencilOp)
   -> ("failOp" ::: StencilOp)
   -> ("failOp" ::: StencilOp)
   -> ("depthCompareOp" ::: CompareOp)
   -> IO ())
vkCmdSetStencilOpEXTPtr
  String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdSetStencilOpEXT" (Ptr CommandBuffer_T
-> ("faceMask" ::: StencilFaceFlags)
-> ("failOp" ::: StencilOp)
-> ("failOp" ::: StencilOp)
-> ("failOp" ::: StencilOp)
-> ("depthCompareOp" ::: CompareOp)
-> IO ()
vkCmdSetStencilOpEXT' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) ("faceMask" ::: StencilFaceFlags
faceMask) ("failOp" ::: StencilOp
failOp) ("failOp" ::: StencilOp
passOp) ("failOp" ::: StencilOp
depthFailOp) ("depthCompareOp" ::: CompareOp
compareOp))
  () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ ()


-- | VkPhysicalDeviceExtendedDynamicStateFeaturesEXT - Structure describing
-- what extended dynamic state can be used
--
-- = Members
--
-- This structure describes the following feature:
--
-- = Description
--
-- If the 'PhysicalDeviceExtendedDynamicStateFeaturesEXT' 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. 'PhysicalDeviceExtendedDynamicStateFeaturesEXT' /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_extended_dynamic_state VK_EXT_extended_dynamic_state>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceExtendedDynamicStateFeaturesEXT = PhysicalDeviceExtendedDynamicStateFeaturesEXT
  { -- | #features-extendedDynamicState# @extendedDynamicState@ indicates that
    -- the implementation supports the following dynamic states:
    --
    -- -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_CULL_MODE_EXT'
    --
    -- -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_FRONT_FACE_EXT'
    --
    -- -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_PRIMITIVE_TOPOLOGY_EXT'
    --
    -- -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VIEWPORT_WITH_COUNT_EXT'
    --
    -- -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_SCISSOR_WITH_COUNT_EXT'
    --
    -- -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_VERTEX_INPUT_BINDING_STRIDE_EXT'
    --
    -- -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_DEPTH_TEST_ENABLE_EXT'
    --
    -- -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_DEPTH_WRITE_ENABLE_EXT'
    --
    -- -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_DEPTH_COMPARE_OP_EXT'
    --
    -- -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_DEPTH_BOUNDS_TEST_ENABLE_EXT'
    --
    -- -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_STENCIL_TEST_ENABLE_EXT'
    --
    -- -   'Vulkan.Core10.Enums.DynamicState.DYNAMIC_STATE_STENCIL_OP_EXT'
    PhysicalDeviceExtendedDynamicStateFeaturesEXT -> Bool
extendedDynamicState :: Bool }
  deriving (Typeable, PhysicalDeviceExtendedDynamicStateFeaturesEXT
-> PhysicalDeviceExtendedDynamicStateFeaturesEXT -> Bool
(PhysicalDeviceExtendedDynamicStateFeaturesEXT
 -> PhysicalDeviceExtendedDynamicStateFeaturesEXT -> Bool)
-> (PhysicalDeviceExtendedDynamicStateFeaturesEXT
    -> PhysicalDeviceExtendedDynamicStateFeaturesEXT -> Bool)
-> Eq PhysicalDeviceExtendedDynamicStateFeaturesEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceExtendedDynamicStateFeaturesEXT
-> PhysicalDeviceExtendedDynamicStateFeaturesEXT -> Bool
$c/= :: PhysicalDeviceExtendedDynamicStateFeaturesEXT
-> PhysicalDeviceExtendedDynamicStateFeaturesEXT -> Bool
== :: PhysicalDeviceExtendedDynamicStateFeaturesEXT
-> PhysicalDeviceExtendedDynamicStateFeaturesEXT -> Bool
$c== :: PhysicalDeviceExtendedDynamicStateFeaturesEXT
-> PhysicalDeviceExtendedDynamicStateFeaturesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceExtendedDynamicStateFeaturesEXT)
#endif
deriving instance Show PhysicalDeviceExtendedDynamicStateFeaturesEXT

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

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

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

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


type EXT_EXTENDED_DYNAMIC_STATE_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_EXT_EXTENDED_DYNAMIC_STATE_SPEC_VERSION"
pattern EXT_EXTENDED_DYNAMIC_STATE_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_EXTENDED_DYNAMIC_STATE_SPEC_VERSION :: a
$mEXT_EXTENDED_DYNAMIC_STATE_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
EXT_EXTENDED_DYNAMIC_STATE_SPEC_VERSION = 1


type EXT_EXTENDED_DYNAMIC_STATE_EXTENSION_NAME = "VK_EXT_extended_dynamic_state"

-- No documentation found for TopLevel "VK_EXT_EXTENDED_DYNAMIC_STATE_EXTENSION_NAME"
pattern EXT_EXTENDED_DYNAMIC_STATE_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_EXTENDED_DYNAMIC_STATE_EXTENSION_NAME :: a
$mEXT_EXTENDED_DYNAMIC_STATE_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
EXT_EXTENDED_DYNAMIC_STATE_EXTENSION_NAME = "VK_EXT_extended_dynamic_state"