{-# language CPP #-}
-- | = Name
--
-- VK_NV_device_generated_commands_compute - device extension
--
-- == VK_NV_device_generated_commands_compute
--
-- [__Name String__]
--     @VK_NV_device_generated_commands_compute@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     429
--
-- [__Revision__]
--     2
--
-- [__Ratification Status__]
--     Not ratified
--
-- [__Extension and Version Dependencies__]
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_device_generated_commands VK_NV_device_generated_commands>
--
-- [__Contact__]
--
--     -   Vikram Kushwaha
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_NV_device_generated_commands_compute] @vkushwaha-nv%0A*Here describe the issue or question you have about the VK_NV_device_generated_commands_compute extension* >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2023-07-21
--
-- [__Contributors__]
--
--     -   Vikram Kushwaha, NVIDIA
--
--     -   Jeff Bolz, NVIDIA
--
--     -   Christoph Kubisch, NVIDIA
--
--     -   Piers Daniell, NVIDIA
--
--     -   Daniel Koch, NVIDIA
--
--     -   Hans-Kristian Arntzen, Valve
--
--     -   Mike Blumenkrantz, VALVE
--
-- == Description
--
-- This extension allows the device to generate commands for binding
-- compute pipelines, setting push constants and launching compute
-- dispatches.
--
-- == New Commands
--
-- -   'cmdUpdatePipelineIndirectBufferNV'
--
-- -   'getPipelineIndirectDeviceAddressNV'
--
-- -   'getPipelineIndirectMemoryRequirementsNV'
--
-- == New Structures
--
-- -   'BindPipelineIndirectCommandNV'
--
-- -   'ComputePipelineIndirectBufferInfoNV'
--
-- -   'PipelineIndirectDeviceAddressInfoNV'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV'
--
-- == New Enum Constants
--
-- -   'NV_DEVICE_GENERATED_COMMANDS_COMPUTE_EXTENSION_NAME'
--
-- -   'NV_DEVICE_GENERATED_COMMANDS_COMPUTE_SPEC_VERSION'
--
-- -   Extending
--     'Vulkan.Core10.Enums.DescriptorSetLayoutCreateFlagBits.DescriptorSetLayoutCreateFlagBits':
--
--     -   'Vulkan.Core10.Enums.DescriptorSetLayoutCreateFlagBits.DESCRIPTOR_SET_LAYOUT_CREATE_INDIRECT_BINDABLE_BIT_NV'
--
-- -   Extending
--     'Vulkan.Extensions.VK_NV_device_generated_commands.IndirectCommandsTokenTypeNV':
--
--     -   'Vulkan.Extensions.VK_NV_device_generated_commands.INDIRECT_COMMANDS_TOKEN_TYPE_DISPATCH_NV'
--
--     -   'Vulkan.Extensions.VK_NV_device_generated_commands.INDIRECT_COMMANDS_TOKEN_TYPE_PIPELINE_NV'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_COMPUTE_PIPELINE_INDIRECT_BUFFER_INFO_NV'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_DEVICE_GENERATED_COMMANDS_COMPUTE_FEATURES_NV'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PIPELINE_INDIRECT_DEVICE_ADDRESS_INFO_NV'
--
-- == Version History
--
-- -   Revision 2, 2023-07-21 (Vikram Kushwaha)
--
--     -   Rename vkCmdUpdatePipelineIndirectBuffer to
--         vkCmdUpdatePipelineIndirectBufferNV
--
-- -   Revision 1, 2023-06-09 (Vikram Kushwaha)
--
--     -   First Revision
--
-- == See Also
--
-- 'BindPipelineIndirectCommandNV', 'ComputePipelineIndirectBufferInfoNV',
-- 'PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV',
-- 'PipelineIndirectDeviceAddressInfoNV',
-- 'cmdUpdatePipelineIndirectBufferNV',
-- 'getPipelineIndirectDeviceAddressNV',
-- 'getPipelineIndirectMemoryRequirementsNV'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_NV_device_generated_commands_compute Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_NV_device_generated_commands_compute  ( cmdUpdatePipelineIndirectBufferNV
                                                                  , getPipelineIndirectMemoryRequirementsNV
                                                                  , getPipelineIndirectDeviceAddressNV
                                                                  , ComputePipelineIndirectBufferInfoNV(..)
                                                                  , PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV(..)
                                                                  , PipelineIndirectDeviceAddressInfoNV(..)
                                                                  , BindPipelineIndirectCommandNV(..)
                                                                  , NV_DEVICE_GENERATED_COMMANDS_COMPUTE_SPEC_VERSION
                                                                  , pattern NV_DEVICE_GENERATED_COMMANDS_COMPUTE_SPEC_VERSION
                                                                  , NV_DEVICE_GENERATED_COMMANDS_COMPUTE_EXTENSION_NAME
                                                                  , pattern NV_DEVICE_GENERATED_COMMANDS_COMPUTE_EXTENSION_NAME
                                                                  , IndirectCommandsTokenTypeNV(..)
                                                                  ) 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 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.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.CStruct.Extends (forgetExtensions)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Handles (CommandBuffer)
import Vulkan.Core10.Handles (CommandBuffer(..))
import Vulkan.Core10.Handles (CommandBuffer(CommandBuffer))
import Vulkan.Core10.Handles (CommandBuffer_T)
import Vulkan.Core10.Pipeline (ComputePipelineCreateInfo)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Core10.FundamentalTypes (DeviceAddress)
import Vulkan.Dynamic (DeviceCmds(pVkCmdUpdatePipelineIndirectBufferNV))
import Vulkan.Dynamic (DeviceCmds(pVkGetPipelineIndirectDeviceAddressNV))
import Vulkan.Dynamic (DeviceCmds(pVkGetPipelineIndirectMemoryRequirementsNV))
import Vulkan.Core10.FundamentalTypes (DeviceSize)
import Vulkan.Core10.Handles (Device_T)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.Core11.Promoted_From_VK_KHR_get_memory_requirements2 (MemoryRequirements2)
import Vulkan.CStruct.Extends (PeekChain)
import Vulkan.Core10.Handles (Pipeline)
import Vulkan.Core10.Handles (Pipeline(..))
import Vulkan.Core10.Enums.PipelineBindPoint (PipelineBindPoint)
import Vulkan.Core10.Enums.PipelineBindPoint (PipelineBindPoint(..))
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_COMPUTE_PIPELINE_INDIRECT_BUFFER_INFO_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_DEVICE_GENERATED_COMMANDS_COMPUTE_FEATURES_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_INDIRECT_DEVICE_ADDRESS_INFO_NV))
import Vulkan.Extensions.VK_NV_device_generated_commands (IndirectCommandsTokenTypeNV(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdUpdatePipelineIndirectBufferNV
  :: FunPtr (Ptr CommandBuffer_T -> PipelineBindPoint -> Pipeline -> IO ()) -> Ptr CommandBuffer_T -> PipelineBindPoint -> Pipeline -> IO ()

-- | vkCmdUpdatePipelineIndirectBufferNV - Update the indirect compute
-- pipeline’s metadata
--
-- = Description
--
-- 'cmdUpdatePipelineIndirectBufferNV' is only allowed outside of a render
-- pass. This command is treated as a “transfer” operation for the purposes
-- of synchronization barriers. The writes to the address /must/ be
-- synchronized using stages
-- 'Vulkan.Core13.Enums.PipelineStageFlags2.PIPELINE_STAGE_2_COPY_BIT' and
-- 'Vulkan.Core10.Enums.PipelineStageFlagBits.PIPELINE_STAGE_COMMAND_PREPROCESS_BIT_NV'
-- and with access masks
-- 'Vulkan.Core10.Enums.AccessFlagBits.ACCESS_MEMORY_WRITE_BIT' and
-- 'Vulkan.Core10.Enums.AccessFlagBits.ACCESS_COMMAND_PREPROCESS_READ_BIT_NV'
-- respectively before using the results in preprocessing.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdUpdatePipelineIndirectBufferNV-pipelineBindPoint-09018#
--     @pipelineBindPoint@ /must/ be
--     'Vulkan.Core10.Enums.PipelineBindPoint.PIPELINE_BIND_POINT_COMPUTE'
--
-- -   #VUID-vkCmdUpdatePipelineIndirectBufferNV-pipeline-09019# @pipeline@
--     /must/ have been created with
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_INDIRECT_BINDABLE_BIT_NV'
--     flag set
--
-- -   #VUID-vkCmdUpdatePipelineIndirectBufferNV-pipeline-09020# @pipeline@
--     /must/ have been created with 'ComputePipelineIndirectBufferInfoNV'
--     structure specifying a valid address where its metadata will be
--     saved
--
-- -   #VUID-vkCmdUpdatePipelineIndirectBufferNV-deviceGeneratedComputePipelines-09021#
--     The
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-deviceGeneratedComputePipelines ::deviceGeneratedComputePipelines>
--     feature /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdUpdatePipelineIndirectBufferNV-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdUpdatePipelineIndirectBufferNV-pipelineBindPoint-parameter#
--     @pipelineBindPoint@ /must/ be a valid
--     'Vulkan.Core10.Enums.PipelineBindPoint.PipelineBindPoint' value
--
-- -   #VUID-vkCmdUpdatePipelineIndirectBufferNV-pipeline-parameter#
--     @pipeline@ /must/ be a valid 'Vulkan.Core10.Handles.Pipeline' handle
--
-- -   #VUID-vkCmdUpdatePipelineIndirectBufferNV-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-vkCmdUpdatePipelineIndirectBufferNV-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support transfer, graphics, or compute
--     operations
--
-- -   #VUID-vkCmdUpdatePipelineIndirectBufferNV-renderpass# This command
--     /must/ only be called outside of a render pass instance
--
-- -   #VUID-vkCmdUpdatePipelineIndirectBufferNV-videocoding# This command
--     /must/ only be called outside of a video coding scope
--
-- -   #VUID-vkCmdUpdatePipelineIndirectBufferNV-commonparent# Both of
--     @commandBuffer@, and @pipeline@ /must/ have been created, allocated,
--     or retrieved from the same 'Vulkan.Core10.Handles.Device'
--
-- == Host Synchronization
--
-- -   Host access to @commandBuffer@ /must/ be externally synchronized
--
-- -   Host access to the 'Vulkan.Core10.Handles.CommandPool' that
--     @commandBuffer@ was allocated from /must/ be externally synchronized
--
-- == Command Properties
--
-- \'
--
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
-- | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkCommandBufferLevel Command Buffer Levels> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginRenderPass Render Pass Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginVideoCodingKHR Video Coding Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkQueueFlagBits Supported Queue Types> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-queueoperation-command-types Command Type> |
-- +============================================================================================================================+========================================================================================================================+=============================================================================================================================+=======================================================================================================================+========================================================================================================================================+
-- | Primary                                                                                                                    | Outside                                                                                                                | Outside                                                                                                                     | Transfer                                                                                                              | Action                                                                                                                                 |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                             | Graphics                                                                                                              |                                                                                                                                        |
-- |                                                                                                                            |                                                                                                                        |                                                                                                                             | Compute                                                                                                               |                                                                                                                                        |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_device_generated_commands_compute VK_NV_device_generated_commands_compute>,
-- 'Vulkan.Core10.Handles.CommandBuffer', 'Vulkan.Core10.Handles.Pipeline',
-- 'Vulkan.Core10.Enums.PipelineBindPoint.PipelineBindPoint'
cmdUpdatePipelineIndirectBufferNV :: forall io
                                   . (MonadIO io)
                                  => -- | @commandBuffer@ is the command buffer into which the command will be
                                     -- recorded.
                                     CommandBuffer
                                  -> -- | @pipelineBindPoint@ is a
                                     -- 'Vulkan.Core10.Enums.PipelineBindPoint.PipelineBindPoint' value
                                     -- specifying the type of pipeline whose metadata will be saved.
                                     PipelineBindPoint
                                  -> -- | @pipeline@ is the pipeline whose metadata will be saved.
                                     Pipeline
                                  -> io ()
cmdUpdatePipelineIndirectBufferNV :: forall (io :: * -> *).
MonadIO io =>
CommandBuffer -> PipelineBindPoint -> Pipeline -> io ()
cmdUpdatePipelineIndirectBufferNV CommandBuffer
commandBuffer
                                    PipelineBindPoint
pipelineBindPoint
                                    Pipeline
pipeline = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  let vkCmdUpdatePipelineIndirectBufferNVPtr :: FunPtr
  (Ptr CommandBuffer_T -> PipelineBindPoint -> Pipeline -> IO ())
vkCmdUpdatePipelineIndirectBufferNVPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T -> PipelineBindPoint -> Pipeline -> IO ())
pVkCmdUpdatePipelineIndirectBufferNV (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr CommandBuffer_T -> PipelineBindPoint -> Pipeline -> IO ())
vkCmdUpdatePipelineIndirectBufferNVPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCmdUpdatePipelineIndirectBufferNV is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkCmdUpdatePipelineIndirectBufferNV' :: Ptr CommandBuffer_T -> PipelineBindPoint -> Pipeline -> IO ()
vkCmdUpdatePipelineIndirectBufferNV' = FunPtr
  (Ptr CommandBuffer_T -> PipelineBindPoint -> Pipeline -> IO ())
-> Ptr CommandBuffer_T -> PipelineBindPoint -> Pipeline -> IO ()
mkVkCmdUpdatePipelineIndirectBufferNV FunPtr
  (Ptr CommandBuffer_T -> PipelineBindPoint -> Pipeline -> IO ())
vkCmdUpdatePipelineIndirectBufferNVPtr
  forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdUpdatePipelineIndirectBufferNV" (Ptr CommandBuffer_T -> PipelineBindPoint -> Pipeline -> IO ()
vkCmdUpdatePipelineIndirectBufferNV'
                                                            (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer))
                                                            (PipelineBindPoint
pipelineBindPoint)
                                                            (Pipeline
pipeline))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ()


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetPipelineIndirectMemoryRequirementsNV
  :: FunPtr (Ptr Device_T -> Ptr (SomeStruct ComputePipelineCreateInfo) -> Ptr (SomeStruct MemoryRequirements2) -> IO ()) -> Ptr Device_T -> Ptr (SomeStruct ComputePipelineCreateInfo) -> Ptr (SomeStruct MemoryRequirements2) -> IO ()

-- | vkGetPipelineIndirectMemoryRequirementsNV - Get the memory requirements
-- for the compute indirect pipeline
--
-- = Description
--
-- If @pCreateInfo@::@pNext@ chain includes a pointer to a
-- 'ComputePipelineIndirectBufferInfoNV' structure, then the contents of
-- that structure are ignored.
--
-- == Valid Usage
--
-- -   #VUID-vkGetPipelineIndirectMemoryRequirementsNV-deviceGeneratedComputePipelines-09082#
--     The
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-deviceGeneratedComputePipelines ::deviceGeneratedComputePipelines>
--     feature /must/ be enabled
--
-- -   #VUID-vkGetPipelineIndirectMemoryRequirementsNV-pCreateInfo-09083#
--     @pCreateInfo@::@flags@ /must/ include
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_INDIRECT_BINDABLE_BIT_NV'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkGetPipelineIndirectMemoryRequirementsNV-device-parameter#
--     @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkGetPipelineIndirectMemoryRequirementsNV-pCreateInfo-parameter#
--     @pCreateInfo@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.Pipeline.ComputePipelineCreateInfo' structure
--
-- -   #VUID-vkGetPipelineIndirectMemoryRequirementsNV-pMemoryRequirements-parameter#
--     @pMemoryRequirements@ /must/ be a valid pointer to a
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_memory_requirements2.MemoryRequirements2'
--     structure
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_device_generated_commands_compute VK_NV_device_generated_commands_compute>,
-- 'Vulkan.Core10.Pipeline.ComputePipelineCreateInfo',
-- 'Vulkan.Core10.Handles.Device',
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_memory_requirements2.MemoryRequirements2'
getPipelineIndirectMemoryRequirementsNV :: forall a b io
                                         . ( Extendss ComputePipelineCreateInfo a
                                           , PokeChain a
                                           , Extendss MemoryRequirements2 b
                                           , PokeChain b
                                           , PeekChain b
                                           , MonadIO io )
                                        => -- | @device@ is the logical device that owns the buffer.
                                           Device
                                        -> -- | @pCreateInfo@ is a 'Vulkan.Core10.Pipeline.ComputePipelineCreateInfo'
                                           -- structure specifying the creation parameters of the compute pipeline
                                           -- whose memory requirements are being queried.
                                           (ComputePipelineCreateInfo a)
                                        -> io (MemoryRequirements2 b)
getPipelineIndirectMemoryRequirementsNV :: forall (a :: [*]) (b :: [*]) (io :: * -> *).
(Extendss ComputePipelineCreateInfo a, PokeChain a,
 Extendss MemoryRequirements2 b, PokeChain b, PeekChain b,
 MonadIO io) =>
Device -> ComputePipelineCreateInfo a -> io (MemoryRequirements2 b)
getPipelineIndirectMemoryRequirementsNV Device
device
                                          ComputePipelineCreateInfo a
createInfo = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
  let vkGetPipelineIndirectMemoryRequirementsNVPtr :: FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
   -> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
   -> IO ())
vkGetPipelineIndirectMemoryRequirementsNVPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pCreateInfo" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
      -> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
      -> IO ())
pVkGetPipelineIndirectMemoryRequirementsNV (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
   -> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
   -> IO ())
vkGetPipelineIndirectMemoryRequirementsNVPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetPipelineIndirectMemoryRequirementsNV is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkGetPipelineIndirectMemoryRequirementsNV' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
-> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
-> IO ()
vkGetPipelineIndirectMemoryRequirementsNV' = FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
   -> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
   -> IO ())
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
-> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
-> IO ()
mkVkGetPipelineIndirectMemoryRequirementsNV FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
   -> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
   -> IO ())
vkGetPipelineIndirectMemoryRequirementsNVPtr
  Ptr (ComputePipelineCreateInfo a)
pCreateInfo <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (ComputePipelineCreateInfo a
createInfo)
  Ptr (MemoryRequirements2 b)
pPMemoryRequirements <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @(MemoryRequirements2 _))
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPipelineIndirectMemoryRequirementsNV" (Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct ComputePipelineCreateInfo))
-> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
-> IO ()
vkGetPipelineIndirectMemoryRequirementsNV'
                                                                         (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                                         (forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (ComputePipelineCreateInfo a)
pCreateInfo)
                                                                         (forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (MemoryRequirements2 b)
pPMemoryRequirements)))
  MemoryRequirements2 b
pMemoryRequirements <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @(MemoryRequirements2 _) Ptr (MemoryRequirements2 b)
pPMemoryRequirements
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (MemoryRequirements2 b
pMemoryRequirements)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetPipelineIndirectDeviceAddressNV
  :: FunPtr (Ptr Device_T -> Ptr PipelineIndirectDeviceAddressInfoNV -> IO DeviceAddress) -> Ptr Device_T -> Ptr PipelineIndirectDeviceAddressInfoNV -> IO DeviceAddress

-- | vkGetPipelineIndirectDeviceAddressNV - Get pipeline’s 64-bit device
-- address
--
-- == Valid Usage
--
-- -   #VUID-vkGetPipelineIndirectDeviceAddressNV-deviceGeneratedComputePipelines-09078#
--     The
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-deviceGeneratedComputePipelines ::deviceGeneratedComputePipelines>
--     feature /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_device_generated_commands_compute VK_NV_device_generated_commands_compute>,
-- 'Vulkan.Core10.Handles.Device', 'PipelineIndirectDeviceAddressInfoNV'
getPipelineIndirectDeviceAddressNV :: forall io
                                    . (MonadIO io)
                                   => -- | #VUID-vkGetPipelineIndirectDeviceAddressNV-device-parameter# @device@
                                      -- /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
                                      Device
                                   -> -- | #VUID-vkGetPipelineIndirectDeviceAddressNV-pInfo-parameter# @pInfo@
                                      -- /must/ be a valid pointer to a valid
                                      -- 'PipelineIndirectDeviceAddressInfoNV' structure
                                      PipelineIndirectDeviceAddressInfoNV
                                   -> io (DeviceAddress)
getPipelineIndirectDeviceAddressNV :: forall (io :: * -> *).
MonadIO io =>
Device -> PipelineIndirectDeviceAddressInfoNV -> io DeviceAddress
getPipelineIndirectDeviceAddressNV Device
device PipelineIndirectDeviceAddressInfoNV
info = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
  let vkGetPipelineIndirectDeviceAddressNVPtr :: FunPtr
  (Ptr Device_T
   -> ("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV)
   -> IO DeviceAddress)
vkGetPipelineIndirectDeviceAddressNVPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV)
      -> IO DeviceAddress)
pVkGetPipelineIndirectDeviceAddressNV (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV)
   -> IO DeviceAddress)
vkGetPipelineIndirectDeviceAddressNVPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetPipelineIndirectDeviceAddressNV is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkGetPipelineIndirectDeviceAddressNV' :: Ptr Device_T
-> ("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV)
-> IO DeviceAddress
vkGetPipelineIndirectDeviceAddressNV' = FunPtr
  (Ptr Device_T
   -> ("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV)
   -> IO DeviceAddress)
-> Ptr Device_T
-> ("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV)
-> IO DeviceAddress
mkVkGetPipelineIndirectDeviceAddressNV FunPtr
  (Ptr Device_T
   -> ("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV)
   -> IO DeviceAddress)
vkGetPipelineIndirectDeviceAddressNVPtr
  "pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
pInfo <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (PipelineIndirectDeviceAddressInfoNV
info)
  DeviceAddress
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPipelineIndirectDeviceAddressNV" (Ptr Device_T
-> ("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV)
-> IO DeviceAddress
vkGetPipelineIndirectDeviceAddressNV'
                                                                         (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                                         "pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
pInfo)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (DeviceAddress
r)


-- | VkComputePipelineIndirectBufferInfoNV - Structure describing the device
-- address where pipeline’s metadata will be saved
--
-- = Members
--
-- If @pipelineDeviceAddressCaptureReplay@ is zero, no specific address is
-- requested. If @pipelineDeviceAddressCaptureReplay@ is not zero, then it
-- /must/ be an address retrieved from an identically created pipeline on
-- the same implementation. The pipeline metadata /must/ also be placed on
-- an identically created buffer and at the same offset using the
-- 'cmdUpdatePipelineIndirectBufferNV' command.
--
-- == Valid Usage
--
-- -   #VUID-VkComputePipelineIndirectBufferInfoNV-deviceGeneratedComputePipelines-09009#
--     The
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-deviceGeneratedComputePipelines ::deviceGeneratedComputePipelines>
--     feature /must/ be enabled
--
-- -   #VUID-VkComputePipelineIndirectBufferInfoNV-flags-09010# The
--     pipeline creation flags in
--     'Vulkan.Core10.Pipeline.ComputePipelineCreateInfo'::@flags@ /must/
--     include
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_INDIRECT_BINDABLE_BIT_NV'
--
-- -   #VUID-VkComputePipelineIndirectBufferInfoNV-deviceAddress-09011#
--     @deviceAddress@ /must/ be aligned to the
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_memory_requirements2.MemoryRequirements2'::@alignment@,
--     as returned by 'getPipelineIndirectMemoryRequirementsNV'
--
-- -   #VUID-VkComputePipelineIndirectBufferInfoNV-deviceAddress-09012#
--     @deviceAddress@ /must/ have been allocated from a buffer that was
--     created with usage
--     'Vulkan.Core10.Enums.BufferUsageFlagBits.BUFFER_USAGE_TRANSFER_DST_BIT'
--     and
--     'Vulkan.Core10.Enums.BufferUsageFlagBits.BUFFER_USAGE_INDIRECT_BUFFER_BIT'
--
-- -   #VUID-VkComputePipelineIndirectBufferInfoNV-size-09013# @size@
--     /must/ be greater than or equal to the
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_memory_requirements2.MemoryRequirements2'::@size@,
--     as returned by 'getPipelineIndirectMemoryRequirementsNV'
--
-- -   #VUID-VkComputePipelineIndirectBufferInfoNV-pipelineDeviceAddressCaptureReplay-09014#
--     If @pipelineDeviceAddressCaptureReplay@ is non-zero then the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-deviceGeneratedComputePipelines ::deviceGeneratedComputeCaptureReplay>
--     feature /must/ be enabled
--
-- -   #VUID-VkComputePipelineIndirectBufferInfoNV-pipelineDeviceAddressCaptureReplay-09015#
--     If @pipelineDeviceAddressCaptureReplay@ is non-zero then that
--     address /must/ have been allocated with flag
--     'Vulkan.Core11.Enums.MemoryAllocateFlagBits.MEMORY_ALLOCATE_DEVICE_ADDRESS_CAPTURE_REPLAY_BIT'
--     set
--
-- -   #VUID-VkComputePipelineIndirectBufferInfoNV-pipelineDeviceAddressCaptureReplay-09016#
--     If @pipelineDeviceAddressCaptureReplay@ is non-zero, the @pipeline@
--     /must/ have been recreated for replay
--
-- -   #VUID-VkComputePipelineIndirectBufferInfoNV-pipelineDeviceAddressCaptureReplay-09017#
--     @pipelineDeviceAddressCaptureReplay@ /must/ satisfy the @alignment@
--     and @size@ requirements similar to @deviceAddress@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkComputePipelineIndirectBufferInfoNV-sType-sType# @sType@
--     /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_COMPUTE_PIPELINE_INDIRECT_BUFFER_INFO_NV'
--
-- -   #VUID-VkComputePipelineIndirectBufferInfoNV-pNext-pNext# @pNext@
--     /must/ be @NULL@
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_device_generated_commands_compute VK_NV_device_generated_commands_compute>,
-- 'Vulkan.Core10.FundamentalTypes.DeviceAddress',
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data ComputePipelineIndirectBufferInfoNV = ComputePipelineIndirectBufferInfoNV
  { -- No documentation found for Nested "VkComputePipelineIndirectBufferInfoNV" "deviceAddress"
    ComputePipelineIndirectBufferInfoNV -> DeviceAddress
deviceAddress :: DeviceAddress
  , -- No documentation found for Nested "VkComputePipelineIndirectBufferInfoNV" "size"
    ComputePipelineIndirectBufferInfoNV -> DeviceAddress
size :: DeviceSize
  , -- No documentation found for Nested "VkComputePipelineIndirectBufferInfoNV" "pipelineDeviceAddressCaptureReplay"
    ComputePipelineIndirectBufferInfoNV -> DeviceAddress
pipelineDeviceAddressCaptureReplay :: DeviceAddress
  }
  deriving (Typeable, ComputePipelineIndirectBufferInfoNV
-> ComputePipelineIndirectBufferInfoNV -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComputePipelineIndirectBufferInfoNV
-> ComputePipelineIndirectBufferInfoNV -> Bool
$c/= :: ComputePipelineIndirectBufferInfoNV
-> ComputePipelineIndirectBufferInfoNV -> Bool
== :: ComputePipelineIndirectBufferInfoNV
-> ComputePipelineIndirectBufferInfoNV -> Bool
$c== :: ComputePipelineIndirectBufferInfoNV
-> ComputePipelineIndirectBufferInfoNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ComputePipelineIndirectBufferInfoNV)
#endif
deriving instance Show ComputePipelineIndirectBufferInfoNV

instance ToCStruct ComputePipelineIndirectBufferInfoNV where
  withCStruct :: forall b.
ComputePipelineIndirectBufferInfoNV
-> (Ptr ComputePipelineIndirectBufferInfoNV -> IO b) -> IO b
withCStruct ComputePipelineIndirectBufferInfoNV
x Ptr ComputePipelineIndirectBufferInfoNV -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 forall a b. (a -> b) -> a -> b
$ \Ptr ComputePipelineIndirectBufferInfoNV
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ComputePipelineIndirectBufferInfoNV
p ComputePipelineIndirectBufferInfoNV
x (Ptr ComputePipelineIndirectBufferInfoNV -> IO b
f Ptr ComputePipelineIndirectBufferInfoNV
p)
  pokeCStruct :: forall b.
Ptr ComputePipelineIndirectBufferInfoNV
-> ComputePipelineIndirectBufferInfoNV -> IO b -> IO b
pokeCStruct Ptr ComputePipelineIndirectBufferInfoNV
p ComputePipelineIndirectBufferInfoNV{DeviceAddress
pipelineDeviceAddressCaptureReplay :: DeviceAddress
size :: DeviceAddress
deviceAddress :: DeviceAddress
$sel:pipelineDeviceAddressCaptureReplay:ComputePipelineIndirectBufferInfoNV :: ComputePipelineIndirectBufferInfoNV -> DeviceAddress
$sel:size:ComputePipelineIndirectBufferInfoNV :: ComputePipelineIndirectBufferInfoNV -> DeviceAddress
$sel:deviceAddress:ComputePipelineIndirectBufferInfoNV :: ComputePipelineIndirectBufferInfoNV -> DeviceAddress
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComputePipelineIndirectBufferInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COMPUTE_PIPELINE_INDIRECT_BUFFER_INFO_NV)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComputePipelineIndirectBufferInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComputePipelineIndirectBufferInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceAddress)) (DeviceAddress
deviceAddress)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComputePipelineIndirectBufferInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DeviceSize)) (DeviceAddress
size)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComputePipelineIndirectBufferInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr DeviceAddress)) (DeviceAddress
pipelineDeviceAddressCaptureReplay)
    IO b
f
  cStructSize :: Int
cStructSize = Int
40
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr ComputePipelineIndirectBufferInfoNV -> IO b -> IO b
pokeZeroCStruct Ptr ComputePipelineIndirectBufferInfoNV
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComputePipelineIndirectBufferInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COMPUTE_PIPELINE_INDIRECT_BUFFER_INFO_NV)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComputePipelineIndirectBufferInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComputePipelineIndirectBufferInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceAddress)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComputePipelineIndirectBufferInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ComputePipelineIndirectBufferInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr DeviceAddress)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct ComputePipelineIndirectBufferInfoNV where
  peekCStruct :: Ptr ComputePipelineIndirectBufferInfoNV
-> IO ComputePipelineIndirectBufferInfoNV
peekCStruct Ptr ComputePipelineIndirectBufferInfoNV
p = do
    DeviceAddress
deviceAddress <- forall a. Storable a => Ptr a -> IO a
peek @DeviceAddress ((Ptr ComputePipelineIndirectBufferInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceAddress))
    DeviceAddress
size <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr ComputePipelineIndirectBufferInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DeviceSize))
    DeviceAddress
pipelineDeviceAddressCaptureReplay <- forall a. Storable a => Ptr a -> IO a
peek @DeviceAddress ((Ptr ComputePipelineIndirectBufferInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr DeviceAddress))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DeviceAddress
-> DeviceAddress
-> DeviceAddress
-> ComputePipelineIndirectBufferInfoNV
ComputePipelineIndirectBufferInfoNV
             DeviceAddress
deviceAddress DeviceAddress
size DeviceAddress
pipelineDeviceAddressCaptureReplay

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

instance Zero ComputePipelineIndirectBufferInfoNV where
  zero :: ComputePipelineIndirectBufferInfoNV
zero = DeviceAddress
-> DeviceAddress
-> DeviceAddress
-> ComputePipelineIndirectBufferInfoNV
ComputePipelineIndirectBufferInfoNV
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkPhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV - Structure
-- describing the device-generated compute features that can be supported
-- by an implementation
--
-- = Members
--
-- This structure describes the following features:
--
-- = Description
--
-- If the 'PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV'
-- 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. 'PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV'
-- /can/ also be used in the @pNext@ chain of
-- 'Vulkan.Core10.Device.DeviceCreateInfo' to selectively enable these
-- features.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_device_generated_commands_compute VK_NV_device_generated_commands_compute>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV = PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
  { -- | #features-deviceGeneratedCompute# @deviceGeneratedCompute@ indicates
    -- whether the implementation supports functionality to generate dispatch
    -- commands and push constants for the compute pipeline on the device. See
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#device-generated-commands Device-Generated Commands>.
    PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV -> Bool
deviceGeneratedCompute :: Bool
  , -- | #features-deviceGeneratedComputePipelines#
    -- @deviceGeneratedComputePipelines@ indicates whether the implementation
    -- supports functionality to generate commands to bind compute pipelines on
    -- the device. See
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#device-generated-commands Device-Generated Commands>.
    PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV -> Bool
deviceGeneratedComputePipelines :: Bool
  , -- | #features-deviceGeneratedComputeCaptureReplay#
    -- @deviceGeneratedComputeCaptureReplay@ indicates whether the
    -- implementation supports functionality to capture compute pipeline
    -- address and reuse later for replay in
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#device-generated-commands Device-Generated Commands>.
    PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV -> Bool
deviceGeneratedComputeCaptureReplay :: Bool
  }
  deriving (Typeable, PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
-> PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
-> PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV -> Bool
$c/= :: PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
-> PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV -> Bool
== :: PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
-> PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV -> Bool
$c== :: PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV
-> PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV)
#endif
deriving instance Show PhysicalDeviceDeviceGeneratedCommandsComputeFeaturesNV

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

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

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

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


-- | VkPipelineIndirectDeviceAddressInfoNV - Structure specifying the
-- pipeline to query an address for
--
-- == Valid Usage
--
-- -   #VUID-VkPipelineIndirectDeviceAddressInfoNV-pipelineBindPoint-09079#
--     The provided @pipelineBindPoint@ /must/ be of type
--     'Vulkan.Core10.Enums.PipelineBindPoint.PIPELINE_BIND_POINT_COMPUTE'
--
-- -   #VUID-VkPipelineIndirectDeviceAddressInfoNV-pipeline-09080#
--     @pipeline@ /must/ have been created with flag
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_INDIRECT_BINDABLE_BIT_NV'
--     set
--
-- -   #VUID-VkPipelineIndirectDeviceAddressInfoNV-pipeline-09081#
--     @pipeline@ /must/ have been created with a
--     'ComputePipelineIndirectBufferInfoNV' structure specifying a valid
--     address where its metadata will be saved
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_device_generated_commands_compute VK_NV_device_generated_commands_compute>,
-- 'Vulkan.Core10.Handles.Pipeline',
-- 'Vulkan.Core10.Enums.PipelineBindPoint.PipelineBindPoint',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'getPipelineIndirectDeviceAddressNV'
data PipelineIndirectDeviceAddressInfoNV = PipelineIndirectDeviceAddressInfoNV
  { -- | #VUID-VkPipelineIndirectDeviceAddressInfoNV-pipelineBindPoint-parameter#
    -- @pipelineBindPoint@ /must/ be a valid
    -- 'Vulkan.Core10.Enums.PipelineBindPoint.PipelineBindPoint' value
    PipelineIndirectDeviceAddressInfoNV -> PipelineBindPoint
pipelineBindPoint :: PipelineBindPoint
  , -- | #VUID-VkPipelineIndirectDeviceAddressInfoNV-pipeline-parameter#
    -- @pipeline@ /must/ be a valid 'Vulkan.Core10.Handles.Pipeline' handle
    PipelineIndirectDeviceAddressInfoNV -> Pipeline
pipeline :: Pipeline
  }
  deriving (Typeable, PipelineIndirectDeviceAddressInfoNV
-> PipelineIndirectDeviceAddressInfoNV -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PipelineIndirectDeviceAddressInfoNV
-> PipelineIndirectDeviceAddressInfoNV -> Bool
$c/= :: PipelineIndirectDeviceAddressInfoNV
-> PipelineIndirectDeviceAddressInfoNV -> Bool
== :: PipelineIndirectDeviceAddressInfoNV
-> PipelineIndirectDeviceAddressInfoNV -> Bool
$c== :: PipelineIndirectDeviceAddressInfoNV
-> PipelineIndirectDeviceAddressInfoNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineIndirectDeviceAddressInfoNV)
#endif
deriving instance Show PipelineIndirectDeviceAddressInfoNV

instance ToCStruct PipelineIndirectDeviceAddressInfoNV where
  withCStruct :: forall b.
PipelineIndirectDeviceAddressInfoNV
-> (("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV) -> IO b)
-> IO b
withCStruct PipelineIndirectDeviceAddressInfoNV
x ("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \"pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p PipelineIndirectDeviceAddressInfoNV
x (("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV) -> IO b
f "pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p)
  pokeCStruct :: forall b.
("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV)
-> PipelineIndirectDeviceAddressInfoNV -> IO b -> IO b
pokeCStruct "pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p PipelineIndirectDeviceAddressInfoNV{PipelineBindPoint
Pipeline
pipeline :: Pipeline
pipelineBindPoint :: PipelineBindPoint
$sel:pipeline:PipelineIndirectDeviceAddressInfoNV :: PipelineIndirectDeviceAddressInfoNV -> Pipeline
$sel:pipelineBindPoint:PipelineIndirectDeviceAddressInfoNV :: PipelineIndirectDeviceAddressInfoNV -> PipelineBindPoint
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_INDIRECT_DEVICE_ADDRESS_INFO_NV)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PipelineBindPoint)) (PipelineBindPoint
pipelineBindPoint)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Pipeline)) (Pipeline
pipeline)
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV)
-> IO b -> IO b
pokeZeroCStruct "pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_INDIRECT_DEVICE_ADDRESS_INFO_NV)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PipelineBindPoint)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Pipeline)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct PipelineIndirectDeviceAddressInfoNV where
  peekCStruct :: ("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV)
-> IO PipelineIndirectDeviceAddressInfoNV
peekCStruct "pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p = do
    PipelineBindPoint
pipelineBindPoint <- forall a. Storable a => Ptr a -> IO a
peek @PipelineBindPoint (("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PipelineBindPoint))
    Pipeline
pipeline <- forall a. Storable a => Ptr a -> IO a
peek @Pipeline (("pInfo" ::: Ptr PipelineIndirectDeviceAddressInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Pipeline))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PipelineBindPoint
-> Pipeline -> PipelineIndirectDeviceAddressInfoNV
PipelineIndirectDeviceAddressInfoNV
             PipelineBindPoint
pipelineBindPoint Pipeline
pipeline

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

instance Zero PipelineIndirectDeviceAddressInfoNV where
  zero :: PipelineIndirectDeviceAddressInfoNV
zero = PipelineBindPoint
-> Pipeline -> PipelineIndirectDeviceAddressInfoNV
PipelineIndirectDeviceAddressInfoNV
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkBindPipelineIndirectCommandNV - Structure specifying input data for
-- the compute pipeline dispatch token
--
-- == Valid Usage
--
-- -   #VUID-VkBindPipelineIndirectCommandNV-deviceGeneratedComputePipelines-09091#
--     The
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-deviceGeneratedComputePipelines ::deviceGeneratedComputePipelines>
--     feature /must/ be enabled
--
-- -   #VUID-VkBindPipelineIndirectCommandNV-None-09092# The referenced
--     pipeline /must/ have been created with
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_INDIRECT_BINDABLE_BIT_NV'
--
-- -   #VUID-VkBindPipelineIndirectCommandNV-None-09093# The referenced
--     pipeline /must/ have been updated with
--     'cmdUpdatePipelineIndirectBufferNV'
--
-- -   #VUID-VkBindPipelineIndirectCommandNV-None-09094# The referenced
--     pipeline’s address /must/ have been queried with
--     'getPipelineIndirectDeviceAddressNV'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_device_generated_commands_compute VK_NV_device_generated_commands_compute>,
-- 'Vulkan.Core10.FundamentalTypes.DeviceAddress'
data BindPipelineIndirectCommandNV = BindPipelineIndirectCommandNV
  { -- | @pipelineAddress@ specifies the pipeline address of the compute pipeline
    -- that will be used in device generated rendering.
    BindPipelineIndirectCommandNV -> DeviceAddress
pipelineAddress :: DeviceAddress }
  deriving (Typeable, BindPipelineIndirectCommandNV
-> BindPipelineIndirectCommandNV -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BindPipelineIndirectCommandNV
-> BindPipelineIndirectCommandNV -> Bool
$c/= :: BindPipelineIndirectCommandNV
-> BindPipelineIndirectCommandNV -> Bool
== :: BindPipelineIndirectCommandNV
-> BindPipelineIndirectCommandNV -> Bool
$c== :: BindPipelineIndirectCommandNV
-> BindPipelineIndirectCommandNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (BindPipelineIndirectCommandNV)
#endif
deriving instance Show BindPipelineIndirectCommandNV

instance ToCStruct BindPipelineIndirectCommandNV where
  withCStruct :: forall b.
BindPipelineIndirectCommandNV
-> (Ptr BindPipelineIndirectCommandNV -> IO b) -> IO b
withCStruct BindPipelineIndirectCommandNV
x Ptr BindPipelineIndirectCommandNV -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
8 forall a b. (a -> b) -> a -> b
$ \Ptr BindPipelineIndirectCommandNV
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr BindPipelineIndirectCommandNV
p BindPipelineIndirectCommandNV
x (Ptr BindPipelineIndirectCommandNV -> IO b
f Ptr BindPipelineIndirectCommandNV
p)
  pokeCStruct :: forall b.
Ptr BindPipelineIndirectCommandNV
-> BindPipelineIndirectCommandNV -> IO b -> IO b
pokeCStruct Ptr BindPipelineIndirectCommandNV
p BindPipelineIndirectCommandNV{DeviceAddress
pipelineAddress :: DeviceAddress
$sel:pipelineAddress:BindPipelineIndirectCommandNV :: BindPipelineIndirectCommandNV -> DeviceAddress
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindPipelineIndirectCommandNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DeviceAddress)) (DeviceAddress
pipelineAddress)
    IO b
f
  cStructSize :: Int
cStructSize = Int
8
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr BindPipelineIndirectCommandNV -> IO b -> IO b
pokeZeroCStruct Ptr BindPipelineIndirectCommandNV
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BindPipelineIndirectCommandNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DeviceAddress)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct BindPipelineIndirectCommandNV where
  peekCStruct :: Ptr BindPipelineIndirectCommandNV
-> IO BindPipelineIndirectCommandNV
peekCStruct Ptr BindPipelineIndirectCommandNV
p = do
    DeviceAddress
pipelineAddress <- forall a. Storable a => Ptr a -> IO a
peek @DeviceAddress ((Ptr BindPipelineIndirectCommandNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DeviceAddress))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DeviceAddress -> BindPipelineIndirectCommandNV
BindPipelineIndirectCommandNV
             DeviceAddress
pipelineAddress

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

instance Zero BindPipelineIndirectCommandNV where
  zero :: BindPipelineIndirectCommandNV
zero = DeviceAddress -> BindPipelineIndirectCommandNV
BindPipelineIndirectCommandNV
           forall a. Zero a => a
zero


type NV_DEVICE_GENERATED_COMMANDS_COMPUTE_SPEC_VERSION = 2

-- No documentation found for TopLevel "VK_NV_DEVICE_GENERATED_COMMANDS_COMPUTE_SPEC_VERSION"
pattern NV_DEVICE_GENERATED_COMMANDS_COMPUTE_SPEC_VERSION :: forall a . Integral a => a
pattern $bNV_DEVICE_GENERATED_COMMANDS_COMPUTE_SPEC_VERSION :: forall a. Integral a => a
$mNV_DEVICE_GENERATED_COMMANDS_COMPUTE_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
NV_DEVICE_GENERATED_COMMANDS_COMPUTE_SPEC_VERSION = 2


type NV_DEVICE_GENERATED_COMMANDS_COMPUTE_EXTENSION_NAME = "VK_NV_device_generated_commands_compute"

-- No documentation found for TopLevel "VK_NV_DEVICE_GENERATED_COMMANDS_COMPUTE_EXTENSION_NAME"
pattern NV_DEVICE_GENERATED_COMMANDS_COMPUTE_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bNV_DEVICE_GENERATED_COMMANDS_COMPUTE_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mNV_DEVICE_GENERATED_COMMANDS_COMPUTE_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
NV_DEVICE_GENERATED_COMMANDS_COMPUTE_EXTENSION_NAME = "VK_NV_device_generated_commands_compute"