{-# language CPP #-}
-- | = Name
--
-- VK_NV_ray_tracing_invocation_reorder - device extension
--
-- == VK_NV_ray_tracing_invocation_reorder
--
-- [__Name String__]
--     @VK_NV_ray_tracing_invocation_reorder@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     491
--
-- [__Revision__]
--     1
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires support for Vulkan 1.0
--
--     -   Requires @VK_KHR_ray_tracing_pipeline@ to be enabled for any
--         device-level functionality
--
-- [__Contact__]
--
--     -   Eric Werness
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_NV_ray_tracing_invocation_reorder] @ewerness-nv%0A*Here describe the issue or question you have about the VK_NV_ray_tracing_invocation_reorder extension* >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2022-11-02
--
-- [__Interactions and External Dependencies__]
--
--     -   This extension requires
--         <https://htmlpreview.github.io/?https://github.com/KhronosGroup/SPIRV-Registry/blob/master/extensions/NV/SPV_NV_shader_invocation_reorder.html SPV_NV_shader_invocation_reorder>
--
--     -   This extension provides API support for
--         <https://github.com/KhronosGroup/GLSL/blob/master/extensions/nv/GLSL_NV_shader_invocation_reorder.txt GL_NV_shader_invocation_reorder>
--
-- [__Contributors__]
--
--     -   Eric Werness, NVIDIA
--
--     -   Ashwin Lele, NVIDIA
--
-- == Description
--
-- The ray tracing pipeline API provides some ability to reorder for
-- locality, but it is useful to have more control over how the reordering
-- happens and what information is included in the reordering. The shader
-- API provides a hit object to contain result information from the hit
-- which can be used as part of the explicit sorting plus options that
-- contain an integer for hint bits to use to add more locality.
--
-- == New Structures
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDeviceRayTracingInvocationReorderFeaturesNV'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2':
--
--     -   'PhysicalDeviceRayTracingInvocationReorderPropertiesNV'
--
-- == New Enums
--
-- -   'RayTracingInvocationReorderModeNV'
--
-- == New Enum Constants
--
-- -   'NV_RAY_TRACING_INVOCATION_REORDER_EXTENSION_NAME'
--
-- -   'NV_RAY_TRACING_INVOCATION_REORDER_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_RAY_TRACING_INVOCATION_REORDER_FEATURES_NV'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_RAY_TRACING_INVOCATION_REORDER_PROPERTIES_NV'
--
-- == Version History
--
-- -   Revision 1, 2020-09-12 (Eric Werness, Ashwin Lele)
--
--     -   Initial external release
--
-- == See Also
--
-- 'PhysicalDeviceRayTracingInvocationReorderFeaturesNV',
-- 'PhysicalDeviceRayTracingInvocationReorderPropertiesNV',
-- 'RayTracingInvocationReorderModeNV'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_NV_ray_tracing_invocation_reorder Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_NV_ray_tracing_invocation_reorder  ( PhysicalDeviceRayTracingInvocationReorderFeaturesNV(..)
                                                               , PhysicalDeviceRayTracingInvocationReorderPropertiesNV(..)
                                                               , RayTracingInvocationReorderModeNV( RAY_TRACING_INVOCATION_REORDER_MODE_NONE_NV
                                                                                                  , RAY_TRACING_INVOCATION_REORDER_MODE_REORDER_NV
                                                                                                  , ..
                                                                                                  )
                                                               , NV_RAY_TRACING_INVOCATION_REORDER_SPEC_VERSION
                                                               , pattern NV_RAY_TRACING_INVOCATION_REORDER_SPEC_VERSION
                                                               , NV_RAY_TRACING_INVOCATION_REORDER_EXTENSION_NAME
                                                               , pattern NV_RAY_TRACING_INVOCATION_REORDER_EXTENSION_NAME
                                                               ) where

import Vulkan.Internal.Utils (enumReadPrec)
import Vulkan.Internal.Utils (enumShowsPrec)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import GHC.Show (showsPrec)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero)
import Vulkan.Zero (Zero(..))
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import Data.Int (Int32)
import Foreign.Ptr (Ptr)
import GHC.Read (Read(readPrec))
import GHC.Show (Show(showsPrec))
import Data.Kind (Type)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_RAY_TRACING_INVOCATION_REORDER_FEATURES_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_RAY_TRACING_INVOCATION_REORDER_PROPERTIES_NV))
-- | VkPhysicalDeviceRayTracingInvocationReorderFeaturesNV - Structure
-- describing feature to control ray tracing invocation reordering
--
-- = Members
--
-- This structure describes the following feature:
--
-- = Description
--
-- If the 'PhysicalDeviceRayTracingInvocationReorderFeaturesNV' structure
-- is included in the @pNext@ chain of the
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2'
-- structure passed to
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceFeatures2',
-- it is filled in to indicate whether each corresponding feature is
-- supported. 'PhysicalDeviceRayTracingInvocationReorderFeaturesNV' /can/
-- also be used in the @pNext@ chain of
-- 'Vulkan.Core10.Device.DeviceCreateInfo' to selectively enable these
-- features.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_ray_tracing_invocation_reorder VK_NV_ray_tracing_invocation_reorder>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceRayTracingInvocationReorderFeaturesNV = PhysicalDeviceRayTracingInvocationReorderFeaturesNV
  { -- | #features-rayTracingInvocationReorder# @rayTracingInvocationReorder@
    -- indicates that the implementation supports
    -- @SPV_NV_shader_invocation_reorder@.
    PhysicalDeviceRayTracingInvocationReorderFeaturesNV -> Bool
rayTracingInvocationReorder :: Bool }
  deriving (Typeable, PhysicalDeviceRayTracingInvocationReorderFeaturesNV
-> PhysicalDeviceRayTracingInvocationReorderFeaturesNV -> Bool
(PhysicalDeviceRayTracingInvocationReorderFeaturesNV
 -> PhysicalDeviceRayTracingInvocationReorderFeaturesNV -> Bool)
-> (PhysicalDeviceRayTracingInvocationReorderFeaturesNV
    -> PhysicalDeviceRayTracingInvocationReorderFeaturesNV -> Bool)
-> Eq PhysicalDeviceRayTracingInvocationReorderFeaturesNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceRayTracingInvocationReorderFeaturesNV
-> PhysicalDeviceRayTracingInvocationReorderFeaturesNV -> Bool
$c/= :: PhysicalDeviceRayTracingInvocationReorderFeaturesNV
-> PhysicalDeviceRayTracingInvocationReorderFeaturesNV -> Bool
== :: PhysicalDeviceRayTracingInvocationReorderFeaturesNV
-> PhysicalDeviceRayTracingInvocationReorderFeaturesNV -> Bool
$c== :: PhysicalDeviceRayTracingInvocationReorderFeaturesNV
-> PhysicalDeviceRayTracingInvocationReorderFeaturesNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceRayTracingInvocationReorderFeaturesNV)
#endif
deriving instance Show PhysicalDeviceRayTracingInvocationReorderFeaturesNV

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

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

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

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


-- | VkPhysicalDeviceRayTracingInvocationReorderPropertiesNV - Structure
-- describing shader module identifier properties of an implementation
--
-- = Description
--
-- Note
--
-- Because the extension changes how hits are managed there is a
-- compatibility reason to expose the extension even when an implementation
-- does not have sorting active.
--
-- If the 'PhysicalDeviceRayTracingInvocationReorderPropertiesNV' structure
-- is included in the @pNext@ chain of the
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2'
-- structure passed to
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceProperties2',
-- it is filled in with each corresponding implementation-dependent
-- property.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_ray_tracing_invocation_reorder VK_NV_ray_tracing_invocation_reorder>,
-- 'RayTracingInvocationReorderModeNV',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceRayTracingInvocationReorderPropertiesNV = PhysicalDeviceRayTracingInvocationReorderPropertiesNV
  { -- | @rayTracingInvocationReorderReorderingHint@ is a hint indicating if the
    -- implementation will actually reorder at the reorder calls.
    PhysicalDeviceRayTracingInvocationReorderPropertiesNV
-> RayTracingInvocationReorderModeNV
rayTracingInvocationReorderReorderingHint :: RayTracingInvocationReorderModeNV }
  deriving (Typeable, PhysicalDeviceRayTracingInvocationReorderPropertiesNV
-> PhysicalDeviceRayTracingInvocationReorderPropertiesNV -> Bool
(PhysicalDeviceRayTracingInvocationReorderPropertiesNV
 -> PhysicalDeviceRayTracingInvocationReorderPropertiesNV -> Bool)
-> (PhysicalDeviceRayTracingInvocationReorderPropertiesNV
    -> PhysicalDeviceRayTracingInvocationReorderPropertiesNV -> Bool)
-> Eq PhysicalDeviceRayTracingInvocationReorderPropertiesNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceRayTracingInvocationReorderPropertiesNV
-> PhysicalDeviceRayTracingInvocationReorderPropertiesNV -> Bool
$c/= :: PhysicalDeviceRayTracingInvocationReorderPropertiesNV
-> PhysicalDeviceRayTracingInvocationReorderPropertiesNV -> Bool
== :: PhysicalDeviceRayTracingInvocationReorderPropertiesNV
-> PhysicalDeviceRayTracingInvocationReorderPropertiesNV -> Bool
$c== :: PhysicalDeviceRayTracingInvocationReorderPropertiesNV
-> PhysicalDeviceRayTracingInvocationReorderPropertiesNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceRayTracingInvocationReorderPropertiesNV)
#endif
deriving instance Show PhysicalDeviceRayTracingInvocationReorderPropertiesNV

instance ToCStruct PhysicalDeviceRayTracingInvocationReorderPropertiesNV where
  withCStruct :: forall b.
PhysicalDeviceRayTracingInvocationReorderPropertiesNV
-> (Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
    -> IO b)
-> IO b
withCStruct PhysicalDeviceRayTracingInvocationReorderPropertiesNV
x Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV -> IO b
f = Int
-> (Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
    -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
  -> IO b)
 -> IO b)
-> (Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
    -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
p -> Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
-> PhysicalDeviceRayTracingInvocationReorderPropertiesNV
-> IO b
-> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
p PhysicalDeviceRayTracingInvocationReorderPropertiesNV
x (Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV -> IO b
f Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
p)
  pokeCStruct :: forall b.
Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
-> PhysicalDeviceRayTracingInvocationReorderPropertiesNV
-> IO b
-> IO b
pokeCStruct Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
p PhysicalDeviceRayTracingInvocationReorderPropertiesNV{RayTracingInvocationReorderModeNV
rayTracingInvocationReorderReorderingHint :: RayTracingInvocationReorderModeNV
$sel:rayTracingInvocationReorderReorderingHint:PhysicalDeviceRayTracingInvocationReorderPropertiesNV :: PhysicalDeviceRayTracingInvocationReorderPropertiesNV
-> RayTracingInvocationReorderModeNV
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
p Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_RAY_TRACING_INVOCATION_REORDER_PROPERTIES_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
p Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
p Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
-> Int -> Ptr RayTracingInvocationReorderModeNV
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr RayTracingInvocationReorderModeNV)) (RayTracingInvocationReorderModeNV
rayTracingInvocationReorderReorderingHint)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
-> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
p Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_RAY_TRACING_INVOCATION_REORDER_PROPERTIES_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
p Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
p Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
-> Int -> Ptr RayTracingInvocationReorderModeNV
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr RayTracingInvocationReorderModeNV)) (RayTracingInvocationReorderModeNV
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct PhysicalDeviceRayTracingInvocationReorderPropertiesNV where
  peekCStruct :: Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
-> IO PhysicalDeviceRayTracingInvocationReorderPropertiesNV
peekCStruct Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
p = do
    RayTracingInvocationReorderModeNV
rayTracingInvocationReorderReorderingHint <- forall a. Storable a => Ptr a -> IO a
peek @RayTracingInvocationReorderModeNV ((Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
p Ptr PhysicalDeviceRayTracingInvocationReorderPropertiesNV
-> Int -> Ptr RayTracingInvocationReorderModeNV
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr RayTracingInvocationReorderModeNV))
    PhysicalDeviceRayTracingInvocationReorderPropertiesNV
-> IO PhysicalDeviceRayTracingInvocationReorderPropertiesNV
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceRayTracingInvocationReorderPropertiesNV
 -> IO PhysicalDeviceRayTracingInvocationReorderPropertiesNV)
-> PhysicalDeviceRayTracingInvocationReorderPropertiesNV
-> IO PhysicalDeviceRayTracingInvocationReorderPropertiesNV
forall a b. (a -> b) -> a -> b
$ RayTracingInvocationReorderModeNV
-> PhysicalDeviceRayTracingInvocationReorderPropertiesNV
PhysicalDeviceRayTracingInvocationReorderPropertiesNV
             RayTracingInvocationReorderModeNV
rayTracingInvocationReorderReorderingHint

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

instance Zero PhysicalDeviceRayTracingInvocationReorderPropertiesNV where
  zero :: PhysicalDeviceRayTracingInvocationReorderPropertiesNV
zero = RayTracingInvocationReorderModeNV
-> PhysicalDeviceRayTracingInvocationReorderPropertiesNV
PhysicalDeviceRayTracingInvocationReorderPropertiesNV
           RayTracingInvocationReorderModeNV
forall a. Zero a => a
zero


-- | VkRayTracingInvocationReorderModeNV - Enum providing a hint on how the
-- application /may/ reorder
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_ray_tracing_invocation_reorder VK_NV_ray_tracing_invocation_reorder>,
-- 'PhysicalDeviceRayTracingInvocationReorderPropertiesNV'
newtype RayTracingInvocationReorderModeNV = RayTracingInvocationReorderModeNV Int32
  deriving newtype (RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV -> Bool
(RayTracingInvocationReorderModeNV
 -> RayTracingInvocationReorderModeNV -> Bool)
-> (RayTracingInvocationReorderModeNV
    -> RayTracingInvocationReorderModeNV -> Bool)
-> Eq RayTracingInvocationReorderModeNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV -> Bool
$c/= :: RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV -> Bool
== :: RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV -> Bool
$c== :: RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV -> Bool
Eq, Eq RayTracingInvocationReorderModeNV
Eq RayTracingInvocationReorderModeNV
-> (RayTracingInvocationReorderModeNV
    -> RayTracingInvocationReorderModeNV -> Ordering)
-> (RayTracingInvocationReorderModeNV
    -> RayTracingInvocationReorderModeNV -> Bool)
-> (RayTracingInvocationReorderModeNV
    -> RayTracingInvocationReorderModeNV -> Bool)
-> (RayTracingInvocationReorderModeNV
    -> RayTracingInvocationReorderModeNV -> Bool)
-> (RayTracingInvocationReorderModeNV
    -> RayTracingInvocationReorderModeNV -> Bool)
-> (RayTracingInvocationReorderModeNV
    -> RayTracingInvocationReorderModeNV
    -> RayTracingInvocationReorderModeNV)
-> (RayTracingInvocationReorderModeNV
    -> RayTracingInvocationReorderModeNV
    -> RayTracingInvocationReorderModeNV)
-> Ord RayTracingInvocationReorderModeNV
RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV -> Bool
RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV -> Ordering
RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV
$cmin :: RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV
max :: RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV
$cmax :: RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV
>= :: RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV -> Bool
$c>= :: RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV -> Bool
> :: RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV -> Bool
$c> :: RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV -> Bool
<= :: RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV -> Bool
$c<= :: RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV -> Bool
< :: RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV -> Bool
$c< :: RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV -> Bool
compare :: RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV -> Ordering
$ccompare :: RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV -> Ordering
Ord, Ptr RayTracingInvocationReorderModeNV
-> IO RayTracingInvocationReorderModeNV
Ptr RayTracingInvocationReorderModeNV
-> Int -> IO RayTracingInvocationReorderModeNV
Ptr RayTracingInvocationReorderModeNV
-> Int -> RayTracingInvocationReorderModeNV -> IO ()
Ptr RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV -> IO ()
RayTracingInvocationReorderModeNV -> Int
(RayTracingInvocationReorderModeNV -> Int)
-> (RayTracingInvocationReorderModeNV -> Int)
-> (Ptr RayTracingInvocationReorderModeNV
    -> Int -> IO RayTracingInvocationReorderModeNV)
-> (Ptr RayTracingInvocationReorderModeNV
    -> Int -> RayTracingInvocationReorderModeNV -> IO ())
-> (forall b. Ptr b -> Int -> IO RayTracingInvocationReorderModeNV)
-> (forall b.
    Ptr b -> Int -> RayTracingInvocationReorderModeNV -> IO ())
-> (Ptr RayTracingInvocationReorderModeNV
    -> IO RayTracingInvocationReorderModeNV)
-> (Ptr RayTracingInvocationReorderModeNV
    -> RayTracingInvocationReorderModeNV -> IO ())
-> Storable RayTracingInvocationReorderModeNV
forall b. Ptr b -> Int -> IO RayTracingInvocationReorderModeNV
forall b.
Ptr b -> Int -> RayTracingInvocationReorderModeNV -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV -> IO ()
$cpoke :: Ptr RayTracingInvocationReorderModeNV
-> RayTracingInvocationReorderModeNV -> IO ()
peek :: Ptr RayTracingInvocationReorderModeNV
-> IO RayTracingInvocationReorderModeNV
$cpeek :: Ptr RayTracingInvocationReorderModeNV
-> IO RayTracingInvocationReorderModeNV
pokeByteOff :: forall b.
Ptr b -> Int -> RayTracingInvocationReorderModeNV -> IO ()
$cpokeByteOff :: forall b.
Ptr b -> Int -> RayTracingInvocationReorderModeNV -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO RayTracingInvocationReorderModeNV
$cpeekByteOff :: forall b. Ptr b -> Int -> IO RayTracingInvocationReorderModeNV
pokeElemOff :: Ptr RayTracingInvocationReorderModeNV
-> Int -> RayTracingInvocationReorderModeNV -> IO ()
$cpokeElemOff :: Ptr RayTracingInvocationReorderModeNV
-> Int -> RayTracingInvocationReorderModeNV -> IO ()
peekElemOff :: Ptr RayTracingInvocationReorderModeNV
-> Int -> IO RayTracingInvocationReorderModeNV
$cpeekElemOff :: Ptr RayTracingInvocationReorderModeNV
-> Int -> IO RayTracingInvocationReorderModeNV
alignment :: RayTracingInvocationReorderModeNV -> Int
$calignment :: RayTracingInvocationReorderModeNV -> Int
sizeOf :: RayTracingInvocationReorderModeNV -> Int
$csizeOf :: RayTracingInvocationReorderModeNV -> Int
Storable, RayTracingInvocationReorderModeNV
RayTracingInvocationReorderModeNV
-> Zero RayTracingInvocationReorderModeNV
forall a. a -> Zero a
zero :: RayTracingInvocationReorderModeNV
$czero :: RayTracingInvocationReorderModeNV
Zero)

-- | 'RAY_TRACING_INVOCATION_REORDER_MODE_NONE_NV' indicates that the
-- implementation is likely to not reorder at reorder calls.
pattern $bRAY_TRACING_INVOCATION_REORDER_MODE_NONE_NV :: RayTracingInvocationReorderModeNV
$mRAY_TRACING_INVOCATION_REORDER_MODE_NONE_NV :: forall {r}.
RayTracingInvocationReorderModeNV
-> (Void# -> r) -> (Void# -> r) -> r
RAY_TRACING_INVOCATION_REORDER_MODE_NONE_NV = RayTracingInvocationReorderModeNV 0

-- | 'RAY_TRACING_INVOCATION_REORDER_MODE_REORDER_NV' indicates that the
-- implementation is likely to reorder at reorder calls.
pattern $bRAY_TRACING_INVOCATION_REORDER_MODE_REORDER_NV :: RayTracingInvocationReorderModeNV
$mRAY_TRACING_INVOCATION_REORDER_MODE_REORDER_NV :: forall {r}.
RayTracingInvocationReorderModeNV
-> (Void# -> r) -> (Void# -> r) -> r
RAY_TRACING_INVOCATION_REORDER_MODE_REORDER_NV = RayTracingInvocationReorderModeNV 1

{-# COMPLETE
  RAY_TRACING_INVOCATION_REORDER_MODE_NONE_NV
  , RAY_TRACING_INVOCATION_REORDER_MODE_REORDER_NV ::
    RayTracingInvocationReorderModeNV
  #-}

conNameRayTracingInvocationReorderModeNV :: String
conNameRayTracingInvocationReorderModeNV :: String
conNameRayTracingInvocationReorderModeNV = String
"RayTracingInvocationReorderModeNV"

enumPrefixRayTracingInvocationReorderModeNV :: String
enumPrefixRayTracingInvocationReorderModeNV :: String
enumPrefixRayTracingInvocationReorderModeNV = String
"RAY_TRACING_INVOCATION_REORDER_MODE_"

showTableRayTracingInvocationReorderModeNV :: [(RayTracingInvocationReorderModeNV, String)]
showTableRayTracingInvocationReorderModeNV :: [(RayTracingInvocationReorderModeNV, String)]
showTableRayTracingInvocationReorderModeNV =
  [
    ( RayTracingInvocationReorderModeNV
RAY_TRACING_INVOCATION_REORDER_MODE_NONE_NV
    , String
"NONE_NV"
    )
  ,
    ( RayTracingInvocationReorderModeNV
RAY_TRACING_INVOCATION_REORDER_MODE_REORDER_NV
    , String
"REORDER_NV"
    )
  ]

instance Show RayTracingInvocationReorderModeNV where
  showsPrec :: Int -> RayTracingInvocationReorderModeNV -> ShowS
showsPrec =
    String
-> [(RayTracingInvocationReorderModeNV, String)]
-> String
-> (RayTracingInvocationReorderModeNV -> Int32)
-> (Int32 -> ShowS)
-> Int
-> RayTracingInvocationReorderModeNV
-> ShowS
forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
      String
enumPrefixRayTracingInvocationReorderModeNV
      [(RayTracingInvocationReorderModeNV, String)]
showTableRayTracingInvocationReorderModeNV
      String
conNameRayTracingInvocationReorderModeNV
      (\(RayTracingInvocationReorderModeNV Int32
x) -> Int32
x)
      (Int -> Int32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11)

instance Read RayTracingInvocationReorderModeNV where
  readPrec :: ReadPrec RayTracingInvocationReorderModeNV
readPrec =
    String
-> [(RayTracingInvocationReorderModeNV, String)]
-> String
-> (Int32 -> RayTracingInvocationReorderModeNV)
-> ReadPrec RayTracingInvocationReorderModeNV
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
      String
enumPrefixRayTracingInvocationReorderModeNV
      [(RayTracingInvocationReorderModeNV, String)]
showTableRayTracingInvocationReorderModeNV
      String
conNameRayTracingInvocationReorderModeNV
      Int32 -> RayTracingInvocationReorderModeNV
RayTracingInvocationReorderModeNV

type NV_RAY_TRACING_INVOCATION_REORDER_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_NV_RAY_TRACING_INVOCATION_REORDER_SPEC_VERSION"
pattern NV_RAY_TRACING_INVOCATION_REORDER_SPEC_VERSION :: forall a . Integral a => a
pattern $bNV_RAY_TRACING_INVOCATION_REORDER_SPEC_VERSION :: forall a. Integral a => a
$mNV_RAY_TRACING_INVOCATION_REORDER_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> (Void# -> r) -> (Void# -> r) -> r
NV_RAY_TRACING_INVOCATION_REORDER_SPEC_VERSION = 1


type NV_RAY_TRACING_INVOCATION_REORDER_EXTENSION_NAME = "VK_NV_ray_tracing_invocation_reorder"

-- No documentation found for TopLevel "VK_NV_RAY_TRACING_INVOCATION_REORDER_EXTENSION_NAME"
pattern NV_RAY_TRACING_INVOCATION_REORDER_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bNV_RAY_TRACING_INVOCATION_REORDER_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mNV_RAY_TRACING_INVOCATION_REORDER_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
NV_RAY_TRACING_INVOCATION_REORDER_EXTENSION_NAME = "VK_NV_ray_tracing_invocation_reorder"