{-# language CPP #-}
module Vulkan.Extensions.VK_KHR_ray_tracing  ( destroyAccelerationStructureKHR
                                             , getAccelerationStructureMemoryRequirementsKHR
                                             , bindAccelerationStructureMemoryKHR
                                             , cmdCopyAccelerationStructureKHR
                                             , copyAccelerationStructureKHR
                                             , cmdCopyAccelerationStructureToMemoryKHR
                                             , copyAccelerationStructureToMemoryKHR
                                             , cmdCopyMemoryToAccelerationStructureKHR
                                             , copyMemoryToAccelerationStructureKHR
                                             , cmdWriteAccelerationStructuresPropertiesKHR
                                             , writeAccelerationStructuresPropertiesKHR
                                             , cmdTraceRaysKHR
                                             , getRayTracingShaderGroupHandlesKHR
                                             , getRayTracingCaptureReplayShaderGroupHandlesKHR
                                             , createRayTracingPipelinesKHR
                                             , cmdTraceRaysIndirectKHR
                                             , getDeviceAccelerationStructureCompatibilityKHR
                                             , createAccelerationStructureKHR
                                             , withAccelerationStructureKHR
                                             , cmdBuildAccelerationStructureKHR
                                             , cmdBuildAccelerationStructureIndirectKHR
                                             , buildAccelerationStructureKHR
                                             , getAccelerationStructureDeviceAddressKHR
                                             , RayTracingShaderGroupCreateInfoKHR(..)
                                             , RayTracingPipelineCreateInfoKHR(..)
                                             , BindAccelerationStructureMemoryInfoKHR(..)
                                             , WriteDescriptorSetAccelerationStructureKHR(..)
                                             , AccelerationStructureMemoryRequirementsInfoKHR(..)
                                             , PhysicalDeviceRayTracingFeaturesKHR(..)
                                             , PhysicalDeviceRayTracingPropertiesKHR(..)
                                             , StridedBufferRegionKHR(..)
                                             , TraceRaysIndirectCommandKHR(..)
                                             , AccelerationStructureGeometryTrianglesDataKHR(..)
                                             , AccelerationStructureGeometryAabbsDataKHR(..)
                                             , AccelerationStructureGeometryInstancesDataKHR(..)
                                             , AccelerationStructureGeometryKHR(..)
                                             , AccelerationStructureBuildGeometryInfoKHR(..)
                                             , AccelerationStructureBuildOffsetInfoKHR(..)
                                             , AccelerationStructureCreateGeometryTypeInfoKHR(..)
                                             , AccelerationStructureCreateInfoKHR(..)
                                             , AabbPositionsKHR(..)
                                             , TransformMatrixKHR(..)
                                             , AccelerationStructureInstanceKHR(..)
                                             , AccelerationStructureDeviceAddressInfoKHR(..)
                                             , AccelerationStructureVersionKHR(..)
                                             , CopyAccelerationStructureInfoKHR(..)
                                             , CopyAccelerationStructureToMemoryInfoKHR(..)
                                             , CopyMemoryToAccelerationStructureInfoKHR(..)
                                             , RayTracingPipelineInterfaceCreateInfoKHR(..)
                                             , DeviceOrHostAddressKHR(..)
                                             , DeviceOrHostAddressConstKHR(..)
                                             , AccelerationStructureGeometryDataKHR(..)
                                             , GeometryInstanceFlagBitsKHR( GEOMETRY_INSTANCE_TRIANGLE_FACING_CULL_DISABLE_BIT_KHR
                                                                          , GEOMETRY_INSTANCE_TRIANGLE_FRONT_COUNTERCLOCKWISE_BIT_KHR
                                                                          , GEOMETRY_INSTANCE_FORCE_OPAQUE_BIT_KHR
                                                                          , GEOMETRY_INSTANCE_FORCE_NO_OPAQUE_BIT_KHR
                                                                          , ..
                                                                          )
                                             , GeometryInstanceFlagsKHR
                                             , GeometryFlagBitsKHR( GEOMETRY_OPAQUE_BIT_KHR
                                                                  , GEOMETRY_NO_DUPLICATE_ANY_HIT_INVOCATION_BIT_KHR
                                                                  , ..
                                                                  )
                                             , GeometryFlagsKHR
                                             , BuildAccelerationStructureFlagBitsKHR( BUILD_ACCELERATION_STRUCTURE_ALLOW_UPDATE_BIT_KHR
                                                                                    , BUILD_ACCELERATION_STRUCTURE_ALLOW_COMPACTION_BIT_KHR
                                                                                    , BUILD_ACCELERATION_STRUCTURE_PREFER_FAST_TRACE_BIT_KHR
                                                                                    , BUILD_ACCELERATION_STRUCTURE_PREFER_FAST_BUILD_BIT_KHR
                                                                                    , BUILD_ACCELERATION_STRUCTURE_LOW_MEMORY_BIT_KHR
                                                                                    , ..
                                                                                    )
                                             , BuildAccelerationStructureFlagsKHR
                                             , CopyAccelerationStructureModeKHR( COPY_ACCELERATION_STRUCTURE_MODE_CLONE_KHR
                                                                               , COPY_ACCELERATION_STRUCTURE_MODE_COMPACT_KHR
                                                                               , COPY_ACCELERATION_STRUCTURE_MODE_SERIALIZE_KHR
                                                                               , COPY_ACCELERATION_STRUCTURE_MODE_DESERIALIZE_KHR
                                                                               , ..
                                                                               )
                                             , AccelerationStructureTypeKHR( ACCELERATION_STRUCTURE_TYPE_TOP_LEVEL_KHR
                                                                           , ACCELERATION_STRUCTURE_TYPE_BOTTOM_LEVEL_KHR
                                                                           , ..
                                                                           )
                                             , GeometryTypeKHR( GEOMETRY_TYPE_TRIANGLES_KHR
                                                              , GEOMETRY_TYPE_AABBS_KHR
                                                              , GEOMETRY_TYPE_INSTANCES_KHR
                                                              , ..
                                                              )
                                             , AccelerationStructureMemoryRequirementsTypeKHR( ACCELERATION_STRUCTURE_MEMORY_REQUIREMENTS_TYPE_OBJECT_KHR
                                                                                             , ACCELERATION_STRUCTURE_MEMORY_REQUIREMENTS_TYPE_BUILD_SCRATCH_KHR
                                                                                             , ACCELERATION_STRUCTURE_MEMORY_REQUIREMENTS_TYPE_UPDATE_SCRATCH_KHR
                                                                                             , ..
                                                                                             )
                                             , AccelerationStructureBuildTypeKHR( ACCELERATION_STRUCTURE_BUILD_TYPE_HOST_KHR
                                                                                , ACCELERATION_STRUCTURE_BUILD_TYPE_DEVICE_KHR
                                                                                , ACCELERATION_STRUCTURE_BUILD_TYPE_HOST_OR_DEVICE_KHR
                                                                                , ..
                                                                                )
                                             , RayTracingShaderGroupTypeKHR( RAY_TRACING_SHADER_GROUP_TYPE_GENERAL_KHR
                                                                           , RAY_TRACING_SHADER_GROUP_TYPE_TRIANGLES_HIT_GROUP_KHR
                                                                           , RAY_TRACING_SHADER_GROUP_TYPE_PROCEDURAL_HIT_GROUP_KHR
                                                                           , ..
                                                                           )
                                             , KHR_RAY_TRACING_SPEC_VERSION
                                             , pattern KHR_RAY_TRACING_SPEC_VERSION
                                             , KHR_RAY_TRACING_EXTENSION_NAME
                                             , pattern KHR_RAY_TRACING_EXTENSION_NAME
                                             , AccelerationStructureKHR(..)
                                             , PipelineLibraryCreateInfoKHR(..)
                                             , DebugReportObjectTypeEXT(..)
                                             , SHADER_UNUSED_KHR
                                             , pattern SHADER_UNUSED_KHR
                                             ) where

import Vulkan.CStruct.Utils (FixedArray)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Bits ((.&.))
import Data.Bits ((.|.))
import Data.Bits (shiftL)
import Data.Bits (shiftR)
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import Foreign.Marshal.Utils (maybePeek)
import Foreign.Marshal.Utils (with)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (castPtr)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import GHC.Read (choose)
import GHC.Read (expectP)
import GHC.Read (parens)
import GHC.Show (showParen)
import GHC.Show (showString)
import GHC.Show (showsPrec)
import Numeric (showHex)
import Text.ParserCombinators.ReadPrec ((+++))
import Text.ParserCombinators.ReadPrec (prec)
import Text.ParserCombinators.ReadPrec (step)
import qualified Data.ByteString (length)
import Data.ByteString (packCStringLen)
import Data.ByteString.Unsafe (unsafeUseAsCString)
import Data.Coerce (coerce)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Control.Monad.Trans.Cont (runContT)
import Data.Vector (generateM)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import Foreign.C.Types (CSize(..))
import Control.Monad.IO.Class (MonadIO)
import Data.Bits (Bits)
import Data.String (IsString)
import Data.Type.Equality ((:~:)(Refl))
import Data.Typeable (Typeable)
import Foreign.C.Types (CChar)
import Foreign.C.Types (CFloat)
import Foreign.C.Types (CFloat(CFloat))
import Foreign.C.Types (CSize)
import Foreign.C.Types (CSize(CSize))
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 Data.Int (Int32)
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import GHC.Read (Read(readPrec))
import Data.Word (Word32)
import Data.Word (Word64)
import Data.Word (Word8)
import Text.Read.Lex (Lexeme(Ident))
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.CStruct.Utils (advancePtrBytes)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.CStruct.Extends (forgetExtensions)
import Vulkan.CStruct.Utils (lowerArrayPtr)
import Vulkan.CStruct.Extends (peekSomeCStruct)
import Vulkan.CStruct.Extends (pokeSomeCStruct)
import Vulkan.NamedType ((:::))
import Vulkan.Extensions.Handles (AccelerationStructureKHR)
import Vulkan.Extensions.Handles (AccelerationStructureKHR(..))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Handles (Buffer)
import Vulkan.Core10.Handles (Buffer(..))
import Vulkan.CStruct.Extends (Chain)
import Vulkan.Core10.Handles (CommandBuffer)
import Vulkan.Core10.Handles (CommandBuffer(..))
import Vulkan.Core10.Handles (CommandBuffer_T)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_deferred_host_operations (DeferredOperationInfoKHR)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.FundamentalTypes (DeviceAddress)
import Vulkan.Dynamic (DeviceCmds(pVkBindAccelerationStructureMemoryKHR))
import Vulkan.Dynamic (DeviceCmds(pVkBuildAccelerationStructureKHR))
import Vulkan.Dynamic (DeviceCmds(pVkCmdBuildAccelerationStructureIndirectKHR))
import Vulkan.Dynamic (DeviceCmds(pVkCmdBuildAccelerationStructureKHR))
import Vulkan.Dynamic (DeviceCmds(pVkCmdCopyAccelerationStructureKHR))
import Vulkan.Dynamic (DeviceCmds(pVkCmdCopyAccelerationStructureToMemoryKHR))
import Vulkan.Dynamic (DeviceCmds(pVkCmdCopyMemoryToAccelerationStructureKHR))
import Vulkan.Dynamic (DeviceCmds(pVkCmdTraceRaysIndirectKHR))
import Vulkan.Dynamic (DeviceCmds(pVkCmdTraceRaysKHR))
import Vulkan.Dynamic (DeviceCmds(pVkCmdWriteAccelerationStructuresPropertiesKHR))
import Vulkan.Dynamic (DeviceCmds(pVkCopyAccelerationStructureKHR))
import Vulkan.Dynamic (DeviceCmds(pVkCopyAccelerationStructureToMemoryKHR))
import Vulkan.Dynamic (DeviceCmds(pVkCopyMemoryToAccelerationStructureKHR))
import Vulkan.Dynamic (DeviceCmds(pVkCreateAccelerationStructureKHR))
import Vulkan.Dynamic (DeviceCmds(pVkCreateRayTracingPipelinesKHR))
import Vulkan.Dynamic (DeviceCmds(pVkDestroyAccelerationStructureKHR))
import Vulkan.Dynamic (DeviceCmds(pVkGetAccelerationStructureDeviceAddressKHR))
import Vulkan.Dynamic (DeviceCmds(pVkGetAccelerationStructureMemoryRequirementsKHR))
import Vulkan.Dynamic (DeviceCmds(pVkGetDeviceAccelerationStructureCompatibilityKHR))
import Vulkan.Dynamic (DeviceCmds(pVkGetRayTracingCaptureReplayShaderGroupHandlesKHR))
import Vulkan.Dynamic (DeviceCmds(pVkGetRayTracingShaderGroupHandlesKHR))
import Vulkan.Dynamic (DeviceCmds(pVkWriteAccelerationStructuresPropertiesKHR))
import Vulkan.Core10.Handles (DeviceMemory)
import Vulkan.Core10.FundamentalTypes (DeviceSize)
import Vulkan.Core10.Handles (Device_T)
import Vulkan.CStruct.Extends (Extends)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (Extensible(..))
import Vulkan.Core10.FundamentalTypes (Flags)
import Vulkan.Core10.Enums.Format (Format)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.Core10.Enums.IndexType (IndexType)
import Vulkan.Core11.Promoted_From_VK_KHR_get_memory_requirements2 (MemoryRequirements2)
import Vulkan.CStruct.Extends (PeekChain)
import Vulkan.CStruct.Extends (PeekChain(..))
import Vulkan.Core10.Handles (Pipeline)
import Vulkan.Core10.Handles (Pipeline(..))
import Vulkan.Core10.Handles (PipelineCache)
import Vulkan.Core10.Handles (PipelineCache(..))
import Vulkan.Core10.Enums.PipelineCreateFlagBits (PipelineCreateFlags)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_pipeline_creation_feedback (PipelineCreationFeedbackCreateInfoEXT)
import Vulkan.Core10.Handles (PipelineLayout)
import Vulkan.Extensions.VK_KHR_pipeline_library (PipelineLibraryCreateInfoKHR)
import Vulkan.Core10.Pipeline (PipelineShaderStageCreateInfo)
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (PokeChain(..))
import Vulkan.Core10.Handles (QueryPool)
import Vulkan.Core10.Handles (QueryPool(..))
import Vulkan.Core10.Enums.QueryType (QueryType)
import Vulkan.Core10.Enums.QueryType (QueryType(..))
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Exception (VulkanException(..))
import Vulkan.Zero (Zero)
import Vulkan.Zero (Zero(..))
import Vulkan.Core10.FundamentalTypes (Bool32(FALSE))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_ACCELERATION_STRUCTURE_BUILD_GEOMETRY_INFO_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_ACCELERATION_STRUCTURE_CREATE_GEOMETRY_TYPE_INFO_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_ACCELERATION_STRUCTURE_CREATE_INFO_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_ACCELERATION_STRUCTURE_DEVICE_ADDRESS_INFO_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_ACCELERATION_STRUCTURE_GEOMETRY_AABBS_DATA_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_ACCELERATION_STRUCTURE_GEOMETRY_INSTANCES_DATA_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_ACCELERATION_STRUCTURE_GEOMETRY_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_ACCELERATION_STRUCTURE_GEOMETRY_TRIANGLES_DATA_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_ACCELERATION_STRUCTURE_MEMORY_REQUIREMENTS_INFO_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_ACCELERATION_STRUCTURE_VERSION_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_BIND_ACCELERATION_STRUCTURE_MEMORY_INFO_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_COPY_ACCELERATION_STRUCTURE_INFO_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_COPY_ACCELERATION_STRUCTURE_TO_MEMORY_INFO_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_COPY_MEMORY_TO_ACCELERATION_STRUCTURE_INFO_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_RAY_TRACING_FEATURES_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_RAY_TRACING_PROPERTIES_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_RAY_TRACING_PIPELINE_CREATE_INFO_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_RAY_TRACING_PIPELINE_INTERFACE_CREATE_INFO_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_RAY_TRACING_SHADER_GROUP_CREATE_INFO_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_WRITE_DESCRIPTOR_SET_ACCELERATION_STRUCTURE_KHR))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Core10.APIConstants (pattern UUID_SIZE)
import Vulkan.Extensions.Handles (AccelerationStructureKHR(..))
import Vulkan.Extensions.VK_EXT_debug_report (DebugReportObjectTypeEXT(..))
import Vulkan.Extensions.VK_KHR_pipeline_library (PipelineLibraryCreateInfoKHR(..))
import Vulkan.Core10.APIConstants (SHADER_UNUSED_KHR)
import Vulkan.Core10.APIConstants (pattern SHADER_UNUSED_KHR)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkDestroyAccelerationStructureKHR
  :: FunPtr (Ptr Device_T -> AccelerationStructureKHR -> Ptr AllocationCallbacks -> IO ()) -> Ptr Device_T -> AccelerationStructureKHR -> Ptr AllocationCallbacks -> IO ()

-- | vkDestroyAccelerationStructureKHR - Destroy an acceleration structure
-- object
--
-- == Valid Usage
--
-- -   All submitted commands that refer to @accelerationStructure@ /must/
--     have completed execution
--
-- -   If 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @accelerationStructure@ was created, a compatible set
--     of callbacks /must/ be provided here
--
-- -   If no 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' were
--     provided when @accelerationStructure@ was created, @pAllocator@
--     /must/ be @NULL@
--
-- == Valid Usage (Implicit)
--
-- -   @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   If @accelerationStructure@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', @accelerationStructure@
--     /must/ be a valid
--     'Vulkan.Extensions.Handles.AccelerationStructureKHR' handle
--
-- -   If @pAllocator@ is not @NULL@, @pAllocator@ /must/ be a valid
--     pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   If @accelerationStructure@ is a valid handle, it /must/ have been
--     created, allocated, or retrieved from @device@
--
-- == Host Synchronization
--
-- -   Host access to @accelerationStructure@ /must/ be externally
--     synchronized
--
-- = See Also
--
-- 'Vulkan.Extensions.Handles.AccelerationStructureKHR',
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Device'
destroyAccelerationStructureKHR :: forall io
                                 . (MonadIO io)
                                => -- | @device@ is the logical device that destroys the buffer.
                                   Device
                                -> -- | @accelerationStructure@ is the acceleration structure to destroy.
                                   AccelerationStructureKHR
                                -> -- | @pAllocator@ controls host memory allocation as described in the
                                   -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                                   -- chapter.
                                   ("allocator" ::: Maybe AllocationCallbacks)
                                -> io ()
destroyAccelerationStructureKHR :: Device
-> AccelerationStructureKHR
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyAccelerationStructureKHR device :: Device
device accelerationStructure :: AccelerationStructureKHR
accelerationStructure allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = 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 vkDestroyAccelerationStructureKHRPtr :: FunPtr
  (Ptr Device_T
   -> AccelerationStructureKHR
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyAccelerationStructureKHRPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> AccelerationStructureKHR
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> IO ())
pVkDestroyAccelerationStructureKHR (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  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 Device_T
   -> AccelerationStructureKHR
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyAccelerationStructureKHRPtr FunPtr
  (Ptr Device_T
   -> AccelerationStructureKHR
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
-> FunPtr
     (Ptr Device_T
      -> AccelerationStructureKHR
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> AccelerationStructureKHR
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> 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 "" "The function pointer for vkDestroyAccelerationStructureKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkDestroyAccelerationStructureKHR' :: Ptr Device_T
-> AccelerationStructureKHR
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyAccelerationStructureKHR' = FunPtr
  (Ptr Device_T
   -> AccelerationStructureKHR
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
-> Ptr Device_T
-> AccelerationStructureKHR
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyAccelerationStructureKHR FunPtr
  (Ptr Device_T
   -> AccelerationStructureKHR
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO ())
vkDestroyAccelerationStructureKHRPtr
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
 -> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  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
$ Ptr Device_T
-> AccelerationStructureKHR
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
vkDestroyAccelerationStructureKHR' (Device -> Ptr Device_T
deviceHandle (Device
device)) (AccelerationStructureKHR
accelerationStructure) "pAllocator" ::: Ptr AllocationCallbacks
pAllocator
  () -> 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" mkVkGetAccelerationStructureMemoryRequirementsKHR
  :: FunPtr (Ptr Device_T -> Ptr AccelerationStructureMemoryRequirementsInfoKHR -> Ptr (SomeStruct MemoryRequirements2) -> IO ()) -> Ptr Device_T -> Ptr AccelerationStructureMemoryRequirementsInfoKHR -> Ptr (SomeStruct MemoryRequirements2) -> IO ()

-- | vkGetAccelerationStructureMemoryRequirementsKHR - Get acceleration
-- structure memory requirements
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'AccelerationStructureMemoryRequirementsInfoKHR',
-- 'Vulkan.Core10.Handles.Device',
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_memory_requirements2.MemoryRequirements2'
getAccelerationStructureMemoryRequirementsKHR :: forall a io
                                               . (Extendss MemoryRequirements2 a, PokeChain a, PeekChain a, MonadIO io)
                                              => -- | @device@ is the logical device on which the acceleration structure was
                                                 -- created.
                                                 --
                                                 -- @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
                                                 Device
                                              -> -- | @pInfo@ specifies the acceleration structure to get memory requirements
                                                 -- for.
                                                 --
                                                 -- @pInfo@ /must/ be a valid pointer to a valid
                                                 -- 'AccelerationStructureMemoryRequirementsInfoKHR' structure
                                                 AccelerationStructureMemoryRequirementsInfoKHR
                                              -> io (MemoryRequirements2 a)
getAccelerationStructureMemoryRequirementsKHR :: Device
-> AccelerationStructureMemoryRequirementsInfoKHR
-> io (MemoryRequirements2 a)
getAccelerationStructureMemoryRequirementsKHR device :: Device
device info :: AccelerationStructureMemoryRequirementsInfoKHR
info = IO (MemoryRequirements2 a) -> io (MemoryRequirements2 a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MemoryRequirements2 a) -> io (MemoryRequirements2 a))
-> (ContT (MemoryRequirements2 a) IO (MemoryRequirements2 a)
    -> IO (MemoryRequirements2 a))
-> ContT (MemoryRequirements2 a) IO (MemoryRequirements2 a)
-> io (MemoryRequirements2 a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT (MemoryRequirements2 a) IO (MemoryRequirements2 a)
-> IO (MemoryRequirements2 a)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT (MemoryRequirements2 a) IO (MemoryRequirements2 a)
 -> io (MemoryRequirements2 a))
-> ContT (MemoryRequirements2 a) IO (MemoryRequirements2 a)
-> io (MemoryRequirements2 a)
forall a b. (a -> b) -> a -> b
$ do
  let vkGetAccelerationStructureMemoryRequirementsKHRPtr :: FunPtr
  (Ptr Device_T
   -> ("pInfo" ::: Ptr AccelerationStructureMemoryRequirementsInfoKHR)
   -> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
   -> IO ())
vkGetAccelerationStructureMemoryRequirementsKHRPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pInfo" ::: Ptr AccelerationStructureMemoryRequirementsInfoKHR)
      -> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
      -> IO ())
pVkGetAccelerationStructureMemoryRequirementsKHR (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  IO () -> ContT (MemoryRequirements2 a) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (MemoryRequirements2 a) IO ())
-> IO () -> ContT (MemoryRequirements2 a) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("pInfo" ::: Ptr AccelerationStructureMemoryRequirementsInfoKHR)
   -> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
   -> IO ())
vkGetAccelerationStructureMemoryRequirementsKHRPtr FunPtr
  (Ptr Device_T
   -> ("pInfo" ::: Ptr AccelerationStructureMemoryRequirementsInfoKHR)
   -> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
   -> IO ())
-> FunPtr
     (Ptr Device_T
      -> ("pInfo" ::: Ptr AccelerationStructureMemoryRequirementsInfoKHR)
      -> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ("pInfo" ::: Ptr AccelerationStructureMemoryRequirementsInfoKHR)
   -> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
   -> 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 "" "The function pointer for vkGetAccelerationStructureMemoryRequirementsKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetAccelerationStructureMemoryRequirementsKHR' :: Ptr Device_T
-> ("pInfo" ::: Ptr AccelerationStructureMemoryRequirementsInfoKHR)
-> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
-> IO ()
vkGetAccelerationStructureMemoryRequirementsKHR' = FunPtr
  (Ptr Device_T
   -> ("pInfo" ::: Ptr AccelerationStructureMemoryRequirementsInfoKHR)
   -> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
   -> IO ())
-> Ptr Device_T
-> ("pInfo" ::: Ptr AccelerationStructureMemoryRequirementsInfoKHR)
-> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
-> IO ()
mkVkGetAccelerationStructureMemoryRequirementsKHR FunPtr
  (Ptr Device_T
   -> ("pInfo" ::: Ptr AccelerationStructureMemoryRequirementsInfoKHR)
   -> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
   -> IO ())
vkGetAccelerationStructureMemoryRequirementsKHRPtr
  "pInfo" ::: Ptr AccelerationStructureMemoryRequirementsInfoKHR
pInfo <- ((("pInfo" ::: Ptr AccelerationStructureMemoryRequirementsInfoKHR)
  -> IO (MemoryRequirements2 a))
 -> IO (MemoryRequirements2 a))
-> ContT
     (MemoryRequirements2 a)
     IO
     ("pInfo" ::: Ptr AccelerationStructureMemoryRequirementsInfoKHR)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pInfo" ::: Ptr AccelerationStructureMemoryRequirementsInfoKHR)
   -> IO (MemoryRequirements2 a))
  -> IO (MemoryRequirements2 a))
 -> ContT
      (MemoryRequirements2 a)
      IO
      ("pInfo" ::: Ptr AccelerationStructureMemoryRequirementsInfoKHR))
-> ((("pInfo"
      ::: Ptr AccelerationStructureMemoryRequirementsInfoKHR)
     -> IO (MemoryRequirements2 a))
    -> IO (MemoryRequirements2 a))
-> ContT
     (MemoryRequirements2 a)
     IO
     ("pInfo" ::: Ptr AccelerationStructureMemoryRequirementsInfoKHR)
forall a b. (a -> b) -> a -> b
$ AccelerationStructureMemoryRequirementsInfoKHR
-> (("pInfo"
     ::: Ptr AccelerationStructureMemoryRequirementsInfoKHR)
    -> IO (MemoryRequirements2 a))
-> IO (MemoryRequirements2 a)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AccelerationStructureMemoryRequirementsInfoKHR
info)
  Ptr (MemoryRequirements2 a)
pPMemoryRequirements <- ((Ptr (MemoryRequirements2 a) -> IO (MemoryRequirements2 a))
 -> IO (MemoryRequirements2 a))
-> ContT (MemoryRequirements2 a) IO (Ptr (MemoryRequirements2 a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct (MemoryRequirements2 a) =>
(Ptr (MemoryRequirements2 a) -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @(MemoryRequirements2 _))
  IO () -> ContT (MemoryRequirements2 a) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (MemoryRequirements2 a) IO ())
-> IO () -> ContT (MemoryRequirements2 a) IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> ("pInfo" ::: Ptr AccelerationStructureMemoryRequirementsInfoKHR)
-> ("pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2))
-> IO ()
vkGetAccelerationStructureMemoryRequirementsKHR' (Device -> Ptr Device_T
deviceHandle (Device
device)) "pInfo" ::: Ptr AccelerationStructureMemoryRequirementsInfoKHR
pInfo (Ptr (MemoryRequirements2 a)
-> "pMemoryRequirements" ::: Ptr (SomeStruct MemoryRequirements2)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (MemoryRequirements2 a)
pPMemoryRequirements))
  MemoryRequirements2 a
pMemoryRequirements <- IO (MemoryRequirements2 a)
-> ContT (MemoryRequirements2 a) IO (MemoryRequirements2 a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (MemoryRequirements2 a)
 -> ContT (MemoryRequirements2 a) IO (MemoryRequirements2 a))
-> IO (MemoryRequirements2 a)
-> ContT (MemoryRequirements2 a) IO (MemoryRequirements2 a)
forall a b. (a -> b) -> a -> b
$ Ptr (MemoryRequirements2 a) -> IO (MemoryRequirements2 a)
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @(MemoryRequirements2 _) Ptr (MemoryRequirements2 a)
pPMemoryRequirements
  MemoryRequirements2 a
-> ContT (MemoryRequirements2 a) IO (MemoryRequirements2 a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MemoryRequirements2 a
 -> ContT (MemoryRequirements2 a) IO (MemoryRequirements2 a))
-> MemoryRequirements2 a
-> ContT (MemoryRequirements2 a) IO (MemoryRequirements2 a)
forall a b. (a -> b) -> a -> b
$ (MemoryRequirements2 a
pMemoryRequirements)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkBindAccelerationStructureMemoryKHR
  :: FunPtr (Ptr Device_T -> Word32 -> Ptr BindAccelerationStructureMemoryInfoKHR -> IO Result) -> Ptr Device_T -> Word32 -> Ptr BindAccelerationStructureMemoryInfoKHR -> IO Result

-- | vkBindAccelerationStructureMemoryKHR - Bind acceleration structure
-- memory
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
-- = See Also
--
-- 'BindAccelerationStructureMemoryInfoKHR', 'Vulkan.Core10.Handles.Device'
bindAccelerationStructureMemoryKHR :: forall io
                                    . (MonadIO io)
                                   => -- | @device@ is the logical device that owns the acceleration structures and
                                      -- memory.
                                      --
                                      -- @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
                                      Device
                                   -> -- | @pBindInfos@ is a pointer to an array of
                                      -- 'BindAccelerationStructureMemoryInfoKHR' structures describing
                                      -- acceleration structures and memory to bind.
                                      --
                                      -- @pBindInfos@ /must/ be a valid pointer to an array of @bindInfoCount@
                                      -- valid 'BindAccelerationStructureMemoryInfoKHR' structures
                                      ("bindInfos" ::: Vector BindAccelerationStructureMemoryInfoKHR)
                                   -> io ()
bindAccelerationStructureMemoryKHR :: Device
-> ("bindInfos" ::: Vector BindAccelerationStructureMemoryInfoKHR)
-> io ()
bindAccelerationStructureMemoryKHR device :: Device
device bindInfos :: "bindInfos" ::: Vector BindAccelerationStructureMemoryInfoKHR
bindInfos = 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 vkBindAccelerationStructureMemoryKHRPtr :: FunPtr
  (Ptr Device_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pBindInfos" ::: Ptr BindAccelerationStructureMemoryInfoKHR)
   -> IO Result)
vkBindAccelerationStructureMemoryKHRPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("bindInfoCount" ::: Word32)
      -> ("pBindInfos" ::: Ptr BindAccelerationStructureMemoryInfoKHR)
      -> IO Result)
pVkBindAccelerationStructureMemoryKHR (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  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 Device_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pBindInfos" ::: Ptr BindAccelerationStructureMemoryInfoKHR)
   -> IO Result)
vkBindAccelerationStructureMemoryKHRPtr FunPtr
  (Ptr Device_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pBindInfos" ::: Ptr BindAccelerationStructureMemoryInfoKHR)
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> ("bindInfoCount" ::: Word32)
      -> ("pBindInfos" ::: Ptr BindAccelerationStructureMemoryInfoKHR)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pBindInfos" ::: Ptr BindAccelerationStructureMemoryInfoKHR)
   -> IO Result)
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 "" "The function pointer for vkBindAccelerationStructureMemoryKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkBindAccelerationStructureMemoryKHR' :: Ptr Device_T
-> ("bindInfoCount" ::: Word32)
-> ("pBindInfos" ::: Ptr BindAccelerationStructureMemoryInfoKHR)
-> IO Result
vkBindAccelerationStructureMemoryKHR' = FunPtr
  (Ptr Device_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pBindInfos" ::: Ptr BindAccelerationStructureMemoryInfoKHR)
   -> IO Result)
-> Ptr Device_T
-> ("bindInfoCount" ::: Word32)
-> ("pBindInfos" ::: Ptr BindAccelerationStructureMemoryInfoKHR)
-> IO Result
mkVkBindAccelerationStructureMemoryKHR FunPtr
  (Ptr Device_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pBindInfos" ::: Ptr BindAccelerationStructureMemoryInfoKHR)
   -> IO Result)
vkBindAccelerationStructureMemoryKHRPtr
  "pBindInfos" ::: Ptr BindAccelerationStructureMemoryInfoKHR
pPBindInfos <- ((("pBindInfos" ::: Ptr BindAccelerationStructureMemoryInfoKHR)
  -> IO ())
 -> IO ())
-> ContT
     () IO ("pBindInfos" ::: Ptr BindAccelerationStructureMemoryInfoKHR)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pBindInfos" ::: Ptr BindAccelerationStructureMemoryInfoKHR)
   -> IO ())
  -> IO ())
 -> ContT
      ()
      IO
      ("pBindInfos" ::: Ptr BindAccelerationStructureMemoryInfoKHR))
-> ((("pBindInfos" ::: Ptr BindAccelerationStructureMemoryInfoKHR)
     -> IO ())
    -> IO ())
-> ContT
     () IO ("pBindInfos" ::: Ptr BindAccelerationStructureMemoryInfoKHR)
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> (("pBindInfos" ::: Ptr BindAccelerationStructureMemoryInfoKHR)
    -> IO ())
-> IO ()
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @BindAccelerationStructureMemoryInfoKHR ((("bindInfos" ::: Vector BindAccelerationStructureMemoryInfoKHR)
-> Int
forall a. Vector a -> Int
Data.Vector.length ("bindInfos" ::: Vector BindAccelerationStructureMemoryInfoKHR
bindInfos)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 56) 8
  (Int -> BindAccelerationStructureMemoryInfoKHR -> ContT () IO ())
-> ("bindInfos" ::: Vector BindAccelerationStructureMemoryInfoKHR)
-> ContT () IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: BindAccelerationStructureMemoryInfoKHR
e -> ((() -> IO ()) -> IO ()) -> ContT () IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO ()) -> IO ()) -> ContT () IO ())
-> ((() -> IO ()) -> IO ()) -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ("pBindInfos" ::: Ptr BindAccelerationStructureMemoryInfoKHR)
-> BindAccelerationStructureMemoryInfoKHR -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ("pBindInfos" ::: Ptr BindAccelerationStructureMemoryInfoKHR
pPBindInfos ("pBindInfos" ::: Ptr BindAccelerationStructureMemoryInfoKHR)
-> Int
-> "pBindInfos" ::: Ptr BindAccelerationStructureMemoryInfoKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (56 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr BindAccelerationStructureMemoryInfoKHR) (BindAccelerationStructureMemoryInfoKHR
e) (IO () -> IO ())
-> ((() -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ ())) ("bindInfos" ::: Vector BindAccelerationStructureMemoryInfoKHR
bindInfos)
  Result
r <- IO Result -> ContT () IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT () IO Result)
-> IO Result -> ContT () IO Result
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> ("bindInfoCount" ::: Word32)
-> ("pBindInfos" ::: Ptr BindAccelerationStructureMemoryInfoKHR)
-> IO Result
vkBindAccelerationStructureMemoryKHR' (Device -> Ptr Device_T
deviceHandle (Device
device)) ((Int -> "bindInfoCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("bindInfos" ::: Vector BindAccelerationStructureMemoryInfoKHR)
-> Int
forall a. Vector a -> Int
Data.Vector.length (("bindInfos" ::: Vector BindAccelerationStructureMemoryInfoKHR)
 -> Int)
-> ("bindInfos" ::: Vector BindAccelerationStructureMemoryInfoKHR)
-> Int
forall a b. (a -> b) -> a -> b
$ ("bindInfos" ::: Vector BindAccelerationStructureMemoryInfoKHR
bindInfos)) :: Word32)) ("pBindInfos" ::: Ptr BindAccelerationStructureMemoryInfoKHR
pPBindInfos)
  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 ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdCopyAccelerationStructureKHR
  :: FunPtr (Ptr CommandBuffer_T -> Ptr (SomeStruct CopyAccelerationStructureInfoKHR) -> IO ()) -> Ptr CommandBuffer_T -> Ptr (SomeStruct CopyAccelerationStructureInfoKHR) -> IO ()

-- | vkCmdCopyAccelerationStructureKHR - Copy an acceleration structure
--
-- == Valid Usage
--
-- -   All 'Vulkan.Extensions.Handles.AccelerationStructureKHR' objects
--     referenced by this command /must/ be bound to device memory
--
-- -   The
--     'Vulkan.Extensions.VK_KHR_deferred_host_operations.DeferredOperationInfoKHR'
--     structure /must/ not be included in the @pNext@ chain of the
--     'CopyAccelerationStructureInfoKHR' structure
--
-- == Valid Usage (Implicit)
--
-- -   @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   @pInfo@ /must/ be a valid pointer to a valid
--     'CopyAccelerationStructureInfoKHR' structure
--
-- -   @commandBuffer@ /must/ be in the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#commandbuffers-lifecycle recording state>
--
-- -   The 'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support compute operations
--
-- -   This command /must/ only be called outside of a render pass instance
--
-- == 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> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-pipeline-stages-types Pipeline Type> |
-- +============================================================================================================================+========================================================================================================================+=======================================================================================================================+=====================================================================================================================================+
-- | Primary                                                                                                                    | Outside                                                                                                                | Compute                                                                                                               |                                                                                                                                     |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                       |                                                                                                                                     |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+-------------------------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- 'Vulkan.Core10.Handles.CommandBuffer',
-- 'CopyAccelerationStructureInfoKHR'
cmdCopyAccelerationStructureKHR :: forall a io
                                 . (Extendss CopyAccelerationStructureInfoKHR a, PokeChain a, MonadIO io)
                                => -- | @commandBuffer@ is the command buffer into which the command will be
                                   -- recorded.
                                   CommandBuffer
                                -> -- | @pInfo@ is a pointer to a 'CopyAccelerationStructureInfoKHR' structure
                                   -- defining the copy operation.
                                   (CopyAccelerationStructureInfoKHR a)
                                -> io ()
cmdCopyAccelerationStructureKHR :: CommandBuffer -> CopyAccelerationStructureInfoKHR a -> io ()
cmdCopyAccelerationStructureKHR commandBuffer :: CommandBuffer
commandBuffer info :: CopyAccelerationStructureInfoKHR a
info = 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 vkCmdCopyAccelerationStructureKHRPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("pInfo" ::: Ptr (SomeStruct CopyAccelerationStructureInfoKHR))
   -> IO ())
vkCmdCopyAccelerationStructureKHRPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pInfo" ::: Ptr (SomeStruct CopyAccelerationStructureInfoKHR))
      -> IO ())
pVkCmdCopyAccelerationStructureKHR (CommandBuffer -> DeviceCmds
deviceCmds (CommandBuffer
commandBuffer :: CommandBuffer))
  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
   -> ("pInfo" ::: Ptr (SomeStruct CopyAccelerationStructureInfoKHR))
   -> IO ())
vkCmdCopyAccelerationStructureKHRPtr FunPtr
  (Ptr CommandBuffer_T
   -> ("pInfo" ::: Ptr (SomeStruct CopyAccelerationStructureInfoKHR))
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pInfo" ::: Ptr (SomeStruct CopyAccelerationStructureInfoKHR))
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("pInfo" ::: Ptr (SomeStruct CopyAccelerationStructureInfoKHR))
   -> 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 "" "The function pointer for vkCmdCopyAccelerationStructureKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdCopyAccelerationStructureKHR' :: Ptr CommandBuffer_T
-> ("pInfo" ::: Ptr (SomeStruct CopyAccelerationStructureInfoKHR))
-> IO ()
vkCmdCopyAccelerationStructureKHR' = FunPtr
  (Ptr CommandBuffer_T
   -> ("pInfo" ::: Ptr (SomeStruct CopyAccelerationStructureInfoKHR))
   -> IO ())
-> Ptr CommandBuffer_T
-> ("pInfo" ::: Ptr (SomeStruct CopyAccelerationStructureInfoKHR))
-> IO ()
mkVkCmdCopyAccelerationStructureKHR FunPtr
  (Ptr CommandBuffer_T
   -> ("pInfo" ::: Ptr (SomeStruct CopyAccelerationStructureInfoKHR))
   -> IO ())
vkCmdCopyAccelerationStructureKHRPtr
  Ptr (CopyAccelerationStructureInfoKHR a)
pInfo <- ((Ptr (CopyAccelerationStructureInfoKHR a) -> IO ()) -> IO ())
-> ContT () IO (Ptr (CopyAccelerationStructureInfoKHR a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (CopyAccelerationStructureInfoKHR a) -> IO ()) -> IO ())
 -> ContT () IO (Ptr (CopyAccelerationStructureInfoKHR a)))
-> ((Ptr (CopyAccelerationStructureInfoKHR a) -> IO ()) -> IO ())
-> ContT () IO (Ptr (CopyAccelerationStructureInfoKHR a))
forall a b. (a -> b) -> a -> b
$ CopyAccelerationStructureInfoKHR a
-> (Ptr (CopyAccelerationStructureInfoKHR a) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (CopyAccelerationStructureInfoKHR a
info)
  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
$ Ptr CommandBuffer_T
-> ("pInfo" ::: Ptr (SomeStruct CopyAccelerationStructureInfoKHR))
-> IO ()
vkCmdCopyAccelerationStructureKHR' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) (Ptr (CopyAccelerationStructureInfoKHR a)
-> "pInfo" ::: Ptr (SomeStruct CopyAccelerationStructureInfoKHR)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (CopyAccelerationStructureInfoKHR a)
pInfo)
  () -> 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" mkVkCopyAccelerationStructureKHR
  :: FunPtr (Ptr Device_T -> Ptr (SomeStruct CopyAccelerationStructureInfoKHR) -> IO Result) -> Ptr Device_T -> Ptr (SomeStruct CopyAccelerationStructureInfoKHR) -> IO Result

-- | vkCopyAccelerationStructureKHR - Copy an acceleration structure on the
-- host
--
-- = Parameters
--
-- This command fulfills the same task as 'cmdCopyAccelerationStructureKHR'
-- but executed by the host.
--
-- = Description
--
-- -   @device@ is the device which owns the acceleration structures.
--
-- -   @pInfo@ is a pointer to a 'CopyAccelerationStructureInfoKHR'
--     structure defining the copy operation.
--
-- If the
-- 'Vulkan.Extensions.VK_KHR_deferred_host_operations.DeferredOperationInfoKHR'
-- structure is included in the @pNext@ chain of the
-- 'CopyAccelerationStructureInfoKHR' structure, the operation of this
-- command is /deferred/, as defined in the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#deferred-host-operations Deferred Host Operations>
-- chapter.
--
-- == Valid Usage
--
-- -   All 'Vulkan.Extensions.Handles.AccelerationStructureKHR' objects
--     referenced by this command /must/ be bound to host-visible memory
--
-- -   the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-raytracing-hostascmds ::rayTracingHostAccelerationStructureCommands>
--     feature /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   @pInfo@ /must/ be a valid pointer to a valid
--     'CopyAccelerationStructureInfoKHR' structure
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
--     -   'Vulkan.Core10.Enums.Result.OPERATION_DEFERRED_KHR'
--
--     -   'Vulkan.Core10.Enums.Result.OPERATION_NOT_DEFERRED_KHR'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
-- = See Also
--
-- 'CopyAccelerationStructureInfoKHR', 'Vulkan.Core10.Handles.Device'
copyAccelerationStructureKHR :: forall a io
                              . (Extendss CopyAccelerationStructureInfoKHR a, PokeChain a, MonadIO io)
                             => -- No documentation found for Nested "vkCopyAccelerationStructureKHR" "device"
                                Device
                             -> -- No documentation found for Nested "vkCopyAccelerationStructureKHR" "pInfo"
                                (CopyAccelerationStructureInfoKHR a)
                             -> io (Result)
copyAccelerationStructureKHR :: Device -> CopyAccelerationStructureInfoKHR a -> io Result
copyAccelerationStructureKHR device :: Device
device info :: CopyAccelerationStructureInfoKHR a
info = IO Result -> io Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> io Result)
-> (ContT Result IO Result -> IO Result)
-> ContT Result IO Result
-> io Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Result IO Result -> IO Result
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Result IO Result -> io Result)
-> ContT Result IO Result -> io Result
forall a b. (a -> b) -> a -> b
$ do
  let vkCopyAccelerationStructureKHRPtr :: FunPtr
  (Ptr Device_T
   -> ("pInfo" ::: Ptr (SomeStruct CopyAccelerationStructureInfoKHR))
   -> IO Result)
vkCopyAccelerationStructureKHRPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pInfo" ::: Ptr (SomeStruct CopyAccelerationStructureInfoKHR))
      -> IO Result)
pVkCopyAccelerationStructureKHR (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  IO () -> ContT Result IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Result IO ()) -> IO () -> ContT Result IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("pInfo" ::: Ptr (SomeStruct CopyAccelerationStructureInfoKHR))
   -> IO Result)
vkCopyAccelerationStructureKHRPtr FunPtr
  (Ptr Device_T
   -> ("pInfo" ::: Ptr (SomeStruct CopyAccelerationStructureInfoKHR))
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> ("pInfo" ::: Ptr (SomeStruct CopyAccelerationStructureInfoKHR))
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ("pInfo" ::: Ptr (SomeStruct CopyAccelerationStructureInfoKHR))
   -> IO Result)
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 "" "The function pointer for vkCopyAccelerationStructureKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCopyAccelerationStructureKHR' :: Ptr Device_T
-> ("pInfo" ::: Ptr (SomeStruct CopyAccelerationStructureInfoKHR))
-> IO Result
vkCopyAccelerationStructureKHR' = FunPtr
  (Ptr Device_T
   -> ("pInfo" ::: Ptr (SomeStruct CopyAccelerationStructureInfoKHR))
   -> IO Result)
-> Ptr Device_T
-> ("pInfo" ::: Ptr (SomeStruct CopyAccelerationStructureInfoKHR))
-> IO Result
mkVkCopyAccelerationStructureKHR FunPtr
  (Ptr Device_T
   -> ("pInfo" ::: Ptr (SomeStruct CopyAccelerationStructureInfoKHR))
   -> IO Result)
vkCopyAccelerationStructureKHRPtr
  Ptr (CopyAccelerationStructureInfoKHR a)
pInfo <- ((Ptr (CopyAccelerationStructureInfoKHR a) -> IO Result)
 -> IO Result)
-> ContT Result IO (Ptr (CopyAccelerationStructureInfoKHR a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (CopyAccelerationStructureInfoKHR a) -> IO Result)
  -> IO Result)
 -> ContT Result IO (Ptr (CopyAccelerationStructureInfoKHR a)))
-> ((Ptr (CopyAccelerationStructureInfoKHR a) -> IO Result)
    -> IO Result)
-> ContT Result IO (Ptr (CopyAccelerationStructureInfoKHR a))
forall a b. (a -> b) -> a -> b
$ CopyAccelerationStructureInfoKHR a
-> (Ptr (CopyAccelerationStructureInfoKHR a) -> IO Result)
-> IO Result
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (CopyAccelerationStructureInfoKHR a
info)
  Result
r <- IO Result -> ContT Result IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT Result IO Result)
-> IO Result -> ContT Result IO Result
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> ("pInfo" ::: Ptr (SomeStruct CopyAccelerationStructureInfoKHR))
-> IO Result
vkCopyAccelerationStructureKHR' (Device -> Ptr Device_T
deviceHandle (Device
device)) (Ptr (CopyAccelerationStructureInfoKHR a)
-> "pInfo" ::: Ptr (SomeStruct CopyAccelerationStructureInfoKHR)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (CopyAccelerationStructureInfoKHR a)
pInfo)
  IO () -> ContT Result IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Result IO ()) -> IO () -> ContT Result IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  Result -> ContT Result IO Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> ContT Result IO Result)
-> Result -> ContT Result IO Result
forall a b. (a -> b) -> a -> b
$ (Result
r)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdCopyAccelerationStructureToMemoryKHR
  :: FunPtr (Ptr CommandBuffer_T -> Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR) -> IO ()) -> Ptr CommandBuffer_T -> Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR) -> IO ()

-- | vkCmdCopyAccelerationStructureToMemoryKHR - Copy an acceleration
-- structure to device memory
--
-- = Parameters
--
-- This command produces the same results as
-- 'copyAccelerationStructureToMemoryKHR', but writes its result to a
-- device address, and is executed on the device rather than the host. The
-- output /may/ not necessarily be bit-for-bit identical, but it can be
-- equally used by either 'cmdCopyMemoryToAccelerationStructureKHR' or
-- 'copyMemoryToAccelerationStructureKHR'.
--
-- = Description
--
-- -   @commandBuffer@ is the command buffer into which the command will be
--     recorded.
--
-- -   @pInfo@ is an a pointer to a
--     'CopyAccelerationStructureToMemoryInfoKHR' structure defining the
--     copy operation.
--
-- The defined header structure for the serialized data consists of:
--
-- -   'Vulkan.Core10.APIConstants.UUID_SIZE' bytes of data matching
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory_capabilities.PhysicalDeviceIDProperties'::@driverUUID@
--
-- -   'Vulkan.Core10.APIConstants.UUID_SIZE' bytes of data identifying the
--     compatibility for comparison using
--     'getDeviceAccelerationStructureCompatibilityKHR'
--
-- -   A 64-bit integer of the total size matching the value queried using
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_ACCELERATION_STRUCTURE_SERIALIZATION_SIZE_KHR'
--
-- -   A 64-bit integer of the deserialized size to be passed in to
--     'AccelerationStructureCreateInfoKHR'::@compactedSize@
--
-- -   A 64-bit integer of the count of the number of acceleration
--     structure handles following. This will be zero for a bottom-level
--     acceleration structure.
--
-- The corresponding handles matching the values returned by
-- 'getAccelerationStructureDeviceAddressKHR' or
-- 'Vulkan.Extensions.VK_NV_ray_tracing.getAccelerationStructureHandleNV'
-- are tightly packed in the buffer following the count. The application is
-- expected to store a mapping between those handles and the original
-- application-generated bottom-level acceleration structures to provide
-- when deserializing.
--
-- == Valid Usage
--
-- -   All 'DeviceOrHostAddressConstKHR' referenced by this command /must/
--     contain valid device addresses for a buffer bound to device memory.
--     If the buffer is non-sparse then it /must/ be bound completely and
--     contiguously to a single VkDeviceMemory object
--
-- -   All 'Vulkan.Extensions.Handles.AccelerationStructureKHR' objects
--     referenced by this command /must/ be bound to device memory
--
-- -   The
--     'Vulkan.Extensions.VK_KHR_deferred_host_operations.DeferredOperationInfoKHR'
--     structure /must/ not be included in the @pNext@ chain of the
--     'CopyAccelerationStructureToMemoryInfoKHR' structure
--
-- -   @mode@ /must/ be 'COPY_ACCELERATION_STRUCTURE_MODE_SERIALIZE_KHR'
--
-- == Valid Usage (Implicit)
--
-- -   @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   @pInfo@ /must/ be a valid pointer to a valid
--     'CopyAccelerationStructureToMemoryInfoKHR' structure
--
-- -   @commandBuffer@ /must/ be in the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#commandbuffers-lifecycle recording state>
--
-- -   The 'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support compute operations
--
-- -   This command /must/ only be called outside of a render pass instance
--
-- == 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> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-pipeline-stages-types Pipeline Type> |
-- +============================================================================================================================+========================================================================================================================+=======================================================================================================================+=====================================================================================================================================+
-- | Primary                                                                                                                    | Outside                                                                                                                | Compute                                                                                                               |                                                                                                                                     |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                       |                                                                                                                                     |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+-------------------------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- 'Vulkan.Core10.Handles.CommandBuffer',
-- 'CopyAccelerationStructureToMemoryInfoKHR'
cmdCopyAccelerationStructureToMemoryKHR :: forall a io
                                         . (Extendss CopyAccelerationStructureToMemoryInfoKHR a, PokeChain a, MonadIO io)
                                        => -- No documentation found for Nested "vkCmdCopyAccelerationStructureToMemoryKHR" "commandBuffer"
                                           CommandBuffer
                                        -> -- No documentation found for Nested "vkCmdCopyAccelerationStructureToMemoryKHR" "pInfo"
                                           (CopyAccelerationStructureToMemoryInfoKHR a)
                                        -> io ()
cmdCopyAccelerationStructureToMemoryKHR :: CommandBuffer
-> CopyAccelerationStructureToMemoryInfoKHR a -> io ()
cmdCopyAccelerationStructureToMemoryKHR commandBuffer :: CommandBuffer
commandBuffer info :: CopyAccelerationStructureToMemoryInfoKHR a
info = 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 vkCmdCopyAccelerationStructureToMemoryKHRPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("pInfo"
       ::: Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR))
   -> IO ())
vkCmdCopyAccelerationStructureToMemoryKHRPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pInfo"
          ::: Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR))
      -> IO ())
pVkCmdCopyAccelerationStructureToMemoryKHR (CommandBuffer -> DeviceCmds
deviceCmds (CommandBuffer
commandBuffer :: CommandBuffer))
  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
   -> ("pInfo"
       ::: Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR))
   -> IO ())
vkCmdCopyAccelerationStructureToMemoryKHRPtr FunPtr
  (Ptr CommandBuffer_T
   -> ("pInfo"
       ::: Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR))
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pInfo"
          ::: Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR))
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("pInfo"
       ::: Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR))
   -> 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 "" "The function pointer for vkCmdCopyAccelerationStructureToMemoryKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdCopyAccelerationStructureToMemoryKHR' :: Ptr CommandBuffer_T
-> ("pInfo"
    ::: Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR))
-> IO ()
vkCmdCopyAccelerationStructureToMemoryKHR' = FunPtr
  (Ptr CommandBuffer_T
   -> ("pInfo"
       ::: Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR))
   -> IO ())
-> Ptr CommandBuffer_T
-> ("pInfo"
    ::: Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR))
-> IO ()
mkVkCmdCopyAccelerationStructureToMemoryKHR FunPtr
  (Ptr CommandBuffer_T
   -> ("pInfo"
       ::: Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR))
   -> IO ())
vkCmdCopyAccelerationStructureToMemoryKHRPtr
  Ptr (CopyAccelerationStructureToMemoryInfoKHR a)
pInfo <- ((Ptr (CopyAccelerationStructureToMemoryInfoKHR a) -> IO ())
 -> IO ())
-> ContT () IO (Ptr (CopyAccelerationStructureToMemoryInfoKHR a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (CopyAccelerationStructureToMemoryInfoKHR a) -> IO ())
  -> IO ())
 -> ContT () IO (Ptr (CopyAccelerationStructureToMemoryInfoKHR a)))
-> ((Ptr (CopyAccelerationStructureToMemoryInfoKHR a) -> IO ())
    -> IO ())
-> ContT () IO (Ptr (CopyAccelerationStructureToMemoryInfoKHR a))
forall a b. (a -> b) -> a -> b
$ CopyAccelerationStructureToMemoryInfoKHR a
-> (Ptr (CopyAccelerationStructureToMemoryInfoKHR a) -> IO ())
-> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (CopyAccelerationStructureToMemoryInfoKHR a
info)
  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
$ Ptr CommandBuffer_T
-> ("pInfo"
    ::: Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR))
-> IO ()
vkCmdCopyAccelerationStructureToMemoryKHR' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) (Ptr (CopyAccelerationStructureToMemoryInfoKHR a)
-> "pInfo"
   ::: Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (CopyAccelerationStructureToMemoryInfoKHR a)
pInfo)
  () -> 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" mkVkCopyAccelerationStructureToMemoryKHR
  :: FunPtr (Ptr Device_T -> Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR) -> IO Result) -> Ptr Device_T -> Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR) -> IO Result

-- | vkCopyAccelerationStructureToMemoryKHR - Serialize an acceleration
-- structure on the host
--
-- = Parameters
--
-- This command fulfills the same task as
-- 'cmdCopyAccelerationStructureToMemoryKHR' but executed by the host.
--
-- = Description
--
-- This command produces the same results as
-- 'cmdCopyAccelerationStructureToMemoryKHR', but writes its result
-- directly to a host pointer, and is executed on the host rather than the
-- device. The output /may/ not necessarily be bit-for-bit identical, but
-- it can be equally used by either
-- 'cmdCopyMemoryToAccelerationStructureKHR' or
-- 'copyMemoryToAccelerationStructureKHR'.
--
-- -   @device@ is the device which owns @pInfo->src@.
--
-- -   @pInfo@ is a pointer to a 'CopyAccelerationStructureToMemoryInfoKHR'
--     structure defining the copy operation.
--
-- If the
-- 'Vulkan.Extensions.VK_KHR_deferred_host_operations.DeferredOperationInfoKHR'
-- structure is included in the @pNext@ chain of the
-- 'CopyAccelerationStructureToMemoryInfoKHR' structure, the operation of
-- this command is /deferred/, as defined in the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#deferred-host-operations>
-- chapter.
--
-- == Valid Usage
--
-- -   All 'Vulkan.Extensions.Handles.AccelerationStructureKHR' objects
--     referenced by this command /must/ be bound to host-visible memory
--
-- -   All 'DeviceOrHostAddressKHR' referenced by this command /must/
--     contain valid host pointers
--
-- -   the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-raytracing-hostascmds ::rayTracingHostAccelerationStructureCommands>
--     feature /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   @pInfo@ /must/ be a valid pointer to a valid
--     'CopyAccelerationStructureToMemoryInfoKHR' structure
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
--     -   'Vulkan.Core10.Enums.Result.OPERATION_DEFERRED_KHR'
--
--     -   'Vulkan.Core10.Enums.Result.OPERATION_NOT_DEFERRED_KHR'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
-- = See Also
--
-- 'CopyAccelerationStructureToMemoryInfoKHR',
-- 'Vulkan.Core10.Handles.Device'
copyAccelerationStructureToMemoryKHR :: forall a io
                                      . (Extendss CopyAccelerationStructureToMemoryInfoKHR a, PokeChain a, MonadIO io)
                                     => -- No documentation found for Nested "vkCopyAccelerationStructureToMemoryKHR" "device"
                                        Device
                                     -> -- No documentation found for Nested "vkCopyAccelerationStructureToMemoryKHR" "pInfo"
                                        (CopyAccelerationStructureToMemoryInfoKHR a)
                                     -> io (Result)
copyAccelerationStructureToMemoryKHR :: Device -> CopyAccelerationStructureToMemoryInfoKHR a -> io Result
copyAccelerationStructureToMemoryKHR device :: Device
device info :: CopyAccelerationStructureToMemoryInfoKHR a
info = IO Result -> io Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> io Result)
-> (ContT Result IO Result -> IO Result)
-> ContT Result IO Result
-> io Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Result IO Result -> IO Result
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Result IO Result -> io Result)
-> ContT Result IO Result -> io Result
forall a b. (a -> b) -> a -> b
$ do
  let vkCopyAccelerationStructureToMemoryKHRPtr :: FunPtr
  (Ptr Device_T
   -> ("pInfo"
       ::: Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR))
   -> IO Result)
vkCopyAccelerationStructureToMemoryKHRPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pInfo"
          ::: Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR))
      -> IO Result)
pVkCopyAccelerationStructureToMemoryKHR (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  IO () -> ContT Result IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Result IO ()) -> IO () -> ContT Result IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("pInfo"
       ::: Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR))
   -> IO Result)
vkCopyAccelerationStructureToMemoryKHRPtr FunPtr
  (Ptr Device_T
   -> ("pInfo"
       ::: Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR))
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> ("pInfo"
          ::: Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR))
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ("pInfo"
       ::: Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR))
   -> IO Result)
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 "" "The function pointer for vkCopyAccelerationStructureToMemoryKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCopyAccelerationStructureToMemoryKHR' :: Ptr Device_T
-> ("pInfo"
    ::: Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR))
-> IO Result
vkCopyAccelerationStructureToMemoryKHR' = FunPtr
  (Ptr Device_T
   -> ("pInfo"
       ::: Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR))
   -> IO Result)
-> Ptr Device_T
-> ("pInfo"
    ::: Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR))
-> IO Result
mkVkCopyAccelerationStructureToMemoryKHR FunPtr
  (Ptr Device_T
   -> ("pInfo"
       ::: Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR))
   -> IO Result)
vkCopyAccelerationStructureToMemoryKHRPtr
  Ptr (CopyAccelerationStructureToMemoryInfoKHR a)
pInfo <- ((Ptr (CopyAccelerationStructureToMemoryInfoKHR a) -> IO Result)
 -> IO Result)
-> ContT
     Result IO (Ptr (CopyAccelerationStructureToMemoryInfoKHR a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (CopyAccelerationStructureToMemoryInfoKHR a) -> IO Result)
  -> IO Result)
 -> ContT
      Result IO (Ptr (CopyAccelerationStructureToMemoryInfoKHR a)))
-> ((Ptr (CopyAccelerationStructureToMemoryInfoKHR a) -> IO Result)
    -> IO Result)
-> ContT
     Result IO (Ptr (CopyAccelerationStructureToMemoryInfoKHR a))
forall a b. (a -> b) -> a -> b
$ CopyAccelerationStructureToMemoryInfoKHR a
-> (Ptr (CopyAccelerationStructureToMemoryInfoKHR a) -> IO Result)
-> IO Result
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (CopyAccelerationStructureToMemoryInfoKHR a
info)
  Result
r <- IO Result -> ContT Result IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT Result IO Result)
-> IO Result -> ContT Result IO Result
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> ("pInfo"
    ::: Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR))
-> IO Result
vkCopyAccelerationStructureToMemoryKHR' (Device -> Ptr Device_T
deviceHandle (Device
device)) (Ptr (CopyAccelerationStructureToMemoryInfoKHR a)
-> "pInfo"
   ::: Ptr (SomeStruct CopyAccelerationStructureToMemoryInfoKHR)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (CopyAccelerationStructureToMemoryInfoKHR a)
pInfo)
  IO () -> ContT Result IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Result IO ()) -> IO () -> ContT Result IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  Result -> ContT Result IO Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> ContT Result IO Result)
-> Result -> ContT Result IO Result
forall a b. (a -> b) -> a -> b
$ (Result
r)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdCopyMemoryToAccelerationStructureKHR
  :: FunPtr (Ptr CommandBuffer_T -> Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR) -> IO ()) -> Ptr CommandBuffer_T -> Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR) -> IO ()

-- | vkCmdCopyMemoryToAccelerationStructureKHR - Copy device memory to an
-- acceleration structure
--
-- = Parameters
--
-- This command can accept acceleration structures produced by either
-- 'cmdCopyAccelerationStructureToMemoryKHR' or
-- 'copyAccelerationStructureToMemoryKHR'.
--
-- = Description
--
-- -   @commandBuffer@ is the command buffer into which the command will be
--     recorded.
--
-- -   @pInfo@ is a pointer to a 'CopyMemoryToAccelerationStructureInfoKHR'
--     structure defining the copy operation.
--
-- The structure provided as input to deserialize is as described in
-- 'cmdCopyAccelerationStructureToMemoryKHR', with any acceleration
-- structure handles filled in with the newly-queried handles to bottom
-- level acceleration structures created before deserialization. These do
-- not need to be built at deserialize time, but /must/ be created.
--
-- == Valid Usage
--
-- -   All 'DeviceOrHostAddressKHR' referenced by this command /must/
--     contain valid device addresses for a buffer bound to device memory.
--     If the buffer is non-sparse then it /must/ be bound completely and
--     contiguously to a single VkDeviceMemory object
--
-- -   All 'Vulkan.Extensions.Handles.AccelerationStructureKHR' objects
--     referenced by this command /must/ be bound to device memory
--
-- -   The
--     'Vulkan.Extensions.VK_KHR_deferred_host_operations.DeferredOperationInfoKHR'
--     structure /must/ not be included in the @pNext@ chain of the
--     'CopyMemoryToAccelerationStructureInfoKHR' structure
--
-- -   @mode@ /must/ be 'COPY_ACCELERATION_STRUCTURE_MODE_DESERIALIZE_KHR'
--
-- -   The data in @pInfo->src@ /must/ have a format compatible with the
--     destination physical device as returned by
--     'getDeviceAccelerationStructureCompatibilityKHR'
--
-- == Valid Usage (Implicit)
--
-- -   @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   @pInfo@ /must/ be a valid pointer to a valid
--     'CopyMemoryToAccelerationStructureInfoKHR' structure
--
-- -   @commandBuffer@ /must/ be in the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#commandbuffers-lifecycle recording state>
--
-- -   The 'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support compute operations
--
-- -   This command /must/ only be called outside of a render pass instance
--
-- == 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> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-pipeline-stages-types Pipeline Type> |
-- +============================================================================================================================+========================================================================================================================+=======================================================================================================================+=====================================================================================================================================+
-- | Primary                                                                                                                    | Outside                                                                                                                | Compute                                                                                                               |                                                                                                                                     |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                       |                                                                                                                                     |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+-------------------------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- 'Vulkan.Core10.Handles.CommandBuffer',
-- 'CopyMemoryToAccelerationStructureInfoKHR'
cmdCopyMemoryToAccelerationStructureKHR :: forall a io
                                         . (Extendss CopyMemoryToAccelerationStructureInfoKHR a, PokeChain a, MonadIO io)
                                        => -- No documentation found for Nested "vkCmdCopyMemoryToAccelerationStructureKHR" "commandBuffer"
                                           CommandBuffer
                                        -> -- No documentation found for Nested "vkCmdCopyMemoryToAccelerationStructureKHR" "pInfo"
                                           (CopyMemoryToAccelerationStructureInfoKHR a)
                                        -> io ()
cmdCopyMemoryToAccelerationStructureKHR :: CommandBuffer
-> CopyMemoryToAccelerationStructureInfoKHR a -> io ()
cmdCopyMemoryToAccelerationStructureKHR commandBuffer :: CommandBuffer
commandBuffer info :: CopyMemoryToAccelerationStructureInfoKHR a
info = 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 vkCmdCopyMemoryToAccelerationStructureKHRPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("pInfo"
       ::: Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR))
   -> IO ())
vkCmdCopyMemoryToAccelerationStructureKHRPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pInfo"
          ::: Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR))
      -> IO ())
pVkCmdCopyMemoryToAccelerationStructureKHR (CommandBuffer -> DeviceCmds
deviceCmds (CommandBuffer
commandBuffer :: CommandBuffer))
  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
   -> ("pInfo"
       ::: Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR))
   -> IO ())
vkCmdCopyMemoryToAccelerationStructureKHRPtr FunPtr
  (Ptr CommandBuffer_T
   -> ("pInfo"
       ::: Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR))
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pInfo"
          ::: Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR))
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("pInfo"
       ::: Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR))
   -> 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 "" "The function pointer for vkCmdCopyMemoryToAccelerationStructureKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdCopyMemoryToAccelerationStructureKHR' :: Ptr CommandBuffer_T
-> ("pInfo"
    ::: Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR))
-> IO ()
vkCmdCopyMemoryToAccelerationStructureKHR' = FunPtr
  (Ptr CommandBuffer_T
   -> ("pInfo"
       ::: Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR))
   -> IO ())
-> Ptr CommandBuffer_T
-> ("pInfo"
    ::: Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR))
-> IO ()
mkVkCmdCopyMemoryToAccelerationStructureKHR FunPtr
  (Ptr CommandBuffer_T
   -> ("pInfo"
       ::: Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR))
   -> IO ())
vkCmdCopyMemoryToAccelerationStructureKHRPtr
  Ptr (CopyMemoryToAccelerationStructureInfoKHR a)
pInfo <- ((Ptr (CopyMemoryToAccelerationStructureInfoKHR a) -> IO ())
 -> IO ())
-> ContT () IO (Ptr (CopyMemoryToAccelerationStructureInfoKHR a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (CopyMemoryToAccelerationStructureInfoKHR a) -> IO ())
  -> IO ())
 -> ContT () IO (Ptr (CopyMemoryToAccelerationStructureInfoKHR a)))
-> ((Ptr (CopyMemoryToAccelerationStructureInfoKHR a) -> IO ())
    -> IO ())
-> ContT () IO (Ptr (CopyMemoryToAccelerationStructureInfoKHR a))
forall a b. (a -> b) -> a -> b
$ CopyMemoryToAccelerationStructureInfoKHR a
-> (Ptr (CopyMemoryToAccelerationStructureInfoKHR a) -> IO ())
-> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (CopyMemoryToAccelerationStructureInfoKHR a
info)
  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
$ Ptr CommandBuffer_T
-> ("pInfo"
    ::: Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR))
-> IO ()
vkCmdCopyMemoryToAccelerationStructureKHR' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) (Ptr (CopyMemoryToAccelerationStructureInfoKHR a)
-> "pInfo"
   ::: Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (CopyMemoryToAccelerationStructureInfoKHR a)
pInfo)
  () -> 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" mkVkCopyMemoryToAccelerationStructureKHR
  :: FunPtr (Ptr Device_T -> Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR) -> IO Result) -> Ptr Device_T -> Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR) -> IO Result

-- | vkCopyMemoryToAccelerationStructureKHR - Deserialize an acceleration
-- structure on the host
--
-- = Parameters
--
-- This command fulfills the same task as
-- 'cmdCopyMemoryToAccelerationStructureKHR' but is executed by the host.
--
-- = Description
--
-- This command can accept acceleration structures produced by either
-- 'cmdCopyAccelerationStructureToMemoryKHR' or
-- 'copyAccelerationStructureToMemoryKHR'.
--
-- -   @device@ is the device which owns @pInfo->dst@.
--
-- -   @pInfo@ is a pointer to a 'CopyMemoryToAccelerationStructureInfoKHR'
--     structure defining the copy operation.
--
-- If the
-- 'Vulkan.Extensions.VK_KHR_deferred_host_operations.DeferredOperationInfoKHR'
-- structure is included in the @pNext@ chain of the
-- 'CopyMemoryToAccelerationStructureInfoKHR' structure, the operation of
-- this command is /deferred/, as defined in the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#deferred-host-operations Deferred Host Operations>
-- chapter.
--
-- == Valid Usage
--
-- -   All 'Vulkan.Extensions.Handles.AccelerationStructureKHR' objects
--     referenced by this command /must/ be bound to host-visible memory
--
-- -   All 'DeviceOrHostAddressConstKHR' referenced by this command /must/
--     contain valid host pointers
--
-- -   the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-raytracing-hostascmds ::rayTracingHostAccelerationStructureCommands>
--     feature /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   @pInfo@ /must/ be a valid pointer to a valid
--     'CopyMemoryToAccelerationStructureInfoKHR' structure
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
--     -   'Vulkan.Core10.Enums.Result.OPERATION_DEFERRED_KHR'
--
--     -   'Vulkan.Core10.Enums.Result.OPERATION_NOT_DEFERRED_KHR'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
-- = See Also
--
-- 'CopyMemoryToAccelerationStructureInfoKHR',
-- 'Vulkan.Core10.Handles.Device'
copyMemoryToAccelerationStructureKHR :: forall a io
                                      . (Extendss CopyMemoryToAccelerationStructureInfoKHR a, PokeChain a, MonadIO io)
                                     => -- No documentation found for Nested "vkCopyMemoryToAccelerationStructureKHR" "device"
                                        Device
                                     -> -- No documentation found for Nested "vkCopyMemoryToAccelerationStructureKHR" "pInfo"
                                        (CopyMemoryToAccelerationStructureInfoKHR a)
                                     -> io (Result)
copyMemoryToAccelerationStructureKHR :: Device -> CopyMemoryToAccelerationStructureInfoKHR a -> io Result
copyMemoryToAccelerationStructureKHR device :: Device
device info :: CopyMemoryToAccelerationStructureInfoKHR a
info = IO Result -> io Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> io Result)
-> (ContT Result IO Result -> IO Result)
-> ContT Result IO Result
-> io Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Result IO Result -> IO Result
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Result IO Result -> io Result)
-> ContT Result IO Result -> io Result
forall a b. (a -> b) -> a -> b
$ do
  let vkCopyMemoryToAccelerationStructureKHRPtr :: FunPtr
  (Ptr Device_T
   -> ("pInfo"
       ::: Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR))
   -> IO Result)
vkCopyMemoryToAccelerationStructureKHRPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pInfo"
          ::: Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR))
      -> IO Result)
pVkCopyMemoryToAccelerationStructureKHR (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  IO () -> ContT Result IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Result IO ()) -> IO () -> ContT Result IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("pInfo"
       ::: Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR))
   -> IO Result)
vkCopyMemoryToAccelerationStructureKHRPtr FunPtr
  (Ptr Device_T
   -> ("pInfo"
       ::: Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR))
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> ("pInfo"
          ::: Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR))
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ("pInfo"
       ::: Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR))
   -> IO Result)
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 "" "The function pointer for vkCopyMemoryToAccelerationStructureKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCopyMemoryToAccelerationStructureKHR' :: Ptr Device_T
-> ("pInfo"
    ::: Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR))
-> IO Result
vkCopyMemoryToAccelerationStructureKHR' = FunPtr
  (Ptr Device_T
   -> ("pInfo"
       ::: Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR))
   -> IO Result)
-> Ptr Device_T
-> ("pInfo"
    ::: Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR))
-> IO Result
mkVkCopyMemoryToAccelerationStructureKHR FunPtr
  (Ptr Device_T
   -> ("pInfo"
       ::: Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR))
   -> IO Result)
vkCopyMemoryToAccelerationStructureKHRPtr
  Ptr (CopyMemoryToAccelerationStructureInfoKHR a)
pInfo <- ((Ptr (CopyMemoryToAccelerationStructureInfoKHR a) -> IO Result)
 -> IO Result)
-> ContT
     Result IO (Ptr (CopyMemoryToAccelerationStructureInfoKHR a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (CopyMemoryToAccelerationStructureInfoKHR a) -> IO Result)
  -> IO Result)
 -> ContT
      Result IO (Ptr (CopyMemoryToAccelerationStructureInfoKHR a)))
-> ((Ptr (CopyMemoryToAccelerationStructureInfoKHR a) -> IO Result)
    -> IO Result)
-> ContT
     Result IO (Ptr (CopyMemoryToAccelerationStructureInfoKHR a))
forall a b. (a -> b) -> a -> b
$ CopyMemoryToAccelerationStructureInfoKHR a
-> (Ptr (CopyMemoryToAccelerationStructureInfoKHR a) -> IO Result)
-> IO Result
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (CopyMemoryToAccelerationStructureInfoKHR a
info)
  Result
r <- IO Result -> ContT Result IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT Result IO Result)
-> IO Result -> ContT Result IO Result
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> ("pInfo"
    ::: Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR))
-> IO Result
vkCopyMemoryToAccelerationStructureKHR' (Device -> Ptr Device_T
deviceHandle (Device
device)) (Ptr (CopyMemoryToAccelerationStructureInfoKHR a)
-> "pInfo"
   ::: Ptr (SomeStruct CopyMemoryToAccelerationStructureInfoKHR)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (CopyMemoryToAccelerationStructureInfoKHR a)
pInfo)
  IO () -> ContT Result IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Result IO ()) -> IO () -> ContT Result IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  Result -> ContT Result IO Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> ContT Result IO Result)
-> Result -> ContT Result IO Result
forall a b. (a -> b) -> a -> b
$ (Result
r)


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

-- | vkCmdWriteAccelerationStructuresPropertiesKHR - Write acceleration
-- structure result parameters to query results.
--
-- == Valid Usage
--
-- -   @queryPool@ /must/ have been created with a @queryType@ matching
--     @queryType@
--
-- -   The queries identified by @queryPool@ and @firstQuery@ /must/ be
--     /unavailable/
--
-- -   All acceleration structures in @accelerationStructures@ /must/ have
--     been built with
--     'BUILD_ACCELERATION_STRUCTURE_ALLOW_COMPACTION_BIT_KHR' if
--     @queryType@ is
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_ACCELERATION_STRUCTURE_COMPACTED_SIZE_KHR'
--
-- -   @queryType@ /must/ be
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_ACCELERATION_STRUCTURE_COMPACTED_SIZE_KHR'
--     or
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_ACCELERATION_STRUCTURE_SERIALIZATION_SIZE_KHR'
--
-- == Valid Usage (Implicit)
--
-- -   @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   @pAccelerationStructures@ /must/ be a valid pointer to an array of
--     @accelerationStructureCount@ valid
--     'Vulkan.Extensions.Handles.AccelerationStructureKHR' handles
--
-- -   @queryType@ /must/ be a valid
--     'Vulkan.Core10.Enums.QueryType.QueryType' value
--
-- -   @queryPool@ /must/ be a valid 'Vulkan.Core10.Handles.QueryPool'
--     handle
--
-- -   @commandBuffer@ /must/ be in the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#commandbuffers-lifecycle recording state>
--
-- -   The 'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support compute operations
--
-- -   This command /must/ only be called outside of a render pass instance
--
-- -   @accelerationStructureCount@ /must/ be greater than @0@
--
-- -   Each of @commandBuffer@, @queryPool@, and the elements of
--     @pAccelerationStructures@ /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> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-pipeline-stages-types Pipeline Type> |
-- +============================================================================================================================+========================================================================================================================+=======================================================================================================================+=====================================================================================================================================+
-- | Primary                                                                                                                    | Outside                                                                                                                | Compute                                                                                                               |                                                                                                                                     |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                       |                                                                                                                                     |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+-------------------------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- 'Vulkan.Extensions.Handles.AccelerationStructureKHR',
-- 'Vulkan.Core10.Handles.CommandBuffer',
-- 'Vulkan.Core10.Handles.QueryPool',
-- 'Vulkan.Core10.Enums.QueryType.QueryType'
cmdWriteAccelerationStructuresPropertiesKHR :: forall io
                                             . (MonadIO io)
                                            => -- | @commandBuffer@ is the command buffer into which the command will be
                                               -- recorded.
                                               CommandBuffer
                                            -> -- | @pAccelerationStructures@ is a pointer to an array of existing
                                               -- previously built acceleration structures.
                                               ("accelerationStructures" ::: Vector AccelerationStructureKHR)
                                            -> -- | @queryType@ is a 'Vulkan.Core10.Enums.QueryType.QueryType' value
                                               -- specifying the type of queries managed by the pool.
                                               QueryType
                                            -> -- | @queryPool@ is the query pool that will manage the results of the query.
                                               QueryPool
                                            -> -- | @firstQuery@ is the first query index within the query pool that will
                                               -- contain the @accelerationStructureCount@ number of results.
                                               ("firstQuery" ::: Word32)
                                            -> io ()
cmdWriteAccelerationStructuresPropertiesKHR :: CommandBuffer
-> ("accelerationStructures" ::: Vector AccelerationStructureKHR)
-> QueryType
-> QueryPool
-> ("bindInfoCount" ::: Word32)
-> io ()
cmdWriteAccelerationStructuresPropertiesKHR commandBuffer :: CommandBuffer
commandBuffer accelerationStructures :: "accelerationStructures" ::: Vector AccelerationStructureKHR
accelerationStructures queryType :: QueryType
queryType queryPool :: QueryPool
queryPool firstQuery :: "bindInfoCount" ::: Word32
firstQuery = 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 vkCmdWriteAccelerationStructuresPropertiesKHRPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
   -> QueryType
   -> QueryPool
   -> ("bindInfoCount" ::: Word32)
   -> IO ())
vkCmdWriteAccelerationStructuresPropertiesKHRPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("bindInfoCount" ::: Word32)
      -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
      -> QueryType
      -> QueryPool
      -> ("bindInfoCount" ::: Word32)
      -> IO ())
pVkCmdWriteAccelerationStructuresPropertiesKHR (CommandBuffer -> DeviceCmds
deviceCmds (CommandBuffer
commandBuffer :: CommandBuffer))
  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
   -> ("bindInfoCount" ::: Word32)
   -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
   -> QueryType
   -> QueryPool
   -> ("bindInfoCount" ::: Word32)
   -> IO ())
vkCmdWriteAccelerationStructuresPropertiesKHRPtr FunPtr
  (Ptr CommandBuffer_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
   -> QueryType
   -> QueryPool
   -> ("bindInfoCount" ::: Word32)
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("bindInfoCount" ::: Word32)
      -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
      -> QueryType
      -> QueryPool
      -> ("bindInfoCount" ::: Word32)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
   -> QueryType
   -> QueryPool
   -> ("bindInfoCount" ::: Word32)
   -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkCmdWriteAccelerationStructuresPropertiesKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdWriteAccelerationStructuresPropertiesKHR' :: Ptr CommandBuffer_T
-> ("bindInfoCount" ::: Word32)
-> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
-> QueryType
-> QueryPool
-> ("bindInfoCount" ::: Word32)
-> IO ()
vkCmdWriteAccelerationStructuresPropertiesKHR' = FunPtr
  (Ptr CommandBuffer_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
   -> QueryType
   -> QueryPool
   -> ("bindInfoCount" ::: Word32)
   -> IO ())
-> Ptr CommandBuffer_T
-> ("bindInfoCount" ::: Word32)
-> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
-> QueryType
-> QueryPool
-> ("bindInfoCount" ::: Word32)
-> IO ()
mkVkCmdWriteAccelerationStructuresPropertiesKHR FunPtr
  (Ptr CommandBuffer_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
   -> QueryType
   -> QueryPool
   -> ("bindInfoCount" ::: Word32)
   -> IO ())
vkCmdWriteAccelerationStructuresPropertiesKHRPtr
  "pAccelerationStructures" ::: Ptr AccelerationStructureKHR
pPAccelerationStructures <- ((("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
  -> IO ())
 -> IO ())
-> ContT
     () IO ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
   -> IO ())
  -> IO ())
 -> ContT
      () IO ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR))
-> ((("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
     -> IO ())
    -> IO ())
-> ContT
     () IO ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> (("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
    -> IO ())
-> IO ()
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @AccelerationStructureKHR ((("accelerationStructures" ::: Vector AccelerationStructureKHR)
-> Int
forall a. Vector a -> Int
Data.Vector.length ("accelerationStructures" ::: Vector AccelerationStructureKHR
accelerationStructures)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 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 -> AccelerationStructureKHR -> IO ())
-> ("accelerationStructures" ::: Vector AccelerationStructureKHR)
-> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: AccelerationStructureKHR
e -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
-> AccelerationStructureKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR
pPAccelerationStructures ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
-> Int
-> "pAccelerationStructures" ::: Ptr AccelerationStructureKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr AccelerationStructureKHR) (AccelerationStructureKHR
e)) ("accelerationStructures" ::: Vector AccelerationStructureKHR
accelerationStructures)
  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
$ Ptr CommandBuffer_T
-> ("bindInfoCount" ::: Word32)
-> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
-> QueryType
-> QueryPool
-> ("bindInfoCount" ::: Word32)
-> IO ()
vkCmdWriteAccelerationStructuresPropertiesKHR' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) ((Int -> "bindInfoCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("accelerationStructures" ::: Vector AccelerationStructureKHR)
-> Int
forall a. Vector a -> Int
Data.Vector.length (("accelerationStructures" ::: Vector AccelerationStructureKHR)
 -> Int)
-> ("accelerationStructures" ::: Vector AccelerationStructureKHR)
-> Int
forall a b. (a -> b) -> a -> b
$ ("accelerationStructures" ::: Vector AccelerationStructureKHR
accelerationStructures)) :: Word32)) ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR
pPAccelerationStructures) (QueryType
queryType) (QueryPool
queryPool) ("bindInfoCount" ::: Word32
firstQuery)
  () -> 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" mkVkWriteAccelerationStructuresPropertiesKHR
  :: FunPtr (Ptr Device_T -> Word32 -> Ptr AccelerationStructureKHR -> QueryType -> CSize -> Ptr () -> CSize -> IO Result) -> Ptr Device_T -> Word32 -> Ptr AccelerationStructureKHR -> QueryType -> CSize -> Ptr () -> CSize -> IO Result

-- | vkWriteAccelerationStructuresPropertiesKHR - Query acceleration
-- structure meta-data on the host
--
-- = Parameters
--
-- This command fulfills the same task as
-- 'cmdWriteAccelerationStructuresPropertiesKHR' but executed by the host.
--
-- = Description
--
-- -   @device@ is the device which owns the acceleration structures in
--     @pAccelerationStructures@.
--
-- -   @accelerationStructureCount@ is the count of acceleration structures
--     for which to query the property.
--
-- -   @pAccelerationStructures@ points to an array of existing previously
--     built acceleration structures.
--
-- -   @queryType@ is a 'Vulkan.Core10.Enums.QueryType.QueryType' value
--     specifying the property to be queried.
--
-- -   @dataSize@ is the size in bytes of the buffer pointed to by @pData@.
--
-- -   @pData@ is a pointer to a user-allocated buffer where the results
--     will be written.
--
-- -   @stride@ is the stride in bytes between results for individual
--     queries within @pData@.
--
-- == Valid Usage
--
-- -   If @queryType@ is
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_ACCELERATION_STRUCTURE_COMPACTED_SIZE_KHR',
--     then @stride@ /must/ be a multiple of the size of
--     'Vulkan.Core10.FundamentalTypes.DeviceSize'
--
-- -   If @queryType@ is
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_ACCELERATION_STRUCTURE_COMPACTED_SIZE_KHR',
--     then @data@ /must/ point to a
--     'Vulkan.Core10.FundamentalTypes.DeviceSize'
--
-- -   If @queryType@ is
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_ACCELERATION_STRUCTURE_SERIALIZATION_SIZE_KHR',
--     then @stride@ /must/ be a multiple of the size of
--     'Vulkan.Core10.FundamentalTypes.DeviceSize'
--
-- -   If @queryType@ is
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_ACCELERATION_STRUCTURE_SERIALIZATION_SIZE_KHR',
--     then @data@ /must/ point to a
--     'Vulkan.Core10.FundamentalTypes.DeviceSize'
--
-- -   @dataSize@ /must/ be greater than or equal to
--     @accelerationStructureCount@*@stride@
--
-- -   The acceleration structures referenced by @pAccelerationStructures@
--     /must/ be bound to host-visible memory
--
-- -   All acceleration structures in @accelerationStructures@ /must/ have
--     been built with
--     'BUILD_ACCELERATION_STRUCTURE_ALLOW_COMPACTION_BIT_KHR' if
--     @queryType@ is
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_ACCELERATION_STRUCTURE_COMPACTED_SIZE_KHR'
--
-- -   @queryType@ /must/ be
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_ACCELERATION_STRUCTURE_COMPACTED_SIZE_KHR'
--     or
--     'Vulkan.Core10.Enums.QueryType.QUERY_TYPE_ACCELERATION_STRUCTURE_SERIALIZATION_SIZE_KHR'
--
-- -   the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-raytracing-hostascmds ::rayTracingHostAccelerationStructureCommands>
--     feature /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   @pAccelerationStructures@ /must/ be a valid pointer to an array of
--     @accelerationStructureCount@ valid
--     'Vulkan.Extensions.Handles.AccelerationStructureKHR' handles
--
-- -   @queryType@ /must/ be a valid
--     'Vulkan.Core10.Enums.QueryType.QueryType' value
--
-- -   @pData@ /must/ be a valid pointer to an array of @dataSize@ bytes
--
-- -   @accelerationStructureCount@ /must/ be greater than @0@
--
-- -   @dataSize@ /must/ be greater than @0@
--
-- -   Each element of @pAccelerationStructures@ /must/ have been created,
--     allocated, or retrieved from @device@
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
-- = See Also
--
-- 'Vulkan.Extensions.Handles.AccelerationStructureKHR',
-- 'Vulkan.Core10.Handles.Device',
-- 'Vulkan.Core10.Enums.QueryType.QueryType'
writeAccelerationStructuresPropertiesKHR :: forall io
                                          . (MonadIO io)
                                         => -- No documentation found for Nested "vkWriteAccelerationStructuresPropertiesKHR" "device"
                                            Device
                                         -> -- No documentation found for Nested "vkWriteAccelerationStructuresPropertiesKHR" "pAccelerationStructures"
                                            ("accelerationStructures" ::: Vector AccelerationStructureKHR)
                                         -> -- No documentation found for Nested "vkWriteAccelerationStructuresPropertiesKHR" "queryType"
                                            QueryType
                                         -> -- No documentation found for Nested "vkWriteAccelerationStructuresPropertiesKHR" "dataSize"
                                            ("dataSize" ::: Word64)
                                         -> -- No documentation found for Nested "vkWriteAccelerationStructuresPropertiesKHR" "pData"
                                            ("data" ::: Ptr ())
                                         -> -- No documentation found for Nested "vkWriteAccelerationStructuresPropertiesKHR" "stride"
                                            ("stride" ::: Word64)
                                         -> io ()
writeAccelerationStructuresPropertiesKHR :: Device
-> ("accelerationStructures" ::: Vector AccelerationStructureKHR)
-> QueryType
-> ("dataSize" ::: Word64)
-> ("data" ::: Ptr ())
-> ("dataSize" ::: Word64)
-> io ()
writeAccelerationStructuresPropertiesKHR device :: Device
device accelerationStructures :: "accelerationStructures" ::: Vector AccelerationStructureKHR
accelerationStructures queryType :: QueryType
queryType dataSize :: "dataSize" ::: Word64
dataSize data' :: "data" ::: Ptr ()
data' stride :: "dataSize" ::: Word64
stride = 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 vkWriteAccelerationStructuresPropertiesKHRPtr :: FunPtr
  (Ptr Device_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
   -> QueryType
   -> ("dataSize" ::: CSize)
   -> ("data" ::: Ptr ())
   -> ("dataSize" ::: CSize)
   -> IO Result)
vkWriteAccelerationStructuresPropertiesKHRPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("bindInfoCount" ::: Word32)
      -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
      -> QueryType
      -> ("dataSize" ::: CSize)
      -> ("data" ::: Ptr ())
      -> ("dataSize" ::: CSize)
      -> IO Result)
pVkWriteAccelerationStructuresPropertiesKHR (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  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 Device_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
   -> QueryType
   -> ("dataSize" ::: CSize)
   -> ("data" ::: Ptr ())
   -> ("dataSize" ::: CSize)
   -> IO Result)
vkWriteAccelerationStructuresPropertiesKHRPtr FunPtr
  (Ptr Device_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
   -> QueryType
   -> ("dataSize" ::: CSize)
   -> ("data" ::: Ptr ())
   -> ("dataSize" ::: CSize)
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> ("bindInfoCount" ::: Word32)
      -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
      -> QueryType
      -> ("dataSize" ::: CSize)
      -> ("data" ::: Ptr ())
      -> ("dataSize" ::: CSize)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
   -> QueryType
   -> ("dataSize" ::: CSize)
   -> ("data" ::: Ptr ())
   -> ("dataSize" ::: CSize)
   -> IO Result)
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 "" "The function pointer for vkWriteAccelerationStructuresPropertiesKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkWriteAccelerationStructuresPropertiesKHR' :: Ptr Device_T
-> ("bindInfoCount" ::: Word32)
-> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
-> QueryType
-> ("dataSize" ::: CSize)
-> ("data" ::: Ptr ())
-> ("dataSize" ::: CSize)
-> IO Result
vkWriteAccelerationStructuresPropertiesKHR' = FunPtr
  (Ptr Device_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
   -> QueryType
   -> ("dataSize" ::: CSize)
   -> ("data" ::: Ptr ())
   -> ("dataSize" ::: CSize)
   -> IO Result)
-> Ptr Device_T
-> ("bindInfoCount" ::: Word32)
-> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
-> QueryType
-> ("dataSize" ::: CSize)
-> ("data" ::: Ptr ())
-> ("dataSize" ::: CSize)
-> IO Result
mkVkWriteAccelerationStructuresPropertiesKHR FunPtr
  (Ptr Device_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
   -> QueryType
   -> ("dataSize" ::: CSize)
   -> ("data" ::: Ptr ())
   -> ("dataSize" ::: CSize)
   -> IO Result)
vkWriteAccelerationStructuresPropertiesKHRPtr
  "pAccelerationStructures" ::: Ptr AccelerationStructureKHR
pPAccelerationStructures <- ((("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
  -> IO ())
 -> IO ())
-> ContT
     () IO ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
   -> IO ())
  -> IO ())
 -> ContT
      () IO ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR))
-> ((("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
     -> IO ())
    -> IO ())
-> ContT
     () IO ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> (("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
    -> IO ())
-> IO ()
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @AccelerationStructureKHR ((("accelerationStructures" ::: Vector AccelerationStructureKHR)
-> Int
forall a. Vector a -> Int
Data.Vector.length ("accelerationStructures" ::: Vector AccelerationStructureKHR
accelerationStructures)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 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 -> AccelerationStructureKHR -> IO ())
-> ("accelerationStructures" ::: Vector AccelerationStructureKHR)
-> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: AccelerationStructureKHR
e -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
-> AccelerationStructureKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR
pPAccelerationStructures ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
-> Int
-> "pAccelerationStructures" ::: Ptr AccelerationStructureKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr AccelerationStructureKHR) (AccelerationStructureKHR
e)) ("accelerationStructures" ::: Vector AccelerationStructureKHR
accelerationStructures)
  Result
r <- IO Result -> ContT () IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT () IO Result)
-> IO Result -> ContT () IO Result
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> ("bindInfoCount" ::: Word32)
-> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
-> QueryType
-> ("dataSize" ::: CSize)
-> ("data" ::: Ptr ())
-> ("dataSize" ::: CSize)
-> IO Result
vkWriteAccelerationStructuresPropertiesKHR' (Device -> Ptr Device_T
deviceHandle (Device
device)) ((Int -> "bindInfoCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("accelerationStructures" ::: Vector AccelerationStructureKHR)
-> Int
forall a. Vector a -> Int
Data.Vector.length (("accelerationStructures" ::: Vector AccelerationStructureKHR)
 -> Int)
-> ("accelerationStructures" ::: Vector AccelerationStructureKHR)
-> Int
forall a b. (a -> b) -> a -> b
$ ("accelerationStructures" ::: Vector AccelerationStructureKHR
accelerationStructures)) :: Word32)) ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR
pPAccelerationStructures) (QueryType
queryType) (("dataSize" ::: Word64) -> "dataSize" ::: CSize
CSize ("dataSize" ::: Word64
dataSize)) ("data" ::: Ptr ()
data') (("dataSize" ::: Word64) -> "dataSize" ::: CSize
CSize ("dataSize" ::: Word64
stride))
  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 ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))


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

-- | vkCmdTraceRaysKHR - Initialize a ray tracing dispatch
--
-- = Description
--
-- When the command is executed, a ray generation group of @width@ ×
-- @height@ × @depth@ rays is assembled.
--
-- == Valid Usage
--
-- -   If a 'Vulkan.Core10.Handles.Sampler' created with @magFilter@ or
--     @minFilter@ equal to 'Vulkan.Core10.Enums.Filter.FILTER_LINEAR' and
--     @compareEnable@ equal to 'Vulkan.Core10.FundamentalTypes.FALSE' is
--     used to sample a 'Vulkan.Core10.Handles.ImageView' as a result of
--     this command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_SAMPLED_IMAGE_FILTER_LINEAR_BIT'
--
-- -   If a 'Vulkan.Core10.Handles.ImageView' is accessed using atomic
--     operations as a result of this command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_STORAGE_IMAGE_ATOMIC_BIT'
--
-- -   If a 'Vulkan.Core10.Handles.ImageView' is sampled with
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FILTER_CUBIC_EXT' as a result
--     of this command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FORMAT_FEATURE_SAMPLED_IMAGE_FILTER_CUBIC_BIT_EXT'
--
-- -   Any 'Vulkan.Core10.Handles.ImageView' being sampled with
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FILTER_CUBIC_EXT' as a result
--     of this command /must/ have a
--     'Vulkan.Core10.Enums.ImageViewType.ImageViewType' and format that
--     supports cubic filtering, as specified by
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FilterCubicImageViewImageFormatPropertiesEXT'::@filterCubic@
--     returned by
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceImageFormatProperties2'
--
-- -   Any 'Vulkan.Core10.Handles.ImageView' being sampled with
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FILTER_CUBIC_EXT' with a
--     reduction mode of either
--     'Vulkan.Core12.Enums.SamplerReductionMode.SAMPLER_REDUCTION_MODE_MIN'
--     or
--     'Vulkan.Core12.Enums.SamplerReductionMode.SAMPLER_REDUCTION_MODE_MAX'
--     as a result of this command /must/ have a
--     'Vulkan.Core10.Enums.ImageViewType.ImageViewType' and format that
--     supports cubic filtering together with minmax filtering, as
--     specified by
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FilterCubicImageViewImageFormatPropertiesEXT'::@filterCubicMinmax@
--     returned by
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceImageFormatProperties2'
--
-- -   Any 'Vulkan.Core10.Handles.Image' created with a
--     'Vulkan.Core10.Image.ImageCreateInfo'::@flags@ containing
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_CORNER_SAMPLED_BIT_NV'
--     sampled as a result of this command /must/ only be sampled using a
--     'Vulkan.Core10.Enums.SamplerAddressMode.SamplerAddressMode' of
--     'Vulkan.Core10.Enums.SamplerAddressMode.SAMPLER_ADDRESS_MODE_CLAMP_TO_EDGE'
--
-- -   For each set /n/ that is statically used by the
--     'Vulkan.Core10.Handles.Pipeline' bound to the pipeline bind point
--     used by this command, a descriptor set /must/ have been bound to /n/
--     at the same pipeline bind point, with a
--     'Vulkan.Core10.Handles.PipelineLayout' that is compatible for set
--     /n/, with the 'Vulkan.Core10.Handles.PipelineLayout' used to create
--     the current 'Vulkan.Core10.Handles.Pipeline', as described in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#descriptorsets-compatibility ???>
--
-- -   For each push constant that is statically used by the
--     'Vulkan.Core10.Handles.Pipeline' bound to the pipeline bind point
--     used by this command, a push constant value /must/ have been set for
--     the same pipeline bind point, with a
--     'Vulkan.Core10.Handles.PipelineLayout' that is compatible for push
--     constants, with the 'Vulkan.Core10.Handles.PipelineLayout' used to
--     create the current 'Vulkan.Core10.Handles.Pipeline', as described in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#descriptorsets-compatibility ???>
--
-- -   Descriptors in each bound descriptor set, specified via
--     'Vulkan.Core10.CommandBufferBuilding.cmdBindDescriptorSets', /must/
--     be valid if they are statically used by the
--     'Vulkan.Core10.Handles.Pipeline' bound to the pipeline bind point
--     used by this command
--
-- -   A valid pipeline /must/ be bound to the pipeline bind point used by
--     this command
--
-- -   If the 'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline
--     bind point used by this command requires any dynamic state, that
--     state /must/ have been set for @commandBuffer@, and done so after
--     any previously bound pipeline with the corresponding state not
--     specified as dynamic
--
-- -   There /must/ not have been any calls to dynamic state setting
--     commands for any state not specified as dynamic in the
--     'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline bind
--     point used by this command, since that pipeline was bound
--
-- -   If the 'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline
--     bind point used by this command accesses a
--     'Vulkan.Core10.Handles.Sampler' object that uses unnormalized
--     coordinates, that sampler /must/ not be used to sample from any
--     'Vulkan.Core10.Handles.Image' with a
--     'Vulkan.Core10.Handles.ImageView' of the type
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_3D',
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE',
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_1D_ARRAY',
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D_ARRAY' or
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE_ARRAY', in
--     any shader stage
--
-- -   If the 'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline
--     bind point used by this command accesses a
--     'Vulkan.Core10.Handles.Sampler' object that uses unnormalized
--     coordinates, that sampler /must/ not be used with any of the SPIR-V
--     @OpImageSample*@ or @OpImageSparseSample*@ instructions with
--     @ImplicitLod@, @Dref@ or @Proj@ in their name, in any shader stage
--
-- -   If the 'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline
--     bind point used by this command accesses a
--     'Vulkan.Core10.Handles.Sampler' object that uses unnormalized
--     coordinates, that sampler /must/ not be used with any of the SPIR-V
--     @OpImageSample*@ or @OpImageSparseSample*@ instructions that
--     includes a LOD bias or any offset values, in any shader stage
--
-- -   If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-robustBufferAccess robust buffer access>
--     feature is not enabled, and if the 'Vulkan.Core10.Handles.Pipeline'
--     object bound to the pipeline bind point used by this command
--     accesses a uniform buffer, it /must/ not access values outside of
--     the range of the buffer as specified in the descriptor set bound to
--     the same pipeline bind point
--
-- -   If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-robustBufferAccess robust buffer access>
--     feature is not enabled, and if the 'Vulkan.Core10.Handles.Pipeline'
--     object bound to the pipeline bind point used by this command
--     accesses a storage buffer, it /must/ not access values outside of
--     the range of the buffer as specified in the descriptor set bound to
--     the same pipeline bind point
--
-- -   If @commandBuffer@ is an unprotected command buffer, any resource
--     accessed by the 'Vulkan.Core10.Handles.Pipeline' object bound to the
--     pipeline bind point used by this command /must/ not be a protected
--     resource
--
-- -   If a 'Vulkan.Core10.Handles.ImageView' is accessed using
--     @OpImageWrite@ as a result of this command, then the @Type@ of the
--     @Texel@ operand of that instruction /must/ have at least as many
--     components as the image view’s format.
--
-- -   If a 'Vulkan.Core10.Handles.BufferView' is accessed using
--     @OpImageWrite@ as a result of this command, then the @Type@ of the
--     @Texel@ operand of that instruction /must/ have at least as many
--     components as the image view’s format.
--
-- -   If a 'Vulkan.Core10.Handles.ImageView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a 64-bit channel width
--     is accessed as a result of this command, the @SampledType@ of the
--     @OpTypeImage@ operand of that instruction /must/ have a @Width@ of
--     64.
--
-- -   If a 'Vulkan.Core10.Handles.ImageView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a channel width less
--     than 64-bit is accessed as a result of this command, the
--     @SampledType@ of the @OpTypeImage@ operand of that instruction
--     /must/ have a @Width@ of 32.
--
-- -   If a 'Vulkan.Core10.Handles.BufferView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a 64-bit channel width
--     is accessed as a result of this command, the @SampledType@ of the
--     @OpTypeImage@ operand of that instruction /must/ have a @Width@ of
--     64.
--
-- -   If a 'Vulkan.Core10.Handles.BufferView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a channel width less
--     than 64-bit is accessed as a result of this command, the
--     @SampledType@ of the @OpTypeImage@ operand of that instruction
--     /must/ have a @Width@ of 32.
--
-- -   If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-sparseImageInt64Atomics sparseImageInt64Atomics>
--     feature is not enabled, 'Vulkan.Core10.Handles.Image' objects
--     created with the
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SPARSE_RESIDENCY_BIT'
--     flag /must/ not be accessed by atomic instructions through an
--     @OpTypeImage@ with a @SampledType@ with a @Width@ of 64 by this
--     command.
--
-- -   If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-sparseImageInt64Atomics sparseImageInt64Atomics>
--     feature is not enabled, 'Vulkan.Core10.Handles.Buffer' objects
--     created with the
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_SPARSE_RESIDENCY_BIT'
--     flag /must/ not be accessed by atomic instructions through an
--     @OpTypeImage@ with a @SampledType@ with a @Width@ of 64 by this
--     command.
--
-- -   Any shader group handle referenced by this call /must/ have been
--     queried from the currently bound ray tracing shader pipeline
--
-- -   This command /must/ not cause a shader call instruction to be
--     executed from a shader invocation with a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#ray-tracing-recursion-depth recursion depth>
--     greater than the value of @maxRecursionDepth@ used to create the
--     bound ray tracing pipeline
--
-- -   If @pRayGenShaderBindingTable->buffer@ is non-sparse then it /must/
--     be bound completely and contiguously to a single
--     'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   The @offset@ member of @pRayGenShaderBindingTable@ /must/ be less
--     than the size of the @pRayGenShaderBindingTable->buffer@
--
-- -   @pRayGenShaderBindingTable->offset@ /must/ be a multiple of
--     'PhysicalDeviceRayTracingPropertiesKHR'::@shaderGroupBaseAlignment@
--
-- -   @pRayGenShaderBindingTable->offset@ +
--     @pRayGenShaderBindingTable->size@ /must/ be less than or equal to
--     the size of @pRayGenShaderBindingTable->buffer@
--
-- -   The @size@ member of @pRayGenShaderBindingTable@ /must/ be equal to
--     its @stride@ member
--
-- -   If @pMissShaderBindingTable->buffer@ is non-sparse then it /must/ be
--     bound completely and contiguously to a single
--     'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   The @offset@ member of @pMissShaderBindingTable@ /must/ be less than
--     the size of @pMissShaderBindingTable->buffer@
--
-- -   The @offset@ member of @pMissShaderBindingTable@ /must/ be a
--     multiple of
--     'PhysicalDeviceRayTracingPropertiesKHR'::@shaderGroupBaseAlignment@
--
-- -   @pMissShaderBindingTable->offset@ + @pMissShaderBindingTable->size@
--     /must/ be less than or equal to the size of
--     @pMissShaderBindingTable->buffer@
--
-- -   The @stride@ member of @pMissShaderBindingTable@ /must/ be a
--     multiple of
--     'PhysicalDeviceRayTracingPropertiesKHR'::@shaderGroupHandleSize@
--
-- -   The @stride@ member of @pMissShaderBindingTable@ /must/ be less than
--     or equal to
--     'PhysicalDeviceRayTracingPropertiesKHR'::@maxShaderGroupStride@
--
-- -   If @pHitShaderBindingTable->buffer@ is non-sparse then it /must/ be
--     bound completely and contiguously to a single
--     'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   The @offset@ member of @pHitShaderBindingTable@ /must/ be less than
--     the size of @pHitShaderBindingTable->buffer@
--
-- -   The @offset@ member of @pHitShaderBindingTable@ /must/ be a multiple
--     of
--     'PhysicalDeviceRayTracingPropertiesKHR'::@shaderGroupBaseAlignment@
--
-- -   @pHitShaderBindingTable->offset@ + @pHitShaderBindingTable->size@
--     /must/ be less than or equal to the size of
--     @pHitShaderBindingTable->buffer@
--
-- -   The @stride@ member of @pHitShaderBindingTable@ /must/ be a multiple
--     of 'PhysicalDeviceRayTracingPropertiesKHR'::@shaderGroupHandleSize@
--
-- -   The @stride@ member of @pHitShaderBindingTable@ /must/ be less than
--     or equal to
--     'PhysicalDeviceRayTracingPropertiesKHR'::@maxShaderGroupStride@
--
-- -   If @pCallableShaderBindingTable->buffer@ is non-sparse then it
--     /must/ be bound completely and contiguously to a single
--     'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   The @offset@ member of @pCallableShaderBindingTable@ /must/ be less
--     than the size of @pCallableShaderBindingTable->buffer@
--
-- -   The @offset@ member of @pCallableShaderBindingTable@ /must/ be a
--     multiple of
--     'PhysicalDeviceRayTracingPropertiesKHR'::@shaderGroupBaseAlignment@
--
-- -   @pCallableShaderBindingTable->offset@ +
--     @pCallableShaderBindingTable->size@ /must/ be less than or equal to
--     the size of @pCallableShaderBindingTable->buffer@
--
-- -   The @stride@ member of @pCallableShaderBindingTable@ /must/ be a
--     multiple of
--     'PhysicalDeviceRayTracingPropertiesKHR'::@shaderGroupHandleSize@
--
-- -   The @stride@ member of @pCallableShaderBindingTable@ /must/ be less
--     than or equal to
--     'PhysicalDeviceRayTracingPropertiesKHR'::@maxShaderGroupStride@
--
-- -   If the currently bound ray tracing pipeline was created with @flags@
--     that included
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RAY_TRACING_NO_NULL_ANY_HIT_SHADERS_BIT_KHR',
--     the @buffer@ member of @pHitShaderBindingTable@ /must/ not be
--     'Vulkan.Core10.APIConstants.NULL_HANDLE'
--
-- -   If the currently bound ray tracing pipeline was created with @flags@
--     that included
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RAY_TRACING_NO_NULL_CLOSEST_HIT_SHADERS_BIT_KHR',
--     the @buffer@ member of @pHitShaderBindingTable@ /must/ not be
--     'Vulkan.Core10.APIConstants.NULL_HANDLE'
--
-- -   If the currently bound ray tracing pipeline was created with @flags@
--     that included
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RAY_TRACING_NO_NULL_INTERSECTION_SHADERS_BIT_KHR',
--     the @buffer@ member of @pHitShaderBindingTable@ /must/ not be
--     'Vulkan.Core10.APIConstants.NULL_HANDLE'
--
-- -   If the currently bound ray tracing pipeline was created with @flags@
--     that included
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RAY_TRACING_NO_NULL_MISS_SHADERS_BIT_KHR',
--     the shader group handle identified by @pMissShaderBindingTable@
--     /must/ contain a valid miss shader
--
-- -   If the currently bound ray tracing pipeline was created with @flags@
--     that included
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RAY_TRACING_NO_NULL_ANY_HIT_SHADERS_BIT_KHR',
--     entries in @pHitShaderBindingTable@ accessed as a result of this
--     command in order to execute an any hit shader /must/ not be set to
--     zero
--
-- -   If the currently bound ray tracing pipeline was created with @flags@
--     that included
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RAY_TRACING_NO_NULL_CLOSEST_HIT_SHADERS_BIT_KHR',
--     entries in @pHitShaderBindingTable@ accessed as a result of this
--     command in order to execute a closest hit shader /must/ not be set
--     to zero
--
-- -   If the currently bound ray tracing pipeline was created with @flags@
--     that included
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RAY_TRACING_NO_NULL_INTERSECTION_SHADERS_BIT_KHR',
--     entries in @pHitShaderBindingTable@ accessed as a result of this
--     command in order to execute an intersection shader /must/ not be set
--     to zero
--
-- -   If @commandBuffer@ is a protected command buffer, any resource
--     written to by the 'Vulkan.Core10.Handles.Pipeline' object bound to
--     the pipeline bind point used by this command /must/ not be an
--     unprotected resource
--
-- -   If @commandBuffer@ is a protected command buffer, pipeline stages
--     other than the framebuffer-space and compute stages in the
--     'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline bind
--     point /must/ not write to any resource
--
-- -   @width@ /must/ be less than or equal to
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxComputeWorkGroupCount@[0]
--
-- -   @height@ /must/ be less than or equal to
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxComputeWorkGroupCount@[1]
--
-- -   @depth@ /must/ be less than or equal to
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxComputeWorkGroupCount@[2]
--
-- == Valid Usage (Implicit)
--
-- -   @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   @pRaygenShaderBindingTable@ /must/ be a valid pointer to a valid
--     'StridedBufferRegionKHR' structure
--
-- -   @pMissShaderBindingTable@ /must/ be a valid pointer to a valid
--     'StridedBufferRegionKHR' structure
--
-- -   @pHitShaderBindingTable@ /must/ be a valid pointer to a valid
--     'StridedBufferRegionKHR' structure
--
-- -   @pCallableShaderBindingTable@ /must/ be a valid pointer to a valid
--     'StridedBufferRegionKHR' structure
--
-- -   @commandBuffer@ /must/ be in the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#commandbuffers-lifecycle recording state>
--
-- -   The 'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support compute operations
--
-- -   This command /must/ only be called outside of a render pass instance
--
-- == 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> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-pipeline-stages-types Pipeline Type> |
-- +============================================================================================================================+========================================================================================================================+=======================================================================================================================+=====================================================================================================================================+
-- | Primary                                                                                                                    | Outside                                                                                                                | Compute                                                                                                               |                                                                                                                                     |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                       |                                                                                                                                     |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+-------------------------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- 'Vulkan.Core10.Handles.CommandBuffer', 'StridedBufferRegionKHR'
cmdTraceRaysKHR :: forall io
                 . (MonadIO io)
                => -- | @commandBuffer@ is the command buffer into which the command will be
                   -- recorded.
                   CommandBuffer
                -> -- | @pRaygenShaderBindingTable@ is a 'StridedBufferRegionKHR' that holds the
                   -- shader binding table data for the ray generation shader stage.
                   ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
                -> -- | @pMissShaderBindingTable@ is a 'StridedBufferRegionKHR' that holds the
                   -- shader binding table data for the miss shader stage.
                   ("missShaderBindingTable" ::: StridedBufferRegionKHR)
                -> -- | @pHitShaderBindingTable@ is a 'StridedBufferRegionKHR' that holds the
                   -- shader binding table data for the hit shader stage.
                   ("hitShaderBindingTable" ::: StridedBufferRegionKHR)
                -> -- | @pCallableShaderBindingTable@ is a 'StridedBufferRegionKHR' that holds
                   -- the shader binding table data for the callable shader stage.
                   ("callableShaderBindingTable" ::: StridedBufferRegionKHR)
                -> -- | @width@ is the width of the ray trace query dimensions.
                   ("width" ::: Word32)
                -> -- | @height@ is height of the ray trace query dimensions.
                   ("height" ::: Word32)
                -> -- | @depth@ is depth of the ray trace query dimensions.
                   ("depth" ::: Word32)
                -> io ()
cmdTraceRaysKHR :: CommandBuffer
-> ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
-> ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
-> ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
-> ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
-> ("bindInfoCount" ::: Word32)
-> ("bindInfoCount" ::: Word32)
-> ("bindInfoCount" ::: Word32)
-> io ()
cmdTraceRaysKHR commandBuffer :: CommandBuffer
commandBuffer raygenShaderBindingTable :: "raygenShaderBindingTable" ::: StridedBufferRegionKHR
raygenShaderBindingTable missShaderBindingTable :: "raygenShaderBindingTable" ::: StridedBufferRegionKHR
missShaderBindingTable hitShaderBindingTable :: "raygenShaderBindingTable" ::: StridedBufferRegionKHR
hitShaderBindingTable callableShaderBindingTable :: "raygenShaderBindingTable" ::: StridedBufferRegionKHR
callableShaderBindingTable width :: "bindInfoCount" ::: Word32
width height :: "bindInfoCount" ::: Word32
height depth :: "bindInfoCount" ::: Word32
depth = 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 vkCmdTraceRaysKHRPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("bindInfoCount" ::: Word32)
   -> ("bindInfoCount" ::: Word32)
   -> ("bindInfoCount" ::: Word32)
   -> IO ())
vkCmdTraceRaysKHRPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pRaygenShaderBindingTable"
          ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
      -> ("pRaygenShaderBindingTable"
          ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
      -> ("pRaygenShaderBindingTable"
          ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
      -> ("pRaygenShaderBindingTable"
          ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
      -> ("bindInfoCount" ::: Word32)
      -> ("bindInfoCount" ::: Word32)
      -> ("bindInfoCount" ::: Word32)
      -> IO ())
pVkCmdTraceRaysKHR (CommandBuffer -> DeviceCmds
deviceCmds (CommandBuffer
commandBuffer :: CommandBuffer))
  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
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("bindInfoCount" ::: Word32)
   -> ("bindInfoCount" ::: Word32)
   -> ("bindInfoCount" ::: Word32)
   -> IO ())
vkCmdTraceRaysKHRPtr FunPtr
  (Ptr CommandBuffer_T
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("bindInfoCount" ::: Word32)
   -> ("bindInfoCount" ::: Word32)
   -> ("bindInfoCount" ::: Word32)
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pRaygenShaderBindingTable"
          ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
      -> ("pRaygenShaderBindingTable"
          ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
      -> ("pRaygenShaderBindingTable"
          ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
      -> ("pRaygenShaderBindingTable"
          ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
      -> ("bindInfoCount" ::: Word32)
      -> ("bindInfoCount" ::: Word32)
      -> ("bindInfoCount" ::: Word32)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("bindInfoCount" ::: Word32)
   -> ("bindInfoCount" ::: Word32)
   -> ("bindInfoCount" ::: Word32)
   -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkCmdTraceRaysKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdTraceRaysKHR' :: Ptr CommandBuffer_T
-> ("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
-> ("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
-> ("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
-> ("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
-> ("bindInfoCount" ::: Word32)
-> ("bindInfoCount" ::: Word32)
-> ("bindInfoCount" ::: Word32)
-> IO ()
vkCmdTraceRaysKHR' = FunPtr
  (Ptr CommandBuffer_T
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("bindInfoCount" ::: Word32)
   -> ("bindInfoCount" ::: Word32)
   -> ("bindInfoCount" ::: Word32)
   -> IO ())
-> Ptr CommandBuffer_T
-> ("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
-> ("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
-> ("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
-> ("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
-> ("bindInfoCount" ::: Word32)
-> ("bindInfoCount" ::: Word32)
-> ("bindInfoCount" ::: Word32)
-> IO ()
mkVkCmdTraceRaysKHR FunPtr
  (Ptr CommandBuffer_T
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("bindInfoCount" ::: Word32)
   -> ("bindInfoCount" ::: Word32)
   -> ("bindInfoCount" ::: Word32)
   -> IO ())
vkCmdTraceRaysKHRPtr
  "pRaygenShaderBindingTable"
::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
pRaygenShaderBindingTable <- ((("pRaygenShaderBindingTable"
   ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
  -> IO ())
 -> IO ())
-> ContT
     ()
     IO
     ("pRaygenShaderBindingTable"
      ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> IO ())
  -> IO ())
 -> ContT
      ()
      IO
      ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)))
-> ((("pRaygenShaderBindingTable"
      ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
     -> IO ())
    -> IO ())
-> ContT
     ()
     IO
     ("pRaygenShaderBindingTable"
      ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
forall a b. (a -> b) -> a -> b
$ ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
-> (("pRaygenShaderBindingTable"
     ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
    -> IO ())
-> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct ("raygenShaderBindingTable" ::: StridedBufferRegionKHR
raygenShaderBindingTable)
  "pRaygenShaderBindingTable"
::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
pMissShaderBindingTable <- ((("pRaygenShaderBindingTable"
   ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
  -> IO ())
 -> IO ())
-> ContT
     ()
     IO
     ("pRaygenShaderBindingTable"
      ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> IO ())
  -> IO ())
 -> ContT
      ()
      IO
      ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)))
-> ((("pRaygenShaderBindingTable"
      ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
     -> IO ())
    -> IO ())
-> ContT
     ()
     IO
     ("pRaygenShaderBindingTable"
      ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
forall a b. (a -> b) -> a -> b
$ ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
-> (("pRaygenShaderBindingTable"
     ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
    -> IO ())
-> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct ("raygenShaderBindingTable" ::: StridedBufferRegionKHR
missShaderBindingTable)
  "pRaygenShaderBindingTable"
::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
pHitShaderBindingTable <- ((("pRaygenShaderBindingTable"
   ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
  -> IO ())
 -> IO ())
-> ContT
     ()
     IO
     ("pRaygenShaderBindingTable"
      ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> IO ())
  -> IO ())
 -> ContT
      ()
      IO
      ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)))
-> ((("pRaygenShaderBindingTable"
      ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
     -> IO ())
    -> IO ())
-> ContT
     ()
     IO
     ("pRaygenShaderBindingTable"
      ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
forall a b. (a -> b) -> a -> b
$ ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
-> (("pRaygenShaderBindingTable"
     ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
    -> IO ())
-> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct ("raygenShaderBindingTable" ::: StridedBufferRegionKHR
hitShaderBindingTable)
  "pRaygenShaderBindingTable"
::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
pCallableShaderBindingTable <- ((("pRaygenShaderBindingTable"
   ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
  -> IO ())
 -> IO ())
-> ContT
     ()
     IO
     ("pRaygenShaderBindingTable"
      ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> IO ())
  -> IO ())
 -> ContT
      ()
      IO
      ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)))
-> ((("pRaygenShaderBindingTable"
      ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
     -> IO ())
    -> IO ())
-> ContT
     ()
     IO
     ("pRaygenShaderBindingTable"
      ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
forall a b. (a -> b) -> a -> b
$ ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
-> (("pRaygenShaderBindingTable"
     ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
    -> IO ())
-> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct ("raygenShaderBindingTable" ::: StridedBufferRegionKHR
callableShaderBindingTable)
  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
$ Ptr CommandBuffer_T
-> ("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
-> ("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
-> ("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
-> ("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
-> ("bindInfoCount" ::: Word32)
-> ("bindInfoCount" ::: Word32)
-> ("bindInfoCount" ::: Word32)
-> IO ()
vkCmdTraceRaysKHR' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) "pRaygenShaderBindingTable"
::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
pRaygenShaderBindingTable "pRaygenShaderBindingTable"
::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
pMissShaderBindingTable "pRaygenShaderBindingTable"
::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
pHitShaderBindingTable "pRaygenShaderBindingTable"
::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
pCallableShaderBindingTable ("bindInfoCount" ::: Word32
width) ("bindInfoCount" ::: Word32
height) ("bindInfoCount" ::: Word32
depth)
  () -> 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" mkVkGetRayTracingShaderGroupHandlesKHR
  :: FunPtr (Ptr Device_T -> Pipeline -> Word32 -> Word32 -> CSize -> Ptr () -> IO Result) -> Ptr Device_T -> Pipeline -> Word32 -> Word32 -> CSize -> Ptr () -> IO Result

-- | vkGetRayTracingShaderGroupHandlesKHR - Query ray tracing pipeline shader
-- group handles
--
-- == Valid Usage
--
-- -   @firstGroup@ /must/ be less than the number of shader groups in
--     @pipeline@
--
-- -   The sum of @firstGroup@ and @groupCount@ /must/ be less than or
--     equal to the number of shader groups in @pipeline@
--
-- -   @dataSize@ /must/ be at least
--     'PhysicalDeviceRayTracingPropertiesKHR'::@shaderGroupHandleSize@ ×
--     @groupCount@
--
-- -   @pipeline@ /must/ have not been created with
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_LIBRARY_BIT_KHR'
--
-- == Valid Usage (Implicit)
--
-- -   @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   @pipeline@ /must/ be a valid 'Vulkan.Core10.Handles.Pipeline' handle
--
-- -   @pData@ /must/ be a valid pointer to an array of @dataSize@ bytes
--
-- -   @dataSize@ /must/ be greater than @0@
--
-- -   @pipeline@ /must/ have been created, allocated, or retrieved from
--     @device@
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
-- = See Also
--
-- 'Vulkan.Core10.Handles.Device', 'Vulkan.Core10.Handles.Pipeline'
getRayTracingShaderGroupHandlesKHR :: forall io
                                    . (MonadIO io)
                                   => -- | @device@ is the logical device containing the ray tracing pipeline.
                                      Device
                                   -> -- | @pipeline@ is the ray tracing pipeline object containing the shaders.
                                      Pipeline
                                   -> -- | @firstGroup@ is the index of the first group to retrieve a handle for
                                      -- from the 'RayTracingPipelineCreateInfoKHR'::@pGroups@ or
                                      -- 'Vulkan.Extensions.VK_NV_ray_tracing.RayTracingPipelineCreateInfoNV'::@pGroups@
                                      -- array.
                                      ("firstGroup" ::: Word32)
                                   -> -- | @groupCount@ is the number of shader handles to retrieve.
                                      ("groupCount" ::: Word32)
                                   -> -- | @dataSize@ is the size in bytes of the buffer pointed to by @pData@.
                                      ("dataSize" ::: Word64)
                                   -> -- | @pData@ is a pointer to a user-allocated buffer where the results will
                                      -- be written.
                                      ("data" ::: Ptr ())
                                   -> io ()
getRayTracingShaderGroupHandlesKHR :: Device
-> Pipeline
-> ("bindInfoCount" ::: Word32)
-> ("bindInfoCount" ::: Word32)
-> ("dataSize" ::: Word64)
-> ("data" ::: Ptr ())
-> io ()
getRayTracingShaderGroupHandlesKHR device :: Device
device pipeline :: Pipeline
pipeline firstGroup :: "bindInfoCount" ::: Word32
firstGroup groupCount :: "bindInfoCount" ::: Word32
groupCount dataSize :: "dataSize" ::: Word64
dataSize data' :: "data" ::: Ptr ()
data' = 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 vkGetRayTracingShaderGroupHandlesKHRPtr :: FunPtr
  (Ptr Device_T
   -> Pipeline
   -> ("bindInfoCount" ::: Word32)
   -> ("bindInfoCount" ::: Word32)
   -> ("dataSize" ::: CSize)
   -> ("data" ::: Ptr ())
   -> IO Result)
vkGetRayTracingShaderGroupHandlesKHRPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> Pipeline
      -> ("bindInfoCount" ::: Word32)
      -> ("bindInfoCount" ::: Word32)
      -> ("dataSize" ::: CSize)
      -> ("data" ::: Ptr ())
      -> IO Result)
pVkGetRayTracingShaderGroupHandlesKHR (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> Pipeline
   -> ("bindInfoCount" ::: Word32)
   -> ("bindInfoCount" ::: Word32)
   -> ("dataSize" ::: CSize)
   -> ("data" ::: Ptr ())
   -> IO Result)
vkGetRayTracingShaderGroupHandlesKHRPtr FunPtr
  (Ptr Device_T
   -> Pipeline
   -> ("bindInfoCount" ::: Word32)
   -> ("bindInfoCount" ::: Word32)
   -> ("dataSize" ::: CSize)
   -> ("data" ::: Ptr ())
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> Pipeline
      -> ("bindInfoCount" ::: Word32)
      -> ("bindInfoCount" ::: Word32)
      -> ("dataSize" ::: CSize)
      -> ("data" ::: Ptr ())
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> Pipeline
   -> ("bindInfoCount" ::: Word32)
   -> ("bindInfoCount" ::: Word32)
   -> ("dataSize" ::: CSize)
   -> ("data" ::: Ptr ())
   -> IO Result)
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 "" "The function pointer for vkGetRayTracingShaderGroupHandlesKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetRayTracingShaderGroupHandlesKHR' :: Ptr Device_T
-> Pipeline
-> ("bindInfoCount" ::: Word32)
-> ("bindInfoCount" ::: Word32)
-> ("dataSize" ::: CSize)
-> ("data" ::: Ptr ())
-> IO Result
vkGetRayTracingShaderGroupHandlesKHR' = FunPtr
  (Ptr Device_T
   -> Pipeline
   -> ("bindInfoCount" ::: Word32)
   -> ("bindInfoCount" ::: Word32)
   -> ("dataSize" ::: CSize)
   -> ("data" ::: Ptr ())
   -> IO Result)
-> Ptr Device_T
-> Pipeline
-> ("bindInfoCount" ::: Word32)
-> ("bindInfoCount" ::: Word32)
-> ("dataSize" ::: CSize)
-> ("data" ::: Ptr ())
-> IO Result
mkVkGetRayTracingShaderGroupHandlesKHR FunPtr
  (Ptr Device_T
   -> Pipeline
   -> ("bindInfoCount" ::: Word32)
   -> ("bindInfoCount" ::: Word32)
   -> ("dataSize" ::: CSize)
   -> ("data" ::: Ptr ())
   -> IO Result)
vkGetRayTracingShaderGroupHandlesKHRPtr
  Result
r <- Ptr Device_T
-> Pipeline
-> ("bindInfoCount" ::: Word32)
-> ("bindInfoCount" ::: Word32)
-> ("dataSize" ::: CSize)
-> ("data" ::: Ptr ())
-> IO Result
vkGetRayTracingShaderGroupHandlesKHR' (Device -> Ptr Device_T
deviceHandle (Device
device)) (Pipeline
pipeline) ("bindInfoCount" ::: Word32
firstGroup) ("bindInfoCount" ::: Word32
groupCount) (("dataSize" ::: Word64) -> "dataSize" ::: CSize
CSize ("dataSize" ::: Word64
dataSize)) ("data" ::: Ptr ()
data')
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetRayTracingCaptureReplayShaderGroupHandlesKHR
  :: FunPtr (Ptr Device_T -> Pipeline -> Word32 -> Word32 -> CSize -> Ptr () -> IO Result) -> Ptr Device_T -> Pipeline -> Word32 -> Word32 -> CSize -> Ptr () -> IO Result

-- | vkGetRayTracingCaptureReplayShaderGroupHandlesKHR - Query ray tracing
-- capture replay pipeline shader group handles
--
-- == Valid Usage
--
-- -   @firstGroup@ /must/ be less than the number of shader groups in
--     @pipeline@
--
-- -   The sum of @firstGroup@ and @groupCount@ /must/ be less than or
--     equal to the number of shader groups in @pipeline@
--
-- -   @dataSize@ /must/ be at least
--     'PhysicalDeviceRayTracingPropertiesKHR'::@shaderGroupHandleCaptureReplaySize@
--     × @groupCount@
--
-- -   'PhysicalDeviceRayTracingFeaturesKHR'::@rayTracingShaderGroupHandleCaptureReplay@
--     /must/ be enabled to call this function
--
-- == Valid Usage (Implicit)
--
-- -   @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   @pipeline@ /must/ be a valid 'Vulkan.Core10.Handles.Pipeline' handle
--
-- -   @pData@ /must/ be a valid pointer to an array of @dataSize@ bytes
--
-- -   @dataSize@ /must/ be greater than @0@
--
-- -   @pipeline@ /must/ have been created, allocated, or retrieved from
--     @device@
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
-- = See Also
--
-- 'Vulkan.Core10.Handles.Device', 'Vulkan.Core10.Handles.Pipeline'
getRayTracingCaptureReplayShaderGroupHandlesKHR :: forall io
                                                 . (MonadIO io)
                                                => -- | @device@ is the logical device containing the ray tracing pipeline.
                                                   Device
                                                -> -- | @pipeline@ is the ray tracing pipeline object containing the shaders.
                                                   Pipeline
                                                -> -- | @firstGroup@ is the index of the first group to retrieve a handle for
                                                   -- from the 'RayTracingPipelineCreateInfoKHR'::@pGroups@ array.
                                                   ("firstGroup" ::: Word32)
                                                -> -- | @groupCount@ is the number of shader handles to retrieve.
                                                   ("groupCount" ::: Word32)
                                                -> -- | @dataSize@ is the size in bytes of the buffer pointed to by @pData@.
                                                   ("dataSize" ::: Word64)
                                                -> -- | @pData@ is a pointer to a user-allocated buffer where the results will
                                                   -- be written.
                                                   ("data" ::: Ptr ())
                                                -> io ()
getRayTracingCaptureReplayShaderGroupHandlesKHR :: Device
-> Pipeline
-> ("bindInfoCount" ::: Word32)
-> ("bindInfoCount" ::: Word32)
-> ("dataSize" ::: Word64)
-> ("data" ::: Ptr ())
-> io ()
getRayTracingCaptureReplayShaderGroupHandlesKHR device :: Device
device pipeline :: Pipeline
pipeline firstGroup :: "bindInfoCount" ::: Word32
firstGroup groupCount :: "bindInfoCount" ::: Word32
groupCount dataSize :: "dataSize" ::: Word64
dataSize data' :: "data" ::: Ptr ()
data' = 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 vkGetRayTracingCaptureReplayShaderGroupHandlesKHRPtr :: FunPtr
  (Ptr Device_T
   -> Pipeline
   -> ("bindInfoCount" ::: Word32)
   -> ("bindInfoCount" ::: Word32)
   -> ("dataSize" ::: CSize)
   -> ("data" ::: Ptr ())
   -> IO Result)
vkGetRayTracingCaptureReplayShaderGroupHandlesKHRPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> Pipeline
      -> ("bindInfoCount" ::: Word32)
      -> ("bindInfoCount" ::: Word32)
      -> ("dataSize" ::: CSize)
      -> ("data" ::: Ptr ())
      -> IO Result)
pVkGetRayTracingCaptureReplayShaderGroupHandlesKHR (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> Pipeline
   -> ("bindInfoCount" ::: Word32)
   -> ("bindInfoCount" ::: Word32)
   -> ("dataSize" ::: CSize)
   -> ("data" ::: Ptr ())
   -> IO Result)
vkGetRayTracingCaptureReplayShaderGroupHandlesKHRPtr FunPtr
  (Ptr Device_T
   -> Pipeline
   -> ("bindInfoCount" ::: Word32)
   -> ("bindInfoCount" ::: Word32)
   -> ("dataSize" ::: CSize)
   -> ("data" ::: Ptr ())
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> Pipeline
      -> ("bindInfoCount" ::: Word32)
      -> ("bindInfoCount" ::: Word32)
      -> ("dataSize" ::: CSize)
      -> ("data" ::: Ptr ())
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> Pipeline
   -> ("bindInfoCount" ::: Word32)
   -> ("bindInfoCount" ::: Word32)
   -> ("dataSize" ::: CSize)
   -> ("data" ::: Ptr ())
   -> IO Result)
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 "" "The function pointer for vkGetRayTracingCaptureReplayShaderGroupHandlesKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetRayTracingCaptureReplayShaderGroupHandlesKHR' :: Ptr Device_T
-> Pipeline
-> ("bindInfoCount" ::: Word32)
-> ("bindInfoCount" ::: Word32)
-> ("dataSize" ::: CSize)
-> ("data" ::: Ptr ())
-> IO Result
vkGetRayTracingCaptureReplayShaderGroupHandlesKHR' = FunPtr
  (Ptr Device_T
   -> Pipeline
   -> ("bindInfoCount" ::: Word32)
   -> ("bindInfoCount" ::: Word32)
   -> ("dataSize" ::: CSize)
   -> ("data" ::: Ptr ())
   -> IO Result)
-> Ptr Device_T
-> Pipeline
-> ("bindInfoCount" ::: Word32)
-> ("bindInfoCount" ::: Word32)
-> ("dataSize" ::: CSize)
-> ("data" ::: Ptr ())
-> IO Result
mkVkGetRayTracingCaptureReplayShaderGroupHandlesKHR FunPtr
  (Ptr Device_T
   -> Pipeline
   -> ("bindInfoCount" ::: Word32)
   -> ("bindInfoCount" ::: Word32)
   -> ("dataSize" ::: CSize)
   -> ("data" ::: Ptr ())
   -> IO Result)
vkGetRayTracingCaptureReplayShaderGroupHandlesKHRPtr
  Result
r <- Ptr Device_T
-> Pipeline
-> ("bindInfoCount" ::: Word32)
-> ("bindInfoCount" ::: Word32)
-> ("dataSize" ::: CSize)
-> ("data" ::: Ptr ())
-> IO Result
vkGetRayTracingCaptureReplayShaderGroupHandlesKHR' (Device -> Ptr Device_T
deviceHandle (Device
device)) (Pipeline
pipeline) ("bindInfoCount" ::: Word32
firstGroup) ("bindInfoCount" ::: Word32
groupCount) (("dataSize" ::: Word64) -> "dataSize" ::: CSize
CSize ("dataSize" ::: Word64
dataSize)) ("data" ::: Ptr ()
data')
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCreateRayTracingPipelinesKHR
  :: FunPtr (Ptr Device_T -> PipelineCache -> Word32 -> Ptr (SomeStruct RayTracingPipelineCreateInfoKHR) -> Ptr AllocationCallbacks -> Ptr Pipeline -> IO Result) -> Ptr Device_T -> PipelineCache -> Word32 -> Ptr (SomeStruct RayTracingPipelineCreateInfoKHR) -> Ptr AllocationCallbacks -> Ptr Pipeline -> IO Result

-- | vkCreateRayTracingPipelinesKHR - Creates a new ray tracing pipeline
-- object
--
-- = Description
--
-- The 'Vulkan.Core10.Enums.Result.ERROR_INVALID_OPAQUE_CAPTURE_ADDRESS'
-- error is returned if the implementation is unable to re-use the shader
-- group handles provided in
-- 'RayTracingShaderGroupCreateInfoKHR'::@pShaderGroupCaptureReplayHandle@
-- when
-- 'PhysicalDeviceRayTracingFeaturesKHR'::@rayTracingShaderGroupHandleCaptureReplay@
-- is enabled.
--
-- == Valid Usage
--
-- -   If the @flags@ member of any element of @pCreateInfos@ contains the
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_DERIVATIVE_BIT'
--     flag, and the @basePipelineIndex@ member of that same element is not
--     @-1@, @basePipelineIndex@ /must/ be less than the index into
--     @pCreateInfos@ that corresponds to that element
--
-- -   If the @flags@ member of any element of @pCreateInfos@ contains the
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_DERIVATIVE_BIT'
--     flag, the base pipeline /must/ have been created with the
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_ALLOW_DERIVATIVES_BIT'
--     flag set
--
-- -   If @pipelineCache@ was created with
--     'Vulkan.Core10.Enums.PipelineCacheCreateFlagBits.PIPELINE_CACHE_CREATE_EXTERNALLY_SYNCHRONIZED_BIT_EXT',
--     host access to @pipelineCache@ /must/ be
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-threadingbehavior externally synchronized>
--
-- -   The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-raytracing rayTracing>
--     feature /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   If @pipelineCache@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @pipelineCache@ /must/ be a valid
--     'Vulkan.Core10.Handles.PipelineCache' handle
--
-- -   @pCreateInfos@ /must/ be a valid pointer to an array of
--     @createInfoCount@ valid 'RayTracingPipelineCreateInfoKHR' structures
--
-- -   If @pAllocator@ is not @NULL@, @pAllocator@ /must/ be a valid
--     pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   @pPipelines@ /must/ be a valid pointer to an array of
--     @createInfoCount@ 'Vulkan.Core10.Handles.Pipeline' handles
--
-- -   @createInfoCount@ /must/ be greater than @0@
--
-- -   If @pipelineCache@ is a valid handle, it /must/ have been created,
--     allocated, or retrieved from @device@
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
--     -   'Vulkan.Core10.Enums.Result.OPERATION_DEFERRED_KHR'
--
--     -   'Vulkan.Core10.Enums.Result.OPERATION_NOT_DEFERRED_KHR'
--
--     -   'Vulkan.Core10.Enums.Result.PIPELINE_COMPILE_REQUIRED_EXT'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_INVALID_OPAQUE_CAPTURE_ADDRESS'
--
-- = See Also
--
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Device', 'Vulkan.Core10.Handles.Pipeline',
-- 'Vulkan.Core10.Handles.PipelineCache', 'RayTracingPipelineCreateInfoKHR'
createRayTracingPipelinesKHR :: forall io
                              . (MonadIO io)
                             => -- | @device@ is the logical device that creates the ray tracing pipelines.
                                Device
                             -> -- | @pipelineCache@ is either 'Vulkan.Core10.APIConstants.NULL_HANDLE',
                                -- indicating that pipeline caching is disabled, or the handle of a valid
                                -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#pipelines-cache pipeline cache>
                                -- object, in which case use of that cache is enabled for the duration of
                                -- the command.
                                PipelineCache
                             -> -- | @pCreateInfos@ is a pointer to an array of
                                -- 'RayTracingPipelineCreateInfoKHR' structures.
                                ("createInfos" ::: Vector (SomeStruct RayTracingPipelineCreateInfoKHR))
                             -> -- | @pAllocator@ controls host memory allocation as described in the
                                -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                                -- chapter.
                                ("allocator" ::: Maybe AllocationCallbacks)
                             -> io (Result, ("pipelines" ::: Vector Pipeline))
createRayTracingPipelinesKHR :: Device
-> PipelineCache
-> ("createInfos"
    ::: Vector (SomeStruct RayTracingPipelineCreateInfoKHR))
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io (Result, "pipelines" ::: Vector Pipeline)
createRayTracingPipelinesKHR device :: Device
device pipelineCache :: PipelineCache
pipelineCache createInfos :: "createInfos"
::: Vector (SomeStruct RayTracingPipelineCreateInfoKHR)
createInfos allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO (Result, "pipelines" ::: Vector Pipeline)
-> io (Result, "pipelines" ::: Vector Pipeline)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, "pipelines" ::: Vector Pipeline)
 -> io (Result, "pipelines" ::: Vector Pipeline))
-> (ContT
      (Result, "pipelines" ::: Vector Pipeline)
      IO
      (Result, "pipelines" ::: Vector Pipeline)
    -> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
     (Result, "pipelines" ::: Vector Pipeline)
     IO
     (Result, "pipelines" ::: Vector Pipeline)
-> io (Result, "pipelines" ::: Vector Pipeline)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  (Result, "pipelines" ::: Vector Pipeline)
  IO
  (Result, "pipelines" ::: Vector Pipeline)
-> IO (Result, "pipelines" ::: Vector Pipeline)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   (Result, "pipelines" ::: Vector Pipeline)
   IO
   (Result, "pipelines" ::: Vector Pipeline)
 -> io (Result, "pipelines" ::: Vector Pipeline))
-> ContT
     (Result, "pipelines" ::: Vector Pipeline)
     IO
     (Result, "pipelines" ::: Vector Pipeline)
-> io (Result, "pipelines" ::: Vector Pipeline)
forall a b. (a -> b) -> a -> b
$ do
  let vkCreateRayTracingPipelinesKHRPtr :: FunPtr
  (Ptr Device_T
   -> PipelineCache
   -> ("bindInfoCount" ::: Word32)
   -> ("pCreateInfos"
       ::: Ptr (SomeStruct RayTracingPipelineCreateInfoKHR))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pPipelines" ::: Ptr Pipeline)
   -> IO Result)
vkCreateRayTracingPipelinesKHRPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> PipelineCache
      -> ("bindInfoCount" ::: Word32)
      -> ("pCreateInfos"
          ::: Ptr (SomeStruct RayTracingPipelineCreateInfoKHR))
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pPipelines" ::: Ptr Pipeline)
      -> IO Result)
pVkCreateRayTracingPipelinesKHR (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  IO () -> ContT (Result, "pipelines" ::: Vector Pipeline) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, "pipelines" ::: Vector Pipeline) IO ())
-> IO () -> ContT (Result, "pipelines" ::: Vector Pipeline) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> PipelineCache
   -> ("bindInfoCount" ::: Word32)
   -> ("pCreateInfos"
       ::: Ptr (SomeStruct RayTracingPipelineCreateInfoKHR))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pPipelines" ::: Ptr Pipeline)
   -> IO Result)
vkCreateRayTracingPipelinesKHRPtr FunPtr
  (Ptr Device_T
   -> PipelineCache
   -> ("bindInfoCount" ::: Word32)
   -> ("pCreateInfos"
       ::: Ptr (SomeStruct RayTracingPipelineCreateInfoKHR))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pPipelines" ::: Ptr Pipeline)
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> PipelineCache
      -> ("bindInfoCount" ::: Word32)
      -> ("pCreateInfos"
          ::: Ptr (SomeStruct RayTracingPipelineCreateInfoKHR))
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pPipelines" ::: Ptr Pipeline)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> PipelineCache
   -> ("bindInfoCount" ::: Word32)
   -> ("pCreateInfos"
       ::: Ptr (SomeStruct RayTracingPipelineCreateInfoKHR))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pPipelines" ::: Ptr Pipeline)
   -> IO Result)
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 "" "The function pointer for vkCreateRayTracingPipelinesKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCreateRayTracingPipelinesKHR' :: Ptr Device_T
-> PipelineCache
-> ("bindInfoCount" ::: Word32)
-> ("pCreateInfos"
    ::: Ptr (SomeStruct RayTracingPipelineCreateInfoKHR))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr Pipeline)
-> IO Result
vkCreateRayTracingPipelinesKHR' = FunPtr
  (Ptr Device_T
   -> PipelineCache
   -> ("bindInfoCount" ::: Word32)
   -> ("pCreateInfos"
       ::: Ptr (SomeStruct RayTracingPipelineCreateInfoKHR))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pPipelines" ::: Ptr Pipeline)
   -> IO Result)
-> Ptr Device_T
-> PipelineCache
-> ("bindInfoCount" ::: Word32)
-> ("pCreateInfos"
    ::: Ptr (SomeStruct RayTracingPipelineCreateInfoKHR))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr Pipeline)
-> IO Result
mkVkCreateRayTracingPipelinesKHR FunPtr
  (Ptr Device_T
   -> PipelineCache
   -> ("bindInfoCount" ::: Word32)
   -> ("pCreateInfos"
       ::: Ptr (SomeStruct RayTracingPipelineCreateInfoKHR))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pPipelines" ::: Ptr Pipeline)
   -> IO Result)
vkCreateRayTracingPipelinesKHRPtr
  Ptr (RayTracingPipelineCreateInfoKHR Any)
pPCreateInfos <- ((Ptr (RayTracingPipelineCreateInfoKHR Any)
  -> IO (Result, "pipelines" ::: Vector Pipeline))
 -> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
     (Result, "pipelines" ::: Vector Pipeline)
     IO
     (Ptr (RayTracingPipelineCreateInfoKHR Any))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (RayTracingPipelineCreateInfoKHR Any)
   -> IO (Result, "pipelines" ::: Vector Pipeline))
  -> IO (Result, "pipelines" ::: Vector Pipeline))
 -> ContT
      (Result, "pipelines" ::: Vector Pipeline)
      IO
      (Ptr (RayTracingPipelineCreateInfoKHR Any)))
-> ((Ptr (RayTracingPipelineCreateInfoKHR Any)
     -> IO (Result, "pipelines" ::: Vector Pipeline))
    -> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
     (Result, "pipelines" ::: Vector Pipeline)
     IO
     (Ptr (RayTracingPipelineCreateInfoKHR Any))
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> (Ptr (RayTracingPipelineCreateInfoKHR Any)
    -> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline)
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @(RayTracingPipelineCreateInfoKHR _) ((("createInfos"
 ::: Vector (SomeStruct RayTracingPipelineCreateInfoKHR))
-> Int
forall a. Vector a -> Int
Data.Vector.length ("createInfos"
::: Vector (SomeStruct RayTracingPipelineCreateInfoKHR)
createInfos)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 120) 8
  (Int
 -> SomeStruct RayTracingPipelineCreateInfoKHR
 -> ContT (Result, "pipelines" ::: Vector Pipeline) IO ())
-> ("createInfos"
    ::: Vector (SomeStruct RayTracingPipelineCreateInfoKHR))
-> ContT (Result, "pipelines" ::: Vector Pipeline) IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: SomeStruct RayTracingPipelineCreateInfoKHR
e -> ((() -> IO (Result, "pipelines" ::: Vector Pipeline))
 -> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT (Result, "pipelines" ::: Vector Pipeline) IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO (Result, "pipelines" ::: Vector Pipeline))
  -> IO (Result, "pipelines" ::: Vector Pipeline))
 -> ContT (Result, "pipelines" ::: Vector Pipeline) IO ())
-> ((() -> IO (Result, "pipelines" ::: Vector Pipeline))
    -> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT (Result, "pipelines" ::: Vector Pipeline) IO ()
forall a b. (a -> b) -> a -> b
$ ("pCreateInfos"
 ::: Ptr (SomeStruct RayTracingPipelineCreateInfoKHR))
-> SomeStruct RayTracingPipelineCreateInfoKHR
-> IO (Result, "pipelines" ::: Vector Pipeline)
-> IO (Result, "pipelines" ::: Vector Pipeline)
forall (a :: [*] -> *) b.
(forall (es :: [*]).
 (Extendss a es, PokeChain es) =>
 ToCStruct (a es)) =>
Ptr (SomeStruct a) -> SomeStruct a -> IO b -> IO b
pokeSomeCStruct (Ptr (RayTracingPipelineCreateInfoKHR Any)
-> "pCreateInfos"
   ::: Ptr (SomeStruct RayTracingPipelineCreateInfoKHR)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (RayTracingPipelineCreateInfoKHR Any)
pPCreateInfos Ptr (RayTracingPipelineCreateInfoKHR Any)
-> Int -> Ptr (RayTracingPipelineCreateInfoKHR _)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (120 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (RayTracingPipelineCreateInfoKHR _))) (SomeStruct RayTracingPipelineCreateInfoKHR
e) (IO (Result, "pipelines" ::: Vector Pipeline)
 -> IO (Result, "pipelines" ::: Vector Pipeline))
-> ((() -> IO (Result, "pipelines" ::: Vector Pipeline))
    -> IO (Result, "pipelines" ::: Vector Pipeline))
-> (() -> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO (Result, "pipelines" ::: Vector Pipeline))
-> () -> IO (Result, "pipelines" ::: Vector Pipeline)
forall a b. (a -> b) -> a -> b
$ ())) ("createInfos"
::: Vector (SomeStruct RayTracingPipelineCreateInfoKHR)
createInfos)
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT
     (Result, "pipelines" ::: Vector Pipeline)
     IO
     ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks)
  -> IO (Result, "pipelines" ::: Vector Pipeline))
 -> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
     (Result, "pipelines" ::: Vector Pipeline)
     IO
     ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO (Result, "pipelines" ::: Vector Pipeline))
  -> IO (Result, "pipelines" ::: Vector Pipeline))
 -> ContT
      (Result, "pipelines" ::: Vector Pipeline)
      IO
      ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks)
     -> IO (Result, "pipelines" ::: Vector Pipeline))
    -> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
     (Result, "pipelines" ::: Vector Pipeline)
     IO
     ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks)
    -> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  "pPipelines" ::: Ptr Pipeline
pPPipelines <- ((("pPipelines" ::: Ptr Pipeline)
  -> IO (Result, "pipelines" ::: Vector Pipeline))
 -> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
     (Result, "pipelines" ::: Vector Pipeline)
     IO
     ("pPipelines" ::: Ptr Pipeline)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pPipelines" ::: Ptr Pipeline)
   -> IO (Result, "pipelines" ::: Vector Pipeline))
  -> IO (Result, "pipelines" ::: Vector Pipeline))
 -> ContT
      (Result, "pipelines" ::: Vector Pipeline)
      IO
      ("pPipelines" ::: Ptr Pipeline))
-> ((("pPipelines" ::: Ptr Pipeline)
     -> IO (Result, "pipelines" ::: Vector Pipeline))
    -> IO (Result, "pipelines" ::: Vector Pipeline))
-> ContT
     (Result, "pipelines" ::: Vector Pipeline)
     IO
     ("pPipelines" ::: Ptr Pipeline)
forall a b. (a -> b) -> a -> b
$ IO ("pPipelines" ::: Ptr Pipeline)
-> (("pPipelines" ::: Ptr Pipeline) -> IO ())
-> (("pPipelines" ::: Ptr Pipeline)
    -> IO (Result, "pipelines" ::: Vector Pipeline))
-> IO (Result, "pipelines" ::: Vector Pipeline)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pPipelines" ::: Ptr Pipeline)
forall a. Int -> IO (Ptr a)
callocBytes @Pipeline ((("bindInfoCount" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int -> "bindInfoCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("createInfos"
 ::: Vector (SomeStruct RayTracingPipelineCreateInfoKHR))
-> Int
forall a. Vector a -> Int
Data.Vector.length (("createInfos"
  ::: Vector (SomeStruct RayTracingPipelineCreateInfoKHR))
 -> Int)
-> ("createInfos"
    ::: Vector (SomeStruct RayTracingPipelineCreateInfoKHR))
-> Int
forall a b. (a -> b) -> a -> b
$ ("createInfos"
::: Vector (SomeStruct RayTracingPipelineCreateInfoKHR)
createInfos)) :: Word32))) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8)) ("pPipelines" ::: Ptr Pipeline) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result
-> ContT (Result, "pipelines" ::: Vector Pipeline) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT (Result, "pipelines" ::: Vector Pipeline) IO Result)
-> IO Result
-> ContT (Result, "pipelines" ::: Vector Pipeline) IO Result
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> PipelineCache
-> ("bindInfoCount" ::: Word32)
-> ("pCreateInfos"
    ::: Ptr (SomeStruct RayTracingPipelineCreateInfoKHR))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pPipelines" ::: Ptr Pipeline)
-> IO Result
vkCreateRayTracingPipelinesKHR' (Device -> Ptr Device_T
deviceHandle (Device
device)) (PipelineCache
pipelineCache) ((Int -> "bindInfoCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("createInfos"
 ::: Vector (SomeStruct RayTracingPipelineCreateInfoKHR))
-> Int
forall a. Vector a -> Int
Data.Vector.length (("createInfos"
  ::: Vector (SomeStruct RayTracingPipelineCreateInfoKHR))
 -> Int)
-> ("createInfos"
    ::: Vector (SomeStruct RayTracingPipelineCreateInfoKHR))
-> Int
forall a b. (a -> b) -> a -> b
$ ("createInfos"
::: Vector (SomeStruct RayTracingPipelineCreateInfoKHR)
createInfos)) :: Word32)) (Ptr (RayTracingPipelineCreateInfoKHR Any)
-> "pCreateInfos"
   ::: Ptr (SomeStruct RayTracingPipelineCreateInfoKHR)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (RayTracingPipelineCreateInfoKHR Any)
pPCreateInfos)) "pAllocator" ::: Ptr AllocationCallbacks
pAllocator ("pPipelines" ::: Ptr Pipeline
pPPipelines)
  IO () -> ContT (Result, "pipelines" ::: Vector Pipeline) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, "pipelines" ::: Vector Pipeline) IO ())
-> IO () -> ContT (Result, "pipelines" ::: Vector Pipeline) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  "pipelines" ::: Vector Pipeline
pPipelines <- IO ("pipelines" ::: Vector Pipeline)
-> ContT
     (Result, "pipelines" ::: Vector Pipeline)
     IO
     ("pipelines" ::: Vector Pipeline)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("pipelines" ::: Vector Pipeline)
 -> ContT
      (Result, "pipelines" ::: Vector Pipeline)
      IO
      ("pipelines" ::: Vector Pipeline))
-> IO ("pipelines" ::: Vector Pipeline)
-> ContT
     (Result, "pipelines" ::: Vector Pipeline)
     IO
     ("pipelines" ::: Vector Pipeline)
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> IO Pipeline) -> IO ("pipelines" ::: Vector Pipeline)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (("bindInfoCount" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int -> "bindInfoCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("createInfos"
 ::: Vector (SomeStruct RayTracingPipelineCreateInfoKHR))
-> Int
forall a. Vector a -> Int
Data.Vector.length (("createInfos"
  ::: Vector (SomeStruct RayTracingPipelineCreateInfoKHR))
 -> Int)
-> ("createInfos"
    ::: Vector (SomeStruct RayTracingPipelineCreateInfoKHR))
-> Int
forall a b. (a -> b) -> a -> b
$ ("createInfos"
::: Vector (SomeStruct RayTracingPipelineCreateInfoKHR)
createInfos)) :: Word32))) (\i :: Int
i -> ("pPipelines" ::: Ptr Pipeline) -> IO Pipeline
forall a. Storable a => Ptr a -> IO a
peek @Pipeline (("pPipelines" ::: Ptr Pipeline
pPPipelines ("pPipelines" ::: Ptr Pipeline)
-> Int -> "pPipelines" ::: Ptr Pipeline
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Pipeline)))
  (Result, "pipelines" ::: Vector Pipeline)
-> ContT
     (Result, "pipelines" ::: Vector Pipeline)
     IO
     (Result, "pipelines" ::: Vector Pipeline)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, "pipelines" ::: Vector Pipeline)
 -> ContT
      (Result, "pipelines" ::: Vector Pipeline)
      IO
      (Result, "pipelines" ::: Vector Pipeline))
-> (Result, "pipelines" ::: Vector Pipeline)
-> ContT
     (Result, "pipelines" ::: Vector Pipeline)
     IO
     (Result, "pipelines" ::: Vector Pipeline)
forall a b. (a -> b) -> a -> b
$ (Result
r, "pipelines" ::: Vector Pipeline
pPipelines)


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

-- | vkCmdTraceRaysIndirectKHR - Initialize an indirect ray tracing dispatch
--
-- = Description
--
-- 'cmdTraceRaysIndirectKHR' behaves similarly to 'cmdTraceRaysKHR' except
-- that the ray trace query dimensions are read by the device from @buffer@
-- during execution. The parameters of trace ray are encoded in the
-- 'TraceRaysIndirectCommandKHR' structure located at @offset@ bytes in
-- @buffer@.
--
-- == Valid Usage
--
-- -   If a 'Vulkan.Core10.Handles.Sampler' created with @magFilter@ or
--     @minFilter@ equal to 'Vulkan.Core10.Enums.Filter.FILTER_LINEAR' and
--     @compareEnable@ equal to 'Vulkan.Core10.FundamentalTypes.FALSE' is
--     used to sample a 'Vulkan.Core10.Handles.ImageView' as a result of
--     this command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_SAMPLED_IMAGE_FILTER_LINEAR_BIT'
--
-- -   If a 'Vulkan.Core10.Handles.ImageView' is accessed using atomic
--     operations as a result of this command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_STORAGE_IMAGE_ATOMIC_BIT'
--
-- -   If a 'Vulkan.Core10.Handles.ImageView' is sampled with
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FILTER_CUBIC_EXT' as a result
--     of this command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FORMAT_FEATURE_SAMPLED_IMAGE_FILTER_CUBIC_BIT_EXT'
--
-- -   Any 'Vulkan.Core10.Handles.ImageView' being sampled with
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FILTER_CUBIC_EXT' as a result
--     of this command /must/ have a
--     'Vulkan.Core10.Enums.ImageViewType.ImageViewType' and format that
--     supports cubic filtering, as specified by
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FilterCubicImageViewImageFormatPropertiesEXT'::@filterCubic@
--     returned by
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceImageFormatProperties2'
--
-- -   Any 'Vulkan.Core10.Handles.ImageView' being sampled with
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FILTER_CUBIC_EXT' with a
--     reduction mode of either
--     'Vulkan.Core12.Enums.SamplerReductionMode.SAMPLER_REDUCTION_MODE_MIN'
--     or
--     'Vulkan.Core12.Enums.SamplerReductionMode.SAMPLER_REDUCTION_MODE_MAX'
--     as a result of this command /must/ have a
--     'Vulkan.Core10.Enums.ImageViewType.ImageViewType' and format that
--     supports cubic filtering together with minmax filtering, as
--     specified by
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FilterCubicImageViewImageFormatPropertiesEXT'::@filterCubicMinmax@
--     returned by
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceImageFormatProperties2'
--
-- -   Any 'Vulkan.Core10.Handles.Image' created with a
--     'Vulkan.Core10.Image.ImageCreateInfo'::@flags@ containing
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_CORNER_SAMPLED_BIT_NV'
--     sampled as a result of this command /must/ only be sampled using a
--     'Vulkan.Core10.Enums.SamplerAddressMode.SamplerAddressMode' of
--     'Vulkan.Core10.Enums.SamplerAddressMode.SAMPLER_ADDRESS_MODE_CLAMP_TO_EDGE'
--
-- -   For each set /n/ that is statically used by the
--     'Vulkan.Core10.Handles.Pipeline' bound to the pipeline bind point
--     used by this command, a descriptor set /must/ have been bound to /n/
--     at the same pipeline bind point, with a
--     'Vulkan.Core10.Handles.PipelineLayout' that is compatible for set
--     /n/, with the 'Vulkan.Core10.Handles.PipelineLayout' used to create
--     the current 'Vulkan.Core10.Handles.Pipeline', as described in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#descriptorsets-compatibility ???>
--
-- -   For each push constant that is statically used by the
--     'Vulkan.Core10.Handles.Pipeline' bound to the pipeline bind point
--     used by this command, a push constant value /must/ have been set for
--     the same pipeline bind point, with a
--     'Vulkan.Core10.Handles.PipelineLayout' that is compatible for push
--     constants, with the 'Vulkan.Core10.Handles.PipelineLayout' used to
--     create the current 'Vulkan.Core10.Handles.Pipeline', as described in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#descriptorsets-compatibility ???>
--
-- -   Descriptors in each bound descriptor set, specified via
--     'Vulkan.Core10.CommandBufferBuilding.cmdBindDescriptorSets', /must/
--     be valid if they are statically used by the
--     'Vulkan.Core10.Handles.Pipeline' bound to the pipeline bind point
--     used by this command
--
-- -   A valid pipeline /must/ be bound to the pipeline bind point used by
--     this command
--
-- -   If the 'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline
--     bind point used by this command requires any dynamic state, that
--     state /must/ have been set for @commandBuffer@, and done so after
--     any previously bound pipeline with the corresponding state not
--     specified as dynamic
--
-- -   There /must/ not have been any calls to dynamic state setting
--     commands for any state not specified as dynamic in the
--     'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline bind
--     point used by this command, since that pipeline was bound
--
-- -   If the 'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline
--     bind point used by this command accesses a
--     'Vulkan.Core10.Handles.Sampler' object that uses unnormalized
--     coordinates, that sampler /must/ not be used to sample from any
--     'Vulkan.Core10.Handles.Image' with a
--     'Vulkan.Core10.Handles.ImageView' of the type
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_3D',
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE',
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_1D_ARRAY',
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D_ARRAY' or
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE_ARRAY', in
--     any shader stage
--
-- -   If the 'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline
--     bind point used by this command accesses a
--     'Vulkan.Core10.Handles.Sampler' object that uses unnormalized
--     coordinates, that sampler /must/ not be used with any of the SPIR-V
--     @OpImageSample*@ or @OpImageSparseSample*@ instructions with
--     @ImplicitLod@, @Dref@ or @Proj@ in their name, in any shader stage
--
-- -   If the 'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline
--     bind point used by this command accesses a
--     'Vulkan.Core10.Handles.Sampler' object that uses unnormalized
--     coordinates, that sampler /must/ not be used with any of the SPIR-V
--     @OpImageSample*@ or @OpImageSparseSample*@ instructions that
--     includes a LOD bias or any offset values, in any shader stage
--
-- -   If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-robustBufferAccess robust buffer access>
--     feature is not enabled, and if the 'Vulkan.Core10.Handles.Pipeline'
--     object bound to the pipeline bind point used by this command
--     accesses a uniform buffer, it /must/ not access values outside of
--     the range of the buffer as specified in the descriptor set bound to
--     the same pipeline bind point
--
-- -   If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-robustBufferAccess robust buffer access>
--     feature is not enabled, and if the 'Vulkan.Core10.Handles.Pipeline'
--     object bound to the pipeline bind point used by this command
--     accesses a storage buffer, it /must/ not access values outside of
--     the range of the buffer as specified in the descriptor set bound to
--     the same pipeline bind point
--
-- -   If @commandBuffer@ is an unprotected command buffer, any resource
--     accessed by the 'Vulkan.Core10.Handles.Pipeline' object bound to the
--     pipeline bind point used by this command /must/ not be a protected
--     resource
--
-- -   If a 'Vulkan.Core10.Handles.ImageView' is accessed using
--     @OpImageWrite@ as a result of this command, then the @Type@ of the
--     @Texel@ operand of that instruction /must/ have at least as many
--     components as the image view’s format.
--
-- -   If a 'Vulkan.Core10.Handles.BufferView' is accessed using
--     @OpImageWrite@ as a result of this command, then the @Type@ of the
--     @Texel@ operand of that instruction /must/ have at least as many
--     components as the image view’s format.
--
-- -   If a 'Vulkan.Core10.Handles.ImageView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a 64-bit channel width
--     is accessed as a result of this command, the @SampledType@ of the
--     @OpTypeImage@ operand of that instruction /must/ have a @Width@ of
--     64.
--
-- -   If a 'Vulkan.Core10.Handles.ImageView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a channel width less
--     than 64-bit is accessed as a result of this command, the
--     @SampledType@ of the @OpTypeImage@ operand of that instruction
--     /must/ have a @Width@ of 32.
--
-- -   If a 'Vulkan.Core10.Handles.BufferView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a 64-bit channel width
--     is accessed as a result of this command, the @SampledType@ of the
--     @OpTypeImage@ operand of that instruction /must/ have a @Width@ of
--     64.
--
-- -   If a 'Vulkan.Core10.Handles.BufferView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a channel width less
--     than 64-bit is accessed as a result of this command, the
--     @SampledType@ of the @OpTypeImage@ operand of that instruction
--     /must/ have a @Width@ of 32.
--
-- -   If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-sparseImageInt64Atomics sparseImageInt64Atomics>
--     feature is not enabled, 'Vulkan.Core10.Handles.Image' objects
--     created with the
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SPARSE_RESIDENCY_BIT'
--     flag /must/ not be accessed by atomic instructions through an
--     @OpTypeImage@ with a @SampledType@ with a @Width@ of 64 by this
--     command.
--
-- -   If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-sparseImageInt64Atomics sparseImageInt64Atomics>
--     feature is not enabled, 'Vulkan.Core10.Handles.Buffer' objects
--     created with the
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_SPARSE_RESIDENCY_BIT'
--     flag /must/ not be accessed by atomic instructions through an
--     @OpTypeImage@ with a @SampledType@ with a @Width@ of 64 by this
--     command.
--
-- -   Any shader group handle referenced by this call /must/ have been
--     queried from the currently bound ray tracing shader pipeline
--
-- -   This command /must/ not cause a shader call instruction to be
--     executed from a shader invocation with a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#ray-tracing-recursion-depth recursion depth>
--     greater than the value of @maxRecursionDepth@ used to create the
--     bound ray tracing pipeline
--
-- -   If @pRayGenShaderBindingTable->buffer@ is non-sparse then it /must/
--     be bound completely and contiguously to a single
--     'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   The @offset@ member of @pRayGenShaderBindingTable@ /must/ be less
--     than the size of the @pRayGenShaderBindingTable->buffer@
--
-- -   @pRayGenShaderBindingTable->offset@ /must/ be a multiple of
--     'PhysicalDeviceRayTracingPropertiesKHR'::@shaderGroupBaseAlignment@
--
-- -   @pRayGenShaderBindingTable->offset@ +
--     @pRayGenShaderBindingTable->size@ /must/ be less than or equal to
--     the size of @pRayGenShaderBindingTable->buffer@
--
-- -   The @size@ member of @pRayGenShaderBindingTable@ /must/ be equal to
--     its @stride@ member
--
-- -   If @pMissShaderBindingTable->buffer@ is non-sparse then it /must/ be
--     bound completely and contiguously to a single
--     'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   The @offset@ member of @pMissShaderBindingTable@ /must/ be less than
--     the size of @pMissShaderBindingTable->buffer@
--
-- -   The @offset@ member of @pMissShaderBindingTable@ /must/ be a
--     multiple of
--     'PhysicalDeviceRayTracingPropertiesKHR'::@shaderGroupBaseAlignment@
--
-- -   @pMissShaderBindingTable->offset@ + @pMissShaderBindingTable->size@
--     /must/ be less than or equal to the size of
--     @pMissShaderBindingTable->buffer@
--
-- -   The @stride@ member of @pMissShaderBindingTable@ /must/ be a
--     multiple of
--     'PhysicalDeviceRayTracingPropertiesKHR'::@shaderGroupHandleSize@
--
-- -   The @stride@ member of @pMissShaderBindingTable@ /must/ be less than
--     or equal to
--     'PhysicalDeviceRayTracingPropertiesKHR'::@maxShaderGroupStride@
--
-- -   If @pHitShaderBindingTable->buffer@ is non-sparse then it /must/ be
--     bound completely and contiguously to a single
--     'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   The @offset@ member of @pHitShaderBindingTable@ /must/ be less than
--     the size of @pHitShaderBindingTable->buffer@
--
-- -   The @offset@ member of @pHitShaderBindingTable@ /must/ be a multiple
--     of
--     'PhysicalDeviceRayTracingPropertiesKHR'::@shaderGroupBaseAlignment@
--
-- -   @pHitShaderBindingTable->offset@ + @pHitShaderBindingTable->size@
--     /must/ be less than or equal to the size of
--     @pHitShaderBindingTable->buffer@
--
-- -   The @stride@ member of @pHitShaderBindingTable@ /must/ be a multiple
--     of 'PhysicalDeviceRayTracingPropertiesKHR'::@shaderGroupHandleSize@
--
-- -   The @stride@ member of @pHitShaderBindingTable@ /must/ be less than
--     or equal to
--     'PhysicalDeviceRayTracingPropertiesKHR'::@maxShaderGroupStride@
--
-- -   If @pCallableShaderBindingTable->buffer@ is non-sparse then it
--     /must/ be bound completely and contiguously to a single
--     'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   The @offset@ member of @pCallableShaderBindingTable@ /must/ be less
--     than the size of @pCallableShaderBindingTable->buffer@
--
-- -   The @offset@ member of @pCallableShaderBindingTable@ /must/ be a
--     multiple of
--     'PhysicalDeviceRayTracingPropertiesKHR'::@shaderGroupBaseAlignment@
--
-- -   @pCallableShaderBindingTable->offset@ +
--     @pCallableShaderBindingTable->size@ /must/ be less than or equal to
--     the size of @pCallableShaderBindingTable->buffer@
--
-- -   The @stride@ member of @pCallableShaderBindingTable@ /must/ be a
--     multiple of
--     'PhysicalDeviceRayTracingPropertiesKHR'::@shaderGroupHandleSize@
--
-- -   The @stride@ member of @pCallableShaderBindingTable@ /must/ be less
--     than or equal to
--     'PhysicalDeviceRayTracingPropertiesKHR'::@maxShaderGroupStride@
--
-- -   If the currently bound ray tracing pipeline was created with @flags@
--     that included
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RAY_TRACING_NO_NULL_ANY_HIT_SHADERS_BIT_KHR',
--     the @buffer@ member of @pHitShaderBindingTable@ /must/ not be
--     'Vulkan.Core10.APIConstants.NULL_HANDLE'
--
-- -   If the currently bound ray tracing pipeline was created with @flags@
--     that included
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RAY_TRACING_NO_NULL_CLOSEST_HIT_SHADERS_BIT_KHR',
--     the @buffer@ member of @pHitShaderBindingTable@ /must/ not be
--     'Vulkan.Core10.APIConstants.NULL_HANDLE'
--
-- -   If the currently bound ray tracing pipeline was created with @flags@
--     that included
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RAY_TRACING_NO_NULL_INTERSECTION_SHADERS_BIT_KHR',
--     the @buffer@ member of @pHitShaderBindingTable@ /must/ not be
--     'Vulkan.Core10.APIConstants.NULL_HANDLE'
--
-- -   If the currently bound ray tracing pipeline was created with @flags@
--     that included
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RAY_TRACING_NO_NULL_MISS_SHADERS_BIT_KHR',
--     the shader group handle identified by @pMissShaderBindingTable@
--     /must/ contain a valid miss shader
--
-- -   If the currently bound ray tracing pipeline was created with @flags@
--     that included
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RAY_TRACING_NO_NULL_ANY_HIT_SHADERS_BIT_KHR',
--     entries in @pHitShaderBindingTable@ accessed as a result of this
--     command in order to execute an any hit shader /must/ not be set to
--     zero
--
-- -   If the currently bound ray tracing pipeline was created with @flags@
--     that included
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RAY_TRACING_NO_NULL_CLOSEST_HIT_SHADERS_BIT_KHR',
--     entries in @pHitShaderBindingTable@ accessed as a result of this
--     command in order to execute a closest hit shader /must/ not be set
--     to zero
--
-- -   If the currently bound ray tracing pipeline was created with @flags@
--     that included
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RAY_TRACING_NO_NULL_INTERSECTION_SHADERS_BIT_KHR',
--     entries in @pHitShaderBindingTable@ accessed as a result of this
--     command in order to execute an intersection shader /must/ not be set
--     to zero
--
-- -   If @buffer@ is non-sparse then it /must/ be bound completely and
--     contiguously to a single 'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   @buffer@ /must/ have been created with the
--     'Vulkan.Core10.Enums.BufferUsageFlagBits.BUFFER_USAGE_INDIRECT_BUFFER_BIT'
--     bit set
--
-- -   @offset@ /must/ be a multiple of @4@
--
-- -   @commandBuffer@ /must/ not be a protected command buffer
--
-- -   (@offset@ + @sizeof@('TraceRaysIndirectCommandKHR')) /must/ be less
--     than or equal to the size of @buffer@
--
-- -   the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-raytracing-indirecttraceray ::rayTracingIndirectTraceRays>
--     feature /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   @pRaygenShaderBindingTable@ /must/ be a valid pointer to a valid
--     'StridedBufferRegionKHR' structure
--
-- -   @pMissShaderBindingTable@ /must/ be a valid pointer to a valid
--     'StridedBufferRegionKHR' structure
--
-- -   @pHitShaderBindingTable@ /must/ be a valid pointer to a valid
--     'StridedBufferRegionKHR' structure
--
-- -   @pCallableShaderBindingTable@ /must/ be a valid pointer to a valid
--     'StridedBufferRegionKHR' structure
--
-- -   @buffer@ /must/ be a valid 'Vulkan.Core10.Handles.Buffer' handle
--
-- -   @commandBuffer@ /must/ be in the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#commandbuffers-lifecycle recording state>
--
-- -   The 'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support compute operations
--
-- -   This command /must/ only be called outside of a render pass instance
--
-- -   Both of @buffer@, and @commandBuffer@ /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> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-pipeline-stages-types Pipeline Type> |
-- +============================================================================================================================+========================================================================================================================+=======================================================================================================================+=====================================================================================================================================+
-- | Primary                                                                                                                    | Outside                                                                                                                | Compute                                                                                                               |                                                                                                                                     |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                       |                                                                                                                                     |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+-------------------------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- 'Vulkan.Core10.Handles.Buffer', 'Vulkan.Core10.Handles.CommandBuffer',
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize', 'StridedBufferRegionKHR'
cmdTraceRaysIndirectKHR :: forall io
                         . (MonadIO io)
                        => -- | @commandBuffer@ is the command buffer into which the command will be
                           -- recorded.
                           CommandBuffer
                        -> -- | @pRaygenShaderBindingTable@ is a 'StridedBufferRegionKHR' that holds the
                           -- shader binding table data for the ray generation shader stage.
                           ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
                        -> -- | @pMissShaderBindingTable@ is a 'StridedBufferRegionKHR' that holds the
                           -- shader binding table data for the miss shader stage.
                           ("missShaderBindingTable" ::: StridedBufferRegionKHR)
                        -> -- | @pHitShaderBindingTable@ is a 'StridedBufferRegionKHR' that holds the
                           -- shader binding table data for the hit shader stage.
                           ("hitShaderBindingTable" ::: StridedBufferRegionKHR)
                        -> -- | @pCallableShaderBindingTable@ is a 'StridedBufferRegionKHR' that holds
                           -- the shader binding table data for the callable shader stage.
                           ("callableShaderBindingTable" ::: StridedBufferRegionKHR)
                        -> -- | @buffer@ is the buffer containing the trace ray parameters.
                           Buffer
                        -> -- | @offset@ is the byte offset into @buffer@ where parameters begin.
                           ("offset" ::: DeviceSize)
                        -> io ()
cmdTraceRaysIndirectKHR :: CommandBuffer
-> ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
-> ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
-> ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
-> ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
-> Buffer
-> ("dataSize" ::: Word64)
-> io ()
cmdTraceRaysIndirectKHR commandBuffer :: CommandBuffer
commandBuffer raygenShaderBindingTable :: "raygenShaderBindingTable" ::: StridedBufferRegionKHR
raygenShaderBindingTable missShaderBindingTable :: "raygenShaderBindingTable" ::: StridedBufferRegionKHR
missShaderBindingTable hitShaderBindingTable :: "raygenShaderBindingTable" ::: StridedBufferRegionKHR
hitShaderBindingTable callableShaderBindingTable :: "raygenShaderBindingTable" ::: StridedBufferRegionKHR
callableShaderBindingTable buffer :: Buffer
buffer offset :: "dataSize" ::: Word64
offset = 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 vkCmdTraceRaysIndirectKHRPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> Buffer
   -> ("dataSize" ::: Word64)
   -> IO ())
vkCmdTraceRaysIndirectKHRPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pRaygenShaderBindingTable"
          ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
      -> ("pRaygenShaderBindingTable"
          ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
      -> ("pRaygenShaderBindingTable"
          ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
      -> ("pRaygenShaderBindingTable"
          ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
      -> Buffer
      -> ("dataSize" ::: Word64)
      -> IO ())
pVkCmdTraceRaysIndirectKHR (CommandBuffer -> DeviceCmds
deviceCmds (CommandBuffer
commandBuffer :: CommandBuffer))
  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
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> Buffer
   -> ("dataSize" ::: Word64)
   -> IO ())
vkCmdTraceRaysIndirectKHRPtr FunPtr
  (Ptr CommandBuffer_T
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> Buffer
   -> ("dataSize" ::: Word64)
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pRaygenShaderBindingTable"
          ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
      -> ("pRaygenShaderBindingTable"
          ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
      -> ("pRaygenShaderBindingTable"
          ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
      -> ("pRaygenShaderBindingTable"
          ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
      -> Buffer
      -> ("dataSize" ::: Word64)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> Buffer
   -> ("dataSize" ::: Word64)
   -> 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 "" "The function pointer for vkCmdTraceRaysIndirectKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdTraceRaysIndirectKHR' :: Ptr CommandBuffer_T
-> ("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
-> ("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
-> ("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
-> ("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
-> Buffer
-> ("dataSize" ::: Word64)
-> IO ()
vkCmdTraceRaysIndirectKHR' = FunPtr
  (Ptr CommandBuffer_T
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> Buffer
   -> ("dataSize" ::: Word64)
   -> IO ())
-> Ptr CommandBuffer_T
-> ("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
-> ("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
-> ("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
-> ("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
-> Buffer
-> ("dataSize" ::: Word64)
-> IO ()
mkVkCmdTraceRaysIndirectKHR FunPtr
  (Ptr CommandBuffer_T
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> Buffer
   -> ("dataSize" ::: Word64)
   -> IO ())
vkCmdTraceRaysIndirectKHRPtr
  "pRaygenShaderBindingTable"
::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
pRaygenShaderBindingTable <- ((("pRaygenShaderBindingTable"
   ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
  -> IO ())
 -> IO ())
-> ContT
     ()
     IO
     ("pRaygenShaderBindingTable"
      ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> IO ())
  -> IO ())
 -> ContT
      ()
      IO
      ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)))
-> ((("pRaygenShaderBindingTable"
      ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
     -> IO ())
    -> IO ())
-> ContT
     ()
     IO
     ("pRaygenShaderBindingTable"
      ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
forall a b. (a -> b) -> a -> b
$ ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
-> (("pRaygenShaderBindingTable"
     ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
    -> IO ())
-> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct ("raygenShaderBindingTable" ::: StridedBufferRegionKHR
raygenShaderBindingTable)
  "pRaygenShaderBindingTable"
::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
pMissShaderBindingTable <- ((("pRaygenShaderBindingTable"
   ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
  -> IO ())
 -> IO ())
-> ContT
     ()
     IO
     ("pRaygenShaderBindingTable"
      ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> IO ())
  -> IO ())
 -> ContT
      ()
      IO
      ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)))
-> ((("pRaygenShaderBindingTable"
      ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
     -> IO ())
    -> IO ())
-> ContT
     ()
     IO
     ("pRaygenShaderBindingTable"
      ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
forall a b. (a -> b) -> a -> b
$ ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
-> (("pRaygenShaderBindingTable"
     ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
    -> IO ())
-> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct ("raygenShaderBindingTable" ::: StridedBufferRegionKHR
missShaderBindingTable)
  "pRaygenShaderBindingTable"
::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
pHitShaderBindingTable <- ((("pRaygenShaderBindingTable"
   ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
  -> IO ())
 -> IO ())
-> ContT
     ()
     IO
     ("pRaygenShaderBindingTable"
      ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> IO ())
  -> IO ())
 -> ContT
      ()
      IO
      ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)))
-> ((("pRaygenShaderBindingTable"
      ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
     -> IO ())
    -> IO ())
-> ContT
     ()
     IO
     ("pRaygenShaderBindingTable"
      ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
forall a b. (a -> b) -> a -> b
$ ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
-> (("pRaygenShaderBindingTable"
     ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
    -> IO ())
-> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct ("raygenShaderBindingTable" ::: StridedBufferRegionKHR
hitShaderBindingTable)
  "pRaygenShaderBindingTable"
::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
pCallableShaderBindingTable <- ((("pRaygenShaderBindingTable"
   ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
  -> IO ())
 -> IO ())
-> ContT
     ()
     IO
     ("pRaygenShaderBindingTable"
      ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
   -> IO ())
  -> IO ())
 -> ContT
      ()
      IO
      ("pRaygenShaderBindingTable"
       ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)))
-> ((("pRaygenShaderBindingTable"
      ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
     -> IO ())
    -> IO ())
-> ContT
     ()
     IO
     ("pRaygenShaderBindingTable"
      ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
forall a b. (a -> b) -> a -> b
$ ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
-> (("pRaygenShaderBindingTable"
     ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
    -> IO ())
-> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct ("raygenShaderBindingTable" ::: StridedBufferRegionKHR
callableShaderBindingTable)
  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
$ Ptr CommandBuffer_T
-> ("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
-> ("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
-> ("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
-> ("pRaygenShaderBindingTable"
    ::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR))
-> Buffer
-> ("dataSize" ::: Word64)
-> IO ()
vkCmdTraceRaysIndirectKHR' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) "pRaygenShaderBindingTable"
::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
pRaygenShaderBindingTable "pRaygenShaderBindingTable"
::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
pMissShaderBindingTable "pRaygenShaderBindingTable"
::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
pHitShaderBindingTable "pRaygenShaderBindingTable"
::: Ptr ("raygenShaderBindingTable" ::: StridedBufferRegionKHR)
pCallableShaderBindingTable (Buffer
buffer) ("dataSize" ::: Word64
offset)
  () -> 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" mkVkGetDeviceAccelerationStructureCompatibilityKHR
  :: FunPtr (Ptr Device_T -> Ptr AccelerationStructureVersionKHR -> IO Result) -> Ptr Device_T -> Ptr AccelerationStructureVersionKHR -> IO Result

-- | vkGetDeviceAccelerationStructureCompatibilityKHR - Check if a serialized
-- acceleration structure is compatible with the current device
--
-- = Description
--
-- This possible return values for
-- 'getDeviceAccelerationStructureCompatibilityKHR' are:
--
-- -   'Vulkan.Core10.Enums.Result.SUCCESS' is returned if an acceleration
--     structure serialized with @version@ as the version information is
--     compatible with @device@.
--
-- -   'Vulkan.Core10.Enums.Result.ERROR_INCOMPATIBLE_VERSION_KHR' is
--     returned if an acceleration structure serialized with @version@ as
--     the version information is not compatible with @device@.
--
-- == Valid Usage
--
-- -   The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-raytracing rayTracing>
--     or
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-rayQuery rayQuery>
--     feature /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   @version@ /must/ be a valid pointer to a valid
--     'AccelerationStructureVersionKHR' structure
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_INCOMPATIBLE_VERSION_KHR'
--
-- = See Also
--
-- 'AccelerationStructureVersionKHR', 'Vulkan.Core10.Handles.Device'
getDeviceAccelerationStructureCompatibilityKHR :: forall io
                                                . (MonadIO io)
                                               => -- | @device@ is the device to check the version against.
                                                  Device
                                               -> -- | @version@ points to the 'AccelerationStructureVersionKHR' version
                                                  -- information to check against the device.
                                                  AccelerationStructureVersionKHR
                                               -> io ()
getDeviceAccelerationStructureCompatibilityKHR :: Device -> AccelerationStructureVersionKHR -> io ()
getDeviceAccelerationStructureCompatibilityKHR device :: Device
device version :: AccelerationStructureVersionKHR
version = 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 vkGetDeviceAccelerationStructureCompatibilityKHRPtr :: FunPtr
  (Ptr Device_T -> Ptr AccelerationStructureVersionKHR -> IO Result)
vkGetDeviceAccelerationStructureCompatibilityKHRPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T -> Ptr AccelerationStructureVersionKHR -> IO Result)
pVkGetDeviceAccelerationStructureCompatibilityKHR (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  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 Device_T -> Ptr AccelerationStructureVersionKHR -> IO Result)
vkGetDeviceAccelerationStructureCompatibilityKHRPtr FunPtr
  (Ptr Device_T -> Ptr AccelerationStructureVersionKHR -> IO Result)
-> FunPtr
     (Ptr Device_T -> Ptr AccelerationStructureVersionKHR -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T -> Ptr AccelerationStructureVersionKHR -> IO Result)
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 "" "The function pointer for vkGetDeviceAccelerationStructureCompatibilityKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetDeviceAccelerationStructureCompatibilityKHR' :: Ptr Device_T -> Ptr AccelerationStructureVersionKHR -> IO Result
vkGetDeviceAccelerationStructureCompatibilityKHR' = FunPtr
  (Ptr Device_T -> Ptr AccelerationStructureVersionKHR -> IO Result)
-> Ptr Device_T -> Ptr AccelerationStructureVersionKHR -> IO Result
mkVkGetDeviceAccelerationStructureCompatibilityKHR FunPtr
  (Ptr Device_T -> Ptr AccelerationStructureVersionKHR -> IO Result)
vkGetDeviceAccelerationStructureCompatibilityKHRPtr
  Ptr AccelerationStructureVersionKHR
version' <- ((Ptr AccelerationStructureVersionKHR -> IO ()) -> IO ())
-> ContT () IO (Ptr AccelerationStructureVersionKHR)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr AccelerationStructureVersionKHR -> IO ()) -> IO ())
 -> ContT () IO (Ptr AccelerationStructureVersionKHR))
-> ((Ptr AccelerationStructureVersionKHR -> IO ()) -> IO ())
-> ContT () IO (Ptr AccelerationStructureVersionKHR)
forall a b. (a -> b) -> a -> b
$ AccelerationStructureVersionKHR
-> (Ptr AccelerationStructureVersionKHR -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AccelerationStructureVersionKHR
version)
  Result
r <- IO Result -> ContT () IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT () IO Result)
-> IO Result -> ContT () IO Result
forall a b. (a -> b) -> a -> b
$ Ptr Device_T -> Ptr AccelerationStructureVersionKHR -> IO Result
vkGetDeviceAccelerationStructureCompatibilityKHR' (Device -> Ptr Device_T
deviceHandle (Device
device)) Ptr AccelerationStructureVersionKHR
version'
  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 ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCreateAccelerationStructureKHR
  :: FunPtr (Ptr Device_T -> Ptr AccelerationStructureCreateInfoKHR -> Ptr AllocationCallbacks -> Ptr AccelerationStructureKHR -> IO Result) -> Ptr Device_T -> Ptr AccelerationStructureCreateInfoKHR -> Ptr AllocationCallbacks -> Ptr AccelerationStructureKHR -> IO Result

-- | vkCreateAccelerationStructureKHR - Create a new acceleration structure
-- object
--
-- = Description
--
-- Similar to other objects in Vulkan, the acceleration structure creation
-- merely creates an object with a specific “shape”. The type and quantity
-- of geometry that can be built into an acceleration structure is
-- determined by the parameters of 'AccelerationStructureCreateInfoKHR'.
--
-- Populating the data in the object after allocating and binding memory is
-- done with commands such as 'cmdBuildAccelerationStructureKHR',
-- 'buildAccelerationStructureKHR', 'cmdCopyAccelerationStructureKHR', and
-- 'copyAccelerationStructureKHR'.
--
-- The input buffers passed to acceleration structure build commands will
-- be referenced by the implementation for the duration of the command.
-- After the command completes, the acceleration structure /may/ hold a
-- reference to any acceleration structure specified by an active instance
-- contained therein. Apart from this referencing, acceleration structures
-- /must/ be fully self-contained. The application /may/ re-use or free any
-- memory which was used by the command as an input or as scratch without
-- affecting the results of ray traversal.
--
-- == Valid Usage
--
-- -   The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-raytracing rayTracing>
--     or
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-rayQuery rayQuery>
--     feature /must/ be enabled
--
-- -   If 'AccelerationStructureCreateInfoKHR'::@deviceAddress@ is not
--     zero, the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-raytracing-ascapturereplay rayTracingAccelerationStructureCaptureReplay>
--     feature /must/ be enabled
--
-- -   If @device@ was created with multiple physical devices, then the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-bufferDeviceAddressMultiDevice bufferDeviceAddressMultiDevice>
--     feature /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   @pCreateInfo@ /must/ be a valid pointer to a valid
--     'AccelerationStructureCreateInfoKHR' structure
--
-- -   If @pAllocator@ is not @NULL@, @pAllocator@ /must/ be a valid
--     pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   @pAccelerationStructure@ /must/ be a valid pointer to a
--     'Vulkan.Extensions.Handles.AccelerationStructureKHR' handle
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Extensions.VK_KHR_buffer_device_address.ERROR_INVALID_OPAQUE_CAPTURE_ADDRESS_KHR'
--
-- = See Also
--
-- 'AccelerationStructureCreateInfoKHR',
-- 'Vulkan.Extensions.Handles.AccelerationStructureKHR',
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Device'
createAccelerationStructureKHR :: forall io
                                . (MonadIO io)
                               => -- | @device@ is the logical device that creates the buffer object.
                                  Device
                               -> -- | @pCreateInfo@ is a pointer to a 'AccelerationStructureCreateInfoKHR'
                                  -- structure containing parameters affecting creation of the acceleration
                                  -- structure.
                                  AccelerationStructureCreateInfoKHR
                               -> -- | @pAllocator@ controls host memory allocation as described in the
                                  -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                                  -- chapter.
                                  ("allocator" ::: Maybe AllocationCallbacks)
                               -> io (AccelerationStructureKHR)
createAccelerationStructureKHR :: Device
-> AccelerationStructureCreateInfoKHR
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io AccelerationStructureKHR
createAccelerationStructureKHR device :: Device
device createInfo :: AccelerationStructureCreateInfoKHR
createInfo allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO AccelerationStructureKHR -> io AccelerationStructureKHR
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AccelerationStructureKHR -> io AccelerationStructureKHR)
-> (ContT AccelerationStructureKHR IO AccelerationStructureKHR
    -> IO AccelerationStructureKHR)
-> ContT AccelerationStructureKHR IO AccelerationStructureKHR
-> io AccelerationStructureKHR
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT AccelerationStructureKHR IO AccelerationStructureKHR
-> IO AccelerationStructureKHR
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT AccelerationStructureKHR IO AccelerationStructureKHR
 -> io AccelerationStructureKHR)
-> ContT AccelerationStructureKHR IO AccelerationStructureKHR
-> io AccelerationStructureKHR
forall a b. (a -> b) -> a -> b
$ do
  let vkCreateAccelerationStructureKHRPtr :: FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr AccelerationStructureCreateInfoKHR)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
   -> IO Result)
vkCreateAccelerationStructureKHRPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pCreateInfo" ::: Ptr AccelerationStructureCreateInfoKHR)
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
      -> IO Result)
pVkCreateAccelerationStructureKHR (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  IO () -> ContT AccelerationStructureKHR IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT AccelerationStructureKHR IO ())
-> IO () -> ContT AccelerationStructureKHR IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr AccelerationStructureCreateInfoKHR)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
   -> IO Result)
vkCreateAccelerationStructureKHRPtr FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr AccelerationStructureCreateInfoKHR)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> ("pCreateInfo" ::: Ptr AccelerationStructureCreateInfoKHR)
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr AccelerationStructureCreateInfoKHR)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
   -> IO Result)
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 "" "The function pointer for vkCreateAccelerationStructureKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCreateAccelerationStructureKHR' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr AccelerationStructureCreateInfoKHR)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
-> IO Result
vkCreateAccelerationStructureKHR' = FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr AccelerationStructureCreateInfoKHR)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
   -> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr AccelerationStructureCreateInfoKHR)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
-> IO Result
mkVkCreateAccelerationStructureKHR FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr AccelerationStructureCreateInfoKHR)
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
   -> IO Result)
vkCreateAccelerationStructureKHRPtr
  "pCreateInfo" ::: Ptr AccelerationStructureCreateInfoKHR
pCreateInfo <- ((("pCreateInfo" ::: Ptr AccelerationStructureCreateInfoKHR)
  -> IO AccelerationStructureKHR)
 -> IO AccelerationStructureKHR)
-> ContT
     AccelerationStructureKHR
     IO
     ("pCreateInfo" ::: Ptr AccelerationStructureCreateInfoKHR)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pCreateInfo" ::: Ptr AccelerationStructureCreateInfoKHR)
   -> IO AccelerationStructureKHR)
  -> IO AccelerationStructureKHR)
 -> ContT
      AccelerationStructureKHR
      IO
      ("pCreateInfo" ::: Ptr AccelerationStructureCreateInfoKHR))
-> ((("pCreateInfo" ::: Ptr AccelerationStructureCreateInfoKHR)
     -> IO AccelerationStructureKHR)
    -> IO AccelerationStructureKHR)
-> ContT
     AccelerationStructureKHR
     IO
     ("pCreateInfo" ::: Ptr AccelerationStructureCreateInfoKHR)
forall a b. (a -> b) -> a -> b
$ AccelerationStructureCreateInfoKHR
-> (("pCreateInfo" ::: Ptr AccelerationStructureCreateInfoKHR)
    -> IO AccelerationStructureKHR)
-> IO AccelerationStructureKHR
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AccelerationStructureCreateInfoKHR
createInfo)
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT
     AccelerationStructureKHR
     IO
     ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks)
  -> IO AccelerationStructureKHR)
 -> IO AccelerationStructureKHR)
-> ContT
     AccelerationStructureKHR
     IO
     ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks)
   -> IO AccelerationStructureKHR)
  -> IO AccelerationStructureKHR)
 -> ContT
      AccelerationStructureKHR
      IO
      ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks)
     -> IO AccelerationStructureKHR)
    -> IO AccelerationStructureKHR)
-> ContT
     AccelerationStructureKHR
     IO
     ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks)
    -> IO AccelerationStructureKHR)
-> IO AccelerationStructureKHR
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  "pAccelerationStructures" ::: Ptr AccelerationStructureKHR
pPAccelerationStructure <- ((("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
  -> IO AccelerationStructureKHR)
 -> IO AccelerationStructureKHR)
-> ContT
     AccelerationStructureKHR
     IO
     ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
   -> IO AccelerationStructureKHR)
  -> IO AccelerationStructureKHR)
 -> ContT
      AccelerationStructureKHR
      IO
      ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR))
-> ((("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
     -> IO AccelerationStructureKHR)
    -> IO AccelerationStructureKHR)
-> ContT
     AccelerationStructureKHR
     IO
     ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
forall a b. (a -> b) -> a -> b
$ IO ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
-> (("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
    -> IO ())
-> (("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
    -> IO AccelerationStructureKHR)
-> IO AccelerationStructureKHR
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int
-> IO ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
forall a. Int -> IO (Ptr a)
callocBytes @AccelerationStructureKHR 8) ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
-> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT AccelerationStructureKHR IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT AccelerationStructureKHR IO Result)
-> IO Result -> ContT AccelerationStructureKHR IO Result
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> ("pCreateInfo" ::: Ptr AccelerationStructureCreateInfoKHR)
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
-> IO Result
vkCreateAccelerationStructureKHR' (Device -> Ptr Device_T
deviceHandle (Device
device)) "pCreateInfo" ::: Ptr AccelerationStructureCreateInfoKHR
pCreateInfo "pAllocator" ::: Ptr AllocationCallbacks
pAllocator ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR
pPAccelerationStructure)
  IO () -> ContT AccelerationStructureKHR IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT AccelerationStructureKHR IO ())
-> IO () -> ContT AccelerationStructureKHR IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  AccelerationStructureKHR
pAccelerationStructure <- IO AccelerationStructureKHR
-> ContT AccelerationStructureKHR IO AccelerationStructureKHR
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO AccelerationStructureKHR
 -> ContT AccelerationStructureKHR IO AccelerationStructureKHR)
-> IO AccelerationStructureKHR
-> ContT AccelerationStructureKHR IO AccelerationStructureKHR
forall a b. (a -> b) -> a -> b
$ ("pAccelerationStructures" ::: Ptr AccelerationStructureKHR)
-> IO AccelerationStructureKHR
forall a. Storable a => Ptr a -> IO a
peek @AccelerationStructureKHR "pAccelerationStructures" ::: Ptr AccelerationStructureKHR
pPAccelerationStructure
  AccelerationStructureKHR
-> ContT AccelerationStructureKHR IO AccelerationStructureKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AccelerationStructureKHR
 -> ContT AccelerationStructureKHR IO AccelerationStructureKHR)
-> AccelerationStructureKHR
-> ContT AccelerationStructureKHR IO AccelerationStructureKHR
forall a b. (a -> b) -> a -> b
$ (AccelerationStructureKHR
pAccelerationStructure)

-- | A convenience wrapper to make a compatible pair of calls to
-- 'createAccelerationStructureKHR' and 'destroyAccelerationStructureKHR'
--
-- To ensure that 'destroyAccelerationStructureKHR' is always called: pass
-- 'Control.Exception.bracket' (or the allocate function from your
-- favourite resource management library) as the first argument.
-- To just extract the pair pass '(,)' as the first argument.
--
withAccelerationStructureKHR :: forall io r . MonadIO io => Device -> AccelerationStructureCreateInfoKHR -> Maybe AllocationCallbacks -> (io (AccelerationStructureKHR) -> ((AccelerationStructureKHR) -> io ()) -> r) -> r
withAccelerationStructureKHR :: Device
-> AccelerationStructureCreateInfoKHR
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io AccelerationStructureKHR
    -> (AccelerationStructureKHR -> io ()) -> r)
-> r
withAccelerationStructureKHR device :: Device
device pCreateInfo :: AccelerationStructureCreateInfoKHR
pCreateInfo pAllocator :: "allocator" ::: Maybe AllocationCallbacks
pAllocator b :: io AccelerationStructureKHR
-> (AccelerationStructureKHR -> io ()) -> r
b =
  io AccelerationStructureKHR
-> (AccelerationStructureKHR -> io ()) -> r
b (Device
-> AccelerationStructureCreateInfoKHR
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io AccelerationStructureKHR
forall (io :: * -> *).
MonadIO io =>
Device
-> AccelerationStructureCreateInfoKHR
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io AccelerationStructureKHR
createAccelerationStructureKHR Device
device AccelerationStructureCreateInfoKHR
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
    (\(AccelerationStructureKHR
o0) -> Device
-> AccelerationStructureKHR
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
forall (io :: * -> *).
MonadIO io =>
Device
-> AccelerationStructureKHR
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyAccelerationStructureKHR Device
device AccelerationStructureKHR
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdBuildAccelerationStructureKHR
  :: FunPtr (Ptr CommandBuffer_T -> Word32 -> Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR) -> Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR) -> IO ()) -> Ptr CommandBuffer_T -> Word32 -> Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR) -> Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR) -> IO ()

-- | vkCmdBuildAccelerationStructureKHR - Build an acceleration structure
--
-- = Description
--
-- The 'cmdBuildAccelerationStructureKHR' command provides the ability to
-- initiate multiple acceleration structures builds, however there is no
-- ordering or synchronization implied between any of the individual
-- acceleration structure builds.
--
-- Note
--
-- This means that an application /cannot/ build a top-level acceleration
-- structure in the same 'cmdBuildAccelerationStructureKHR' call as the
-- associated bottom-level or instance acceleration structures are being
-- built. There also /cannot/ be any memory aliasing between any
-- acceleration structure memories or scratch memories being used by any of
-- the builds.
--
-- Accesses to the acceleration structure scratch buffers as identified by
-- the 'AccelerationStructureBuildGeometryInfoKHR'→@scratchData@ buffer
-- device addresses /must/ be
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-dependencies synchronized>
-- with the
-- 'Vulkan.Core10.Enums.PipelineStageFlagBits.PIPELINE_STAGE_ACCELERATION_STRUCTURE_BUILD_BIT_KHR'
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-pipeline-stages pipeline stage>
-- and an
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-access-types access type>
-- of
-- 'Vulkan.Core10.Enums.AccessFlagBits.ACCESS_ACCELERATION_STRUCTURE_READ_BIT_KHR'
-- or
-- 'Vulkan.Core10.Enums.AccessFlagBits.ACCESS_ACCELERATION_STRUCTURE_WRITE_BIT_KHR'.
--
-- == Valid Usage
--
-- -   Each element of @ppOffsetInfos@[i] /must/ be a valid pointer to an
--     array of @pInfos@[i].@geometryCount@
--     'AccelerationStructureBuildOffsetInfoKHR' structures
--
-- -   Each @pInfos@[i].@srcAccelerationStructure@ /must/ not refer to the
--     same acceleration structure as any
--     @pInfos@[i].@dstAccelerationStructure@ that is provided to the same
--     build command unless it is identical for an update
--
-- -   For each @pInfos@[i], @dstAccelerationStructure@ /must/ have been
--     created with compatible 'AccelerationStructureCreateInfoKHR' where
--     'AccelerationStructureCreateInfoKHR'::@type@ and
--     'AccelerationStructureCreateInfoKHR'::@flags@ are identical to
--     'AccelerationStructureBuildGeometryInfoKHR'::@type@ and
--     'AccelerationStructureBuildGeometryInfoKHR'::@flags@ respectively,
--     'AccelerationStructureBuildGeometryInfoKHR'::@geometryCount@ for
--     @dstAccelerationStructure@ are greater than or equal to the build
--     size, and each geometry in
--     'AccelerationStructureBuildGeometryInfoKHR'::@ppGeometries@ for
--     @dstAccelerationStructure@ has greater than or equal to the number
--     of vertices, indices, and AABBs,
--     'AccelerationStructureGeometryTrianglesDataKHR'::@transformData@ is
--     both 0 or both non-zero, and all other parameters are the same
--
-- -   For each @pInfos@[i], if @update@ is
--     'Vulkan.Core10.FundamentalTypes.TRUE', then objects that were
--     previously active for that acceleration structure /must/ not be made
--     inactive as per
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#acceleration-structure-inactive-prims ???>
--
-- -   For each @pInfos@[i], if @update@ is
--     'Vulkan.Core10.FundamentalTypes.TRUE', then objects that were
--     previously inactive for that acceleration structure /must/ not be
--     made active as per
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#acceleration-structure-inactive-prims ???>
--
-- -   Any acceleration structure instance in any top level build in this
--     command /must/ not reference any bottom level acceleration structure
--     built by this command
--
-- -   There /must/ not be any
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-memory-aliasing memory aliasing>
--     between the scratch memories that are provided in all the
--     @pInfos@[i].@scratchData@ memories for the acceleration structure
--     builds
--
-- -   There /must/ not be any
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-memory-aliasing memory aliasing>
--     between memory bound to any top level, bottom level, or instance
--     acceleration structure accessed by this command
--
-- -   If @update@ is 'Vulkan.Core10.FundamentalTypes.FALSE', all addresses
--     between @pInfos@[i].@scratchData@ and @pInfos@[i].@scratchData@ + N
--     - 1 /must/ be in the buffer device address range of the same buffer,
--     where N is given by the @size@ member of the
--     'Vulkan.Core10.MemoryManagement.MemoryRequirements' structure
--     returned from a call to
--     'getAccelerationStructureMemoryRequirementsKHR' with
--     'AccelerationStructureMemoryRequirementsInfoKHR'::@accelerationStructure@
--     set to @pInfos@[i].@dstAccelerationStructure@ and
--     'AccelerationStructureMemoryRequirementsInfoKHR'::@type@ set to
--     'ACCELERATION_STRUCTURE_MEMORY_REQUIREMENTS_TYPE_BUILD_SCRATCH_KHR'
--
-- -   If @update@ is 'Vulkan.Core10.FundamentalTypes.TRUE', all addresses
--     between @pInfos@[i].@scratchData@ and @pInfos@[i].@scratchData@ + N
--     - 1 /must/ be in the buffer device address range of the same buffer,
--     where N is given by the @size@ member of the
--     'Vulkan.Core10.MemoryManagement.MemoryRequirements' structure
--     returned from a call to
--     'getAccelerationStructureMemoryRequirementsKHR' with
--     'AccelerationStructureMemoryRequirementsInfoKHR'::@accelerationStructure@
--     set to @pInfos@[i].@dstAccelerationStructure@ and
--     'AccelerationStructureMemoryRequirementsInfoKHR'::@type@ set to
--     'ACCELERATION_STRUCTURE_MEMORY_REQUIREMENTS_TYPE_UPDATE_SCRATCH_KHR'
--
-- -   The buffer from which the buffer device address
--     @pInfos@[i].@scratchData@ is queried /must/ have been created with
--     'Vulkan.Core10.Enums.BufferUsageFlagBits.BUFFER_USAGE_RAY_TRACING_BIT_KHR'
--     usage flag
--
-- -   All 'DeviceOrHostAddressKHR' or 'DeviceOrHostAddressConstKHR'
--     referenced by this command /must/ contain valid device addresses for
--     a buffer bound to device memory. If the buffer is non-sparse then it
--     /must/ be bound completely and contiguously to a single
--     VkDeviceMemory object
--
-- -   All 'Vulkan.Extensions.Handles.AccelerationStructureKHR' objects
--     referenced by this command /must/ be bound to device memory
--
-- -   The
--     'Vulkan.Extensions.VK_KHR_deferred_host_operations.DeferredOperationInfoKHR'
--     structure /must/ not be included in the @pNext@ chain of any of the
--     provided 'AccelerationStructureBuildGeometryInfoKHR' structures
--
-- == Valid Usage (Implicit)
--
-- -   @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   @pInfos@ /must/ be a valid pointer to an array of @infoCount@ valid
--     'AccelerationStructureBuildGeometryInfoKHR' structures
--
-- -   @ppOffsetInfos@ /must/ be a valid pointer to an array of @infoCount@
--     'AccelerationStructureBuildOffsetInfoKHR' structures
--
-- -   @commandBuffer@ /must/ be in the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#commandbuffers-lifecycle recording state>
--
-- -   The 'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support compute operations
--
-- -   This command /must/ only be called outside of a render pass instance
--
-- -   @infoCount@ /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> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-pipeline-stages-types Pipeline Type> |
-- +============================================================================================================================+========================================================================================================================+=======================================================================================================================+=====================================================================================================================================+
-- | Primary                                                                                                                    | Outside                                                                                                                | Compute                                                                                                               |                                                                                                                                     |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                       |                                                                                                                                     |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+-------------------------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- 'AccelerationStructureBuildGeometryInfoKHR',
-- 'AccelerationStructureBuildOffsetInfoKHR',
-- 'Vulkan.Core10.Handles.CommandBuffer'
cmdBuildAccelerationStructureKHR :: forall io
                                  . (MonadIO io)
                                 => -- | @commandBuffer@ is the command buffer into which the command will be
                                    -- recorded.
                                    CommandBuffer
                                 -> -- | @pInfos@ is an array of @infoCount@
                                    -- 'AccelerationStructureBuildGeometryInfoKHR' structures defining the
                                    -- geometry used to build each acceleration structure.
                                    ("infos" ::: Vector (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
                                 -> -- | @ppOffsetInfos@ is an array of @infoCount@ pointers to arrays of
                                    -- 'AccelerationStructureBuildOffsetInfoKHR' structures. Each
                                    -- @ppOffsetInfos@[i] is an array of @pInfos@[i].@geometryCount@
                                    -- 'AccelerationStructureBuildOffsetInfoKHR' structures defining dynamic
                                    -- offsets to the addresses where geometry data is stored, as defined by
                                    -- @pInfos@[i].
                                    ("offsetInfos" ::: Vector AccelerationStructureBuildOffsetInfoKHR)
                                 -> io ()
cmdBuildAccelerationStructureKHR :: CommandBuffer
-> ("infos"
    ::: Vector (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
-> ("offsetInfos"
    ::: Vector AccelerationStructureBuildOffsetInfoKHR)
-> io ()
cmdBuildAccelerationStructureKHR commandBuffer :: CommandBuffer
commandBuffer infos :: "infos"
::: Vector (SomeStruct AccelerationStructureBuildGeometryInfoKHR)
infos offsetInfos :: "offsetInfos" ::: Vector AccelerationStructureBuildOffsetInfoKHR
offsetInfos = 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 vkCmdBuildAccelerationStructureKHRPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pInfos"
       ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
   -> ("ppOffsetInfos"
       ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
   -> IO ())
vkCmdBuildAccelerationStructureKHRPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("bindInfoCount" ::: Word32)
      -> ("pInfos"
          ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
      -> ("ppOffsetInfos"
          ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
      -> IO ())
pVkCmdBuildAccelerationStructureKHR (CommandBuffer -> DeviceCmds
deviceCmds (CommandBuffer
commandBuffer :: CommandBuffer))
  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
   -> ("bindInfoCount" ::: Word32)
   -> ("pInfos"
       ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
   -> ("ppOffsetInfos"
       ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
   -> IO ())
vkCmdBuildAccelerationStructureKHRPtr FunPtr
  (Ptr CommandBuffer_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pInfos"
       ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
   -> ("ppOffsetInfos"
       ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("bindInfoCount" ::: Word32)
      -> ("pInfos"
          ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
      -> ("ppOffsetInfos"
          ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pInfos"
       ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
   -> ("ppOffsetInfos"
       ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
   -> 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 "" "The function pointer for vkCmdBuildAccelerationStructureKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdBuildAccelerationStructureKHR' :: Ptr CommandBuffer_T
-> ("bindInfoCount" ::: Word32)
-> ("pInfos"
    ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
-> ("ppOffsetInfos"
    ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
-> IO ()
vkCmdBuildAccelerationStructureKHR' = FunPtr
  (Ptr CommandBuffer_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pInfos"
       ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
   -> ("ppOffsetInfos"
       ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
   -> IO ())
-> Ptr CommandBuffer_T
-> ("bindInfoCount" ::: Word32)
-> ("pInfos"
    ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
-> ("ppOffsetInfos"
    ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
-> IO ()
mkVkCmdBuildAccelerationStructureKHR FunPtr
  (Ptr CommandBuffer_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pInfos"
       ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
   -> ("ppOffsetInfos"
       ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
   -> IO ())
vkCmdBuildAccelerationStructureKHRPtr
  let pInfosLength :: Int
pInfosLength = ("infos"
 ::: Vector (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
-> Int
forall a. Vector a -> Int
Data.Vector.length (("infos"
  ::: Vector (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
 -> Int)
-> ("infos"
    ::: Vector (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
-> Int
forall a b. (a -> b) -> a -> b
$ ("infos"
::: Vector (SomeStruct AccelerationStructureBuildGeometryInfoKHR)
infos)
  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 ((("offsetInfos" ::: Vector AccelerationStructureBuildOffsetInfoKHR)
-> Int
forall a. Vector a -> Int
Data.Vector.length (("offsetInfos" ::: Vector AccelerationStructureBuildOffsetInfoKHR)
 -> Int)
-> ("offsetInfos"
    ::: Vector AccelerationStructureBuildOffsetInfoKHR)
-> Int
forall a b. (a -> b) -> a -> b
$ ("offsetInfos" ::: Vector AccelerationStructureBuildOffsetInfoKHR
offsetInfos)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
pInfosLength) (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 "" "ppOffsetInfos and pInfos must have the same length" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  Ptr (AccelerationStructureBuildGeometryInfoKHR Any)
pPInfos <- ((Ptr (AccelerationStructureBuildGeometryInfoKHR Any) -> IO ())
 -> IO ())
-> ContT
     () IO (Ptr (AccelerationStructureBuildGeometryInfoKHR Any))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (AccelerationStructureBuildGeometryInfoKHR Any) -> IO ())
  -> IO ())
 -> ContT
      () IO (Ptr (AccelerationStructureBuildGeometryInfoKHR Any)))
-> ((Ptr (AccelerationStructureBuildGeometryInfoKHR Any) -> IO ())
    -> IO ())
-> ContT
     () IO (Ptr (AccelerationStructureBuildGeometryInfoKHR Any))
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> (Ptr (AccelerationStructureBuildGeometryInfoKHR Any) -> IO ())
-> IO ()
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @(AccelerationStructureBuildGeometryInfoKHR _) ((("infos"
 ::: Vector (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
-> Int
forall a. Vector a -> Int
Data.Vector.length ("infos"
::: Vector (SomeStruct AccelerationStructureBuildGeometryInfoKHR)
infos)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 72) 8
  (Int
 -> SomeStruct AccelerationStructureBuildGeometryInfoKHR
 -> ContT () IO ())
-> ("infos"
    ::: Vector (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
-> ContT () IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: SomeStruct AccelerationStructureBuildGeometryInfoKHR
e -> ((() -> IO ()) -> IO ()) -> ContT () IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO ()) -> IO ()) -> ContT () IO ())
-> ((() -> IO ()) -> IO ()) -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ("pInfos"
 ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
-> SomeStruct AccelerationStructureBuildGeometryInfoKHR
-> IO ()
-> IO ()
forall (a :: [*] -> *) b.
(forall (es :: [*]).
 (Extendss a es, PokeChain es) =>
 ToCStruct (a es)) =>
Ptr (SomeStruct a) -> SomeStruct a -> IO b -> IO b
pokeSomeCStruct (Ptr (AccelerationStructureBuildGeometryInfoKHR Any)
-> "pInfos"
   ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (AccelerationStructureBuildGeometryInfoKHR Any)
pPInfos Ptr (AccelerationStructureBuildGeometryInfoKHR Any)
-> Int -> Ptr (AccelerationStructureBuildGeometryInfoKHR _)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (72 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (AccelerationStructureBuildGeometryInfoKHR _))) (SomeStruct AccelerationStructureBuildGeometryInfoKHR
e) (IO () -> IO ())
-> ((() -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ ())) ("infos"
::: Vector (SomeStruct AccelerationStructureBuildGeometryInfoKHR)
infos)
  "ppOffsetInfos"
::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR)
pPpOffsetInfos <- ((("ppOffsetInfos"
   ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
  -> IO ())
 -> IO ())
-> ContT
     ()
     IO
     ("ppOffsetInfos"
      ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("ppOffsetInfos"
    ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
   -> IO ())
  -> IO ())
 -> ContT
      ()
      IO
      ("ppOffsetInfos"
       ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR)))
-> ((("ppOffsetInfos"
      ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
     -> IO ())
    -> IO ())
-> ContT
     ()
     IO
     ("ppOffsetInfos"
      ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> (("ppOffsetInfos"
     ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
    -> IO ())
-> IO ()
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @(Ptr AccelerationStructureBuildOffsetInfoKHR) ((("offsetInfos" ::: Vector AccelerationStructureBuildOffsetInfoKHR)
-> Int
forall a. Vector a -> Int
Data.Vector.length ("offsetInfos" ::: Vector AccelerationStructureBuildOffsetInfoKHR
offsetInfos)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 8
  (Int -> AccelerationStructureBuildOffsetInfoKHR -> ContT () IO ())
-> ("offsetInfos"
    ::: Vector AccelerationStructureBuildOffsetInfoKHR)
-> ContT () IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: AccelerationStructureBuildOffsetInfoKHR
e -> do
    Ptr AccelerationStructureBuildOffsetInfoKHR
ppOffsetInfos <- ((Ptr AccelerationStructureBuildOffsetInfoKHR -> IO ()) -> IO ())
-> ContT () IO (Ptr AccelerationStructureBuildOffsetInfoKHR)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr AccelerationStructureBuildOffsetInfoKHR -> IO ()) -> IO ())
 -> ContT () IO (Ptr AccelerationStructureBuildOffsetInfoKHR))
-> ((Ptr AccelerationStructureBuildOffsetInfoKHR -> IO ())
    -> IO ())
-> ContT () IO (Ptr AccelerationStructureBuildOffsetInfoKHR)
forall a b. (a -> b) -> a -> b
$ AccelerationStructureBuildOffsetInfoKHR
-> (Ptr AccelerationStructureBuildOffsetInfoKHR -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AccelerationStructureBuildOffsetInfoKHR
e)
    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
$ ("ppOffsetInfos"
 ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
-> Ptr AccelerationStructureBuildOffsetInfoKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ("ppOffsetInfos"
::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR)
pPpOffsetInfos ("ppOffsetInfos"
 ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
-> Int
-> "ppOffsetInfos"
   ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR)) Ptr AccelerationStructureBuildOffsetInfoKHR
ppOffsetInfos) ("offsetInfos" ::: Vector AccelerationStructureBuildOffsetInfoKHR
offsetInfos)
  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
$ Ptr CommandBuffer_T
-> ("bindInfoCount" ::: Word32)
-> ("pInfos"
    ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
-> ("ppOffsetInfos"
    ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
-> IO ()
vkCmdBuildAccelerationStructureKHR' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) ((Int -> "bindInfoCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pInfosLength :: Word32)) (Ptr (AccelerationStructureBuildGeometryInfoKHR Any)
-> "pInfos"
   ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (AccelerationStructureBuildGeometryInfoKHR Any)
pPInfos)) ("ppOffsetInfos"
::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR)
pPpOffsetInfos)
  () -> 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" mkVkCmdBuildAccelerationStructureIndirectKHR
  :: FunPtr (Ptr CommandBuffer_T -> Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR) -> Buffer -> DeviceSize -> Word32 -> IO ()) -> Ptr CommandBuffer_T -> Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR) -> Buffer -> DeviceSize -> Word32 -> IO ()

-- | vkCmdBuildAccelerationStructureIndirectKHR - Build an acceleration
-- structure with some parameters provided on the device
--
-- == Valid Usage
--
-- -   All 'DeviceOrHostAddressKHR' or 'DeviceOrHostAddressConstKHR'
--     referenced by this command /must/ contain valid device addresses for
--     a buffer bound to device memory. If the buffer is non-sparse then it
--     /must/ be bound completely and contiguously to a single
--     VkDeviceMemory object
--
-- -   All 'Vulkan.Extensions.Handles.AccelerationStructureKHR' objects
--     referenced by this command /must/ be bound to device memory
--
-- -   The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-raytracing-indirectasbuild ::rayTracingIndirectAccelerationStructureBuild>
--     feature /must/ be enabled
--
-- -   The
--     'Vulkan.Extensions.VK_KHR_deferred_host_operations.DeferredOperationInfoKHR'
--     structure /must/ not be included in the @pNext@ chain of any of the
--     provided 'AccelerationStructureBuildGeometryInfoKHR' structures
--
-- == Valid Usage (Implicit)
--
-- -   @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   @pInfo@ /must/ be a valid pointer to a valid
--     'AccelerationStructureBuildGeometryInfoKHR' structure
--
-- -   @indirectBuffer@ /must/ be a valid 'Vulkan.Core10.Handles.Buffer'
--     handle
--
-- -   @commandBuffer@ /must/ be in the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#commandbuffers-lifecycle recording state>
--
-- -   The 'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support compute operations
--
-- -   This command /must/ only be called outside of a render pass instance
--
-- -   Both of @commandBuffer@, and @indirectBuffer@ /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> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-pipeline-stages-types Pipeline Type> |
-- +============================================================================================================================+========================================================================================================================+=======================================================================================================================+=====================================================================================================================================+
-- | Primary                                                                                                                    | Outside                                                                                                                | Compute                                                                                                               |                                                                                                                                     |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                       |                                                                                                                                     |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+-------------------------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- 'AccelerationStructureBuildGeometryInfoKHR',
-- 'Vulkan.Core10.Handles.Buffer', 'Vulkan.Core10.Handles.CommandBuffer',
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize'
cmdBuildAccelerationStructureIndirectKHR :: forall a io
                                          . (Extendss AccelerationStructureBuildGeometryInfoKHR a, PokeChain a, MonadIO io)
                                         => -- | @commandBuffer@ is the command buffer into which the command will be
                                            -- recorded.
                                            CommandBuffer
                                         -> -- | @pInfo@ is a pointer to a 'AccelerationStructureBuildGeometryInfoKHR'
                                            -- structure defining the geometry used to build the acceleration
                                            -- structure.
                                            (AccelerationStructureBuildGeometryInfoKHR a)
                                         -> -- | @indirectBuffer@ is the 'Vulkan.Core10.Handles.Buffer' containing
                                            -- @pInfo->geometryCount@ 'AccelerationStructureBuildOffsetInfoKHR'
                                            -- structures defining dynamic offsets to the addresses where geometry data
                                            -- is stored, as defined by @pInfo@.
                                            ("indirectBuffer" ::: Buffer)
                                         -> -- | @indirectOffset@ is the byte offset into @indirectBuffer@ where offset
                                            -- parameters begin.
                                            ("indirectOffset" ::: DeviceSize)
                                         -> -- No documentation found for Nested "vkCmdBuildAccelerationStructureIndirectKHR" "indirectStride"
                                            ("indirectStride" ::: Word32)
                                         -> io ()
cmdBuildAccelerationStructureIndirectKHR :: CommandBuffer
-> AccelerationStructureBuildGeometryInfoKHR a
-> Buffer
-> ("dataSize" ::: Word64)
-> ("bindInfoCount" ::: Word32)
-> io ()
cmdBuildAccelerationStructureIndirectKHR commandBuffer :: CommandBuffer
commandBuffer info :: AccelerationStructureBuildGeometryInfoKHR a
info indirectBuffer :: Buffer
indirectBuffer indirectOffset :: "dataSize" ::: Word64
indirectOffset indirectStride :: "bindInfoCount" ::: Word32
indirectStride = 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 vkCmdBuildAccelerationStructureIndirectKHRPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("pInfos"
       ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
   -> Buffer
   -> ("dataSize" ::: Word64)
   -> ("bindInfoCount" ::: Word32)
   -> IO ())
vkCmdBuildAccelerationStructureIndirectKHRPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pInfos"
          ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
      -> Buffer
      -> ("dataSize" ::: Word64)
      -> ("bindInfoCount" ::: Word32)
      -> IO ())
pVkCmdBuildAccelerationStructureIndirectKHR (CommandBuffer -> DeviceCmds
deviceCmds (CommandBuffer
commandBuffer :: CommandBuffer))
  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
   -> ("pInfos"
       ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
   -> Buffer
   -> ("dataSize" ::: Word64)
   -> ("bindInfoCount" ::: Word32)
   -> IO ())
vkCmdBuildAccelerationStructureIndirectKHRPtr FunPtr
  (Ptr CommandBuffer_T
   -> ("pInfos"
       ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
   -> Buffer
   -> ("dataSize" ::: Word64)
   -> ("bindInfoCount" ::: Word32)
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pInfos"
          ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
      -> Buffer
      -> ("dataSize" ::: Word64)
      -> ("bindInfoCount" ::: Word32)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("pInfos"
       ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
   -> Buffer
   -> ("dataSize" ::: Word64)
   -> ("bindInfoCount" ::: Word32)
   -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkCmdBuildAccelerationStructureIndirectKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdBuildAccelerationStructureIndirectKHR' :: Ptr CommandBuffer_T
-> ("pInfos"
    ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
-> Buffer
-> ("dataSize" ::: Word64)
-> ("bindInfoCount" ::: Word32)
-> IO ()
vkCmdBuildAccelerationStructureIndirectKHR' = FunPtr
  (Ptr CommandBuffer_T
   -> ("pInfos"
       ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
   -> Buffer
   -> ("dataSize" ::: Word64)
   -> ("bindInfoCount" ::: Word32)
   -> IO ())
-> Ptr CommandBuffer_T
-> ("pInfos"
    ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
-> Buffer
-> ("dataSize" ::: Word64)
-> ("bindInfoCount" ::: Word32)
-> IO ()
mkVkCmdBuildAccelerationStructureIndirectKHR FunPtr
  (Ptr CommandBuffer_T
   -> ("pInfos"
       ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
   -> Buffer
   -> ("dataSize" ::: Word64)
   -> ("bindInfoCount" ::: Word32)
   -> IO ())
vkCmdBuildAccelerationStructureIndirectKHRPtr
  Ptr (AccelerationStructureBuildGeometryInfoKHR a)
pInfo <- ((Ptr (AccelerationStructureBuildGeometryInfoKHR a) -> IO ())
 -> IO ())
-> ContT () IO (Ptr (AccelerationStructureBuildGeometryInfoKHR a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (AccelerationStructureBuildGeometryInfoKHR a) -> IO ())
  -> IO ())
 -> ContT () IO (Ptr (AccelerationStructureBuildGeometryInfoKHR a)))
-> ((Ptr (AccelerationStructureBuildGeometryInfoKHR a) -> IO ())
    -> IO ())
-> ContT () IO (Ptr (AccelerationStructureBuildGeometryInfoKHR a))
forall a b. (a -> b) -> a -> b
$ AccelerationStructureBuildGeometryInfoKHR a
-> (Ptr (AccelerationStructureBuildGeometryInfoKHR a) -> IO ())
-> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AccelerationStructureBuildGeometryInfoKHR a
info)
  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
$ Ptr CommandBuffer_T
-> ("pInfos"
    ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
-> Buffer
-> ("dataSize" ::: Word64)
-> ("bindInfoCount" ::: Word32)
-> IO ()
vkCmdBuildAccelerationStructureIndirectKHR' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) (Ptr (AccelerationStructureBuildGeometryInfoKHR a)
-> "pInfos"
   ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (AccelerationStructureBuildGeometryInfoKHR a)
pInfo) (Buffer
indirectBuffer) ("dataSize" ::: Word64
indirectOffset) ("bindInfoCount" ::: Word32
indirectStride)
  () -> 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" mkVkBuildAccelerationStructureKHR
  :: FunPtr (Ptr Device_T -> Word32 -> Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR) -> Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR) -> IO Result) -> Ptr Device_T -> Word32 -> Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR) -> Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR) -> IO Result

-- | vkBuildAccelerationStructureKHR - Build an acceleration structure on the
-- host
--
-- = Parameters
--
-- This command fulfills the same task as
-- 'cmdBuildAccelerationStructureKHR' but executed by the host.
--
-- = Description
--
-- -   @device@ is the 'Vulkan.Core10.Handles.Device' for which the
--     acceleration structures are being built.
--
-- -   @infoCount@ is the number of acceleration structures to build. It
--     specifies the number of the @pInfos@ structures and @ppOffsetInfos@
--     pointers that /must/ be provided.
--
-- -   @pInfos@ is a pointer to an array of @infoCount@
--     'AccelerationStructureBuildGeometryInfoKHR' structures defining the
--     geometry used to build each acceleration structure.
--
-- -   @ppOffsetInfos@ is an array of @infoCount@ pointers to arrays of
--     'AccelerationStructureBuildOffsetInfoKHR' structures. Each
--     @ppOffsetInfos@[i] is an array of @pInfos@[i].@geometryCount@
--     'AccelerationStructureBuildOffsetInfoKHR' structures defining
--     dynamic offsets to the addresses where geometry data is stored, as
--     defined by @pInfos@[i].
--
-- The 'buildAccelerationStructureKHR' command provides the ability to
-- initiate multiple acceleration structures builds, however there is no
-- ordering or synchronization implied between any of the individual
-- acceleration structure builds.
--
-- Note
--
-- This means that an application /cannot/ build a top-level acceleration
-- structure in the same 'buildAccelerationStructureKHR' call as the
-- associated bottom-level or instance acceleration structures are being
-- built. There also /cannot/ be any memory aliasing between any
-- acceleration structure memories or scratch memories being used by any of
-- the builds.
--
-- If the
-- 'Vulkan.Extensions.VK_KHR_deferred_host_operations.DeferredOperationInfoKHR'
-- structure is included in the @pNext@ chain of any
-- 'AccelerationStructureBuildGeometryInfoKHR' structure, the operation of
-- this command is /deferred/, as defined in the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#deferred-host-operations Deferred Host Operations>
-- chapter.
--
-- == Valid Usage
--
-- -   Each element of @ppOffsetInfos@[i] /must/ be a valid pointer to an
--     array of @pInfos@[i].@geometryCount@
--     'AccelerationStructureBuildOffsetInfoKHR' structures
--
-- -   Each @pInfos@[i].@srcAccelerationStructure@ /must/ not refer to the
--     same acceleration structure as any
--     @pInfos@[i].@dstAccelerationStructure@ that is provided to the same
--     build command unless it is identical for an update
--
-- -   For each @pInfos@[i], @dstAccelerationStructure@ /must/ have been
--     created with compatible 'AccelerationStructureCreateInfoKHR' where
--     'AccelerationStructureCreateInfoKHR'::@type@ and
--     'AccelerationStructureCreateInfoKHR'::@flags@ are identical to
--     'AccelerationStructureBuildGeometryInfoKHR'::@type@ and
--     'AccelerationStructureBuildGeometryInfoKHR'::@flags@ respectively,
--     'AccelerationStructureBuildGeometryInfoKHR'::@geometryCount@ for
--     @dstAccelerationStructure@ are greater than or equal to the build
--     size, and each geometry in
--     'AccelerationStructureBuildGeometryInfoKHR'::@ppGeometries@ for
--     @dstAccelerationStructure@ has greater than or equal to the number
--     of vertices, indices, and AABBs,
--     'AccelerationStructureGeometryTrianglesDataKHR'::@transformData@ is
--     both 0 or both non-zero, and all other parameters are the same
--
-- -   For each @pInfos@[i], if @update@ is
--     'Vulkan.Core10.FundamentalTypes.TRUE', then objects that were
--     previously active for that acceleration structure /must/ not be made
--     inactive as per
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#acceleration-structure-inactive-prims ???>
--
-- -   For each @pInfos@[i], if @update@ is
--     'Vulkan.Core10.FundamentalTypes.TRUE', then objects that were
--     previously inactive for that acceleration structure /must/ not be
--     made active as per
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#acceleration-structure-inactive-prims ???>
--
-- -   Any acceleration structure instance in any top level build in this
--     command /must/ not reference any bottom level acceleration structure
--     built by this command
--
-- -   There /must/ not be any
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-memory-aliasing memory aliasing>
--     between the scratch memories that are provided in all the
--     @pInfos@[i].@scratchData@ memories for the acceleration structure
--     builds
--
-- -   There /must/ not be any
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-memory-aliasing memory aliasing>
--     between memory bound to any top level, bottom level, or instance
--     acceleration structure accessed by this command
--
-- -   All 'DeviceOrHostAddressKHR' or 'DeviceOrHostAddressConstKHR'
--     referenced by this command /must/ contain valid host addresses
--
-- -   All 'Vulkan.Extensions.Handles.AccelerationStructureKHR' objects
--     referenced by this command /must/ be bound to host-visible memory
--
-- -   The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-raytracing-hostascmds ::rayTracingHostAccelerationStructureCommands>
--     feature /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   @pInfos@ /must/ be a valid pointer to an array of @infoCount@ valid
--     'AccelerationStructureBuildGeometryInfoKHR' structures
--
-- -   @ppOffsetInfos@ /must/ be a valid pointer to an array of @infoCount@
--     'AccelerationStructureBuildOffsetInfoKHR' structures
--
-- -   @infoCount@ /must/ be greater than @0@
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
--     -   'Vulkan.Core10.Enums.Result.OPERATION_DEFERRED_KHR'
--
--     -   'Vulkan.Core10.Enums.Result.OPERATION_NOT_DEFERRED_KHR'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
-- = See Also
--
-- 'AccelerationStructureBuildGeometryInfoKHR',
-- 'AccelerationStructureBuildOffsetInfoKHR',
-- 'Vulkan.Core10.Handles.Device'
buildAccelerationStructureKHR :: forall io
                               . (MonadIO io)
                              => -- No documentation found for Nested "vkBuildAccelerationStructureKHR" "device"
                                 Device
                              -> -- No documentation found for Nested "vkBuildAccelerationStructureKHR" "pInfos"
                                 ("infos" ::: Vector (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
                              -> -- No documentation found for Nested "vkBuildAccelerationStructureKHR" "ppOffsetInfos"
                                 ("offsetInfos" ::: Vector AccelerationStructureBuildOffsetInfoKHR)
                              -> io (Result)
buildAccelerationStructureKHR :: Device
-> ("infos"
    ::: Vector (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
-> ("offsetInfos"
    ::: Vector AccelerationStructureBuildOffsetInfoKHR)
-> io Result
buildAccelerationStructureKHR device :: Device
device infos :: "infos"
::: Vector (SomeStruct AccelerationStructureBuildGeometryInfoKHR)
infos offsetInfos :: "offsetInfos" ::: Vector AccelerationStructureBuildOffsetInfoKHR
offsetInfos = IO Result -> io Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> io Result)
-> (ContT Result IO Result -> IO Result)
-> ContT Result IO Result
-> io Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Result IO Result -> IO Result
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Result IO Result -> io Result)
-> ContT Result IO Result -> io Result
forall a b. (a -> b) -> a -> b
$ do
  let vkBuildAccelerationStructureKHRPtr :: FunPtr
  (Ptr Device_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pInfos"
       ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
   -> ("ppOffsetInfos"
       ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
   -> IO Result)
vkBuildAccelerationStructureKHRPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("bindInfoCount" ::: Word32)
      -> ("pInfos"
          ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
      -> ("ppOffsetInfos"
          ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
      -> IO Result)
pVkBuildAccelerationStructureKHR (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
  IO () -> ContT Result IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Result IO ()) -> IO () -> ContT Result IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pInfos"
       ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
   -> ("ppOffsetInfos"
       ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
   -> IO Result)
vkBuildAccelerationStructureKHRPtr FunPtr
  (Ptr Device_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pInfos"
       ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
   -> ("ppOffsetInfos"
       ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> ("bindInfoCount" ::: Word32)
      -> ("pInfos"
          ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
      -> ("ppOffsetInfos"
          ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pInfos"
       ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
   -> ("ppOffsetInfos"
       ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
   -> IO Result)
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 "" "The function pointer for vkBuildAccelerationStructureKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkBuildAccelerationStructureKHR' :: Ptr Device_T
-> ("bindInfoCount" ::: Word32)
-> ("pInfos"
    ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
-> ("ppOffsetInfos"
    ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
-> IO Result
vkBuildAccelerationStructureKHR' = FunPtr
  (Ptr Device_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pInfos"
       ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
   -> ("ppOffsetInfos"
       ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
   -> IO Result)
-> Ptr Device_T
-> ("bindInfoCount" ::: Word32)
-> ("pInfos"
    ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
-> ("ppOffsetInfos"
    ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
-> IO Result
mkVkBuildAccelerationStructureKHR FunPtr
  (Ptr Device_T
   -> ("bindInfoCount" ::: Word32)
   -> ("pInfos"
       ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
   -> ("ppOffsetInfos"
       ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
   -> IO Result)
vkBuildAccelerationStructureKHRPtr
  let pInfosLength :: Int
pInfosLength = ("infos"
 ::: Vector (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
-> Int
forall a. Vector a -> Int
Data.Vector.length (("infos"
  ::: Vector (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
 -> Int)
-> ("infos"
    ::: Vector (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
-> Int
forall a b. (a -> b) -> a -> b
$ ("infos"
::: Vector (SomeStruct AccelerationStructureBuildGeometryInfoKHR)
infos)
  IO () -> ContT Result IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Result IO ()) -> IO () -> ContT Result IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((("offsetInfos" ::: Vector AccelerationStructureBuildOffsetInfoKHR)
-> Int
forall a. Vector a -> Int
Data.Vector.length (("offsetInfos" ::: Vector AccelerationStructureBuildOffsetInfoKHR)
 -> Int)
-> ("offsetInfos"
    ::: Vector AccelerationStructureBuildOffsetInfoKHR)
-> Int
forall a b. (a -> b) -> a -> b
$ ("offsetInfos" ::: Vector AccelerationStructureBuildOffsetInfoKHR
offsetInfos)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
pInfosLength) (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 "" "ppOffsetInfos and pInfos must have the same length" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  Ptr (AccelerationStructureBuildGeometryInfoKHR Any)
pPInfos <- ((Ptr (AccelerationStructureBuildGeometryInfoKHR Any) -> IO Result)
 -> IO Result)
-> ContT
     Result IO (Ptr (AccelerationStructureBuildGeometryInfoKHR Any))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (AccelerationStructureBuildGeometryInfoKHR Any)
   -> IO Result)
  -> IO Result)
 -> ContT
      Result IO (Ptr (AccelerationStructureBuildGeometryInfoKHR Any)))
-> ((Ptr (AccelerationStructureBuildGeometryInfoKHR Any)
     -> IO Result)
    -> IO Result)
-> ContT
     Result IO (Ptr (AccelerationStructureBuildGeometryInfoKHR Any))
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> (Ptr (AccelerationStructureBuildGeometryInfoKHR Any)
    -> IO Result)
-> IO Result
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @(AccelerationStructureBuildGeometryInfoKHR _) ((("infos"
 ::: Vector (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
-> Int
forall a. Vector a -> Int
Data.Vector.length ("infos"
::: Vector (SomeStruct AccelerationStructureBuildGeometryInfoKHR)
infos)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 72) 8
  (Int
 -> SomeStruct AccelerationStructureBuildGeometryInfoKHR
 -> ContT Result IO ())
-> ("infos"
    ::: Vector (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
-> ContT Result IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: SomeStruct AccelerationStructureBuildGeometryInfoKHR
e -> ((() -> IO Result) -> IO Result) -> ContT Result IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO Result) -> IO Result) -> ContT Result IO ())
-> ((() -> IO Result) -> IO Result) -> ContT Result IO ()
forall a b. (a -> b) -> a -> b
$ ("pInfos"
 ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
-> SomeStruct AccelerationStructureBuildGeometryInfoKHR
-> IO Result
-> IO Result
forall (a :: [*] -> *) b.
(forall (es :: [*]).
 (Extendss a es, PokeChain es) =>
 ToCStruct (a es)) =>
Ptr (SomeStruct a) -> SomeStruct a -> IO b -> IO b
pokeSomeCStruct (Ptr (AccelerationStructureBuildGeometryInfoKHR Any)
-> "pInfos"
   ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (AccelerationStructureBuildGeometryInfoKHR Any)
pPInfos Ptr (AccelerationStructureBuildGeometryInfoKHR Any)
-> Int -> Ptr (AccelerationStructureBuildGeometryInfoKHR _)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (72 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (AccelerationStructureBuildGeometryInfoKHR _))) (SomeStruct AccelerationStructureBuildGeometryInfoKHR
e) (IO Result -> IO Result)
-> ((() -> IO Result) -> IO Result)
-> (() -> IO Result)
-> IO Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO Result) -> () -> IO Result
forall a b. (a -> b) -> a -> b
$ ())) ("infos"
::: Vector (SomeStruct AccelerationStructureBuildGeometryInfoKHR)
infos)
  "ppOffsetInfos"
::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR)
pPpOffsetInfos <- ((("ppOffsetInfos"
   ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
  -> IO Result)
 -> IO Result)
-> ContT
     Result
     IO
     ("ppOffsetInfos"
      ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("ppOffsetInfos"
    ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
   -> IO Result)
  -> IO Result)
 -> ContT
      Result
      IO
      ("ppOffsetInfos"
       ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR)))
-> ((("ppOffsetInfos"
      ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
     -> IO Result)
    -> IO Result)
-> ContT
     Result
     IO
     ("ppOffsetInfos"
      ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> (("ppOffsetInfos"
     ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
    -> IO Result)
-> IO Result
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @(Ptr AccelerationStructureBuildOffsetInfoKHR) ((("offsetInfos" ::: Vector AccelerationStructureBuildOffsetInfoKHR)
-> Int
forall a. Vector a -> Int
Data.Vector.length ("offsetInfos" ::: Vector AccelerationStructureBuildOffsetInfoKHR
offsetInfos)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 8
  (Int
 -> AccelerationStructureBuildOffsetInfoKHR -> ContT Result IO ())
-> ("offsetInfos"
    ::: Vector AccelerationStructureBuildOffsetInfoKHR)
-> ContT Result IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: AccelerationStructureBuildOffsetInfoKHR
e -> do
    Ptr AccelerationStructureBuildOffsetInfoKHR
ppOffsetInfos <- ((Ptr AccelerationStructureBuildOffsetInfoKHR -> IO Result)
 -> IO Result)
-> ContT Result IO (Ptr AccelerationStructureBuildOffsetInfoKHR)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr AccelerationStructureBuildOffsetInfoKHR -> IO Result)
  -> IO Result)
 -> ContT Result IO (Ptr AccelerationStructureBuildOffsetInfoKHR))
-> ((Ptr AccelerationStructureBuildOffsetInfoKHR -> IO Result)
    -> IO Result)
-> ContT Result IO (Ptr AccelerationStructureBuildOffsetInfoKHR)
forall a b. (a -> b) -> a -> b
$ AccelerationStructureBuildOffsetInfoKHR
-> (Ptr AccelerationStructureBuildOffsetInfoKHR -> IO Result)
-> IO Result
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AccelerationStructureBuildOffsetInfoKHR
e)
    IO () -> ContT Result IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Result IO ()) -> IO () -> ContT Result IO ()
forall a b. (a -> b) -> a -> b
$ ("ppOffsetInfos"
 ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
-> Ptr AccelerationStructureBuildOffsetInfoKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ("ppOffsetInfos"
::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR)
pPpOffsetInfos ("ppOffsetInfos"
 ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
-> Int
-> "ppOffsetInfos"
   ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR)) Ptr AccelerationStructureBuildOffsetInfoKHR
ppOffsetInfos) ("offsetInfos" ::: Vector AccelerationStructureBuildOffsetInfoKHR
offsetInfos)
  Result
r <- IO Result -> ContT Result IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT Result IO Result)
-> IO Result -> ContT Result IO Result
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> ("bindInfoCount" ::: Word32)
-> ("pInfos"
    ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR))
-> ("ppOffsetInfos"
    ::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR))
-> IO Result
vkBuildAccelerationStructureKHR' (Device -> Ptr Device_T
deviceHandle (Device
device)) ((Int -> "bindInfoCount" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pInfosLength :: Word32)) (Ptr (AccelerationStructureBuildGeometryInfoKHR Any)
-> "pInfos"
   ::: Ptr (SomeStruct AccelerationStructureBuildGeometryInfoKHR)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (AccelerationStructureBuildGeometryInfoKHR Any)
pPInfos)) ("ppOffsetInfos"
::: Ptr (Ptr AccelerationStructureBuildOffsetInfoKHR)
pPpOffsetInfos)
  IO () -> ContT Result IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Result IO ()) -> IO () -> ContT Result IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  Result -> ContT Result IO Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> ContT Result IO Result)
-> Result -> ContT Result IO Result
forall a b. (a -> b) -> a -> b
$ (Result
r)


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