{-# language CPP #-}
-- | = Name
--
-- VK_NV_displacement_micromap - device extension
--
-- == VK_NV_displacement_micromap
--
-- [__Name String__]
--     @VK_NV_displacement_micromap@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     398
--
-- [__Revision__]
--     2
--
-- [__Ratification Status__]
--     Not ratified
--
-- [__Extension and Version Dependencies__]
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_opacity_micromap VK_EXT_opacity_micromap>
--
--     -   __This is a /provisional/ extension and /must/ be used with
--         caution. See the
--         <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#boilerplate-provisional-header description>
--         of provisional header files for enablement and stability
--         details.__
--
-- [__Contact__]
--
--     -   Christoph Kubisch
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_NV_displacement_micromap] @pixeljetstream%0A*Here describe the issue or question you have about the VK_NV_displacement_micromap extension* >
--
--     -   Eric Werness
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_NV_displacement_micromap] @ewerness-nv%0A*Here describe the issue or question you have about the VK_NV_displacement_micromap extension* >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2023-03-17
--
-- [__Interactions and External Dependencies__]
--     TBD
--
-- [__Contributors__]
--
--     -   Christoph Kubisch, NVIDIA
--
--     -   Eric Werness, NVIDIA
--
-- == Description
--
-- Ray tracing can very efficiently render from geometry which has very
-- fine detail, but when using only a basic triangle representation, memory
-- consumption can be an issue. This extension adds the ability to add a
-- /displacement map/ to add more detail to triangles in an acceleration
-- structure with an efficient in-memory format. The format is externally
-- visible to allow the application to compress its internal geometry
-- representations into the compressed format ahead of time. This format
-- adds displacements along a defined vector to subtriangle vertices which
-- are subdivided from the main triangles.
--
-- This extension provides:
--
-- -   a new 'Vulkan.Extensions.VK_EXT_opacity_micromap.MicromapTypeEXT'
--     format for the displacement micromap,
--
-- -   a structure to extend
--     'Vulkan.Extensions.VK_KHR_acceleration_structure.AccelerationStructureGeometryTrianglesDataKHR'
--     to attach a displacement micromap to the geometry of the
--     acceleration structure,
--
-- -   enums extending
--     'Vulkan.Extensions.VK_KHR_acceleration_structure.BuildAccelerationStructureFlagBitsKHR'
--     to allow for updates.
--
-- == New Structures
--
-- -   Extending
--     'Vulkan.Extensions.VK_KHR_acceleration_structure.AccelerationStructureGeometryTrianglesDataKHR':
--
--     -   'AccelerationStructureTrianglesDisplacementMicromapNV'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDeviceDisplacementMicromapFeaturesNV'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2':
--
--     -   'PhysicalDeviceDisplacementMicromapPropertiesNV'
--
-- == New Enums
--
-- -   'DisplacementMicromapFormatNV'
--
-- == New Enum Constants
--
-- -   'NV_DISPLACEMENT_MICROMAP_EXTENSION_NAME'
--
-- -   'NV_DISPLACEMENT_MICROMAP_SPEC_VERSION'
--
-- -   Extending
--     'Vulkan.Extensions.VK_KHR_acceleration_structure.BuildAccelerationStructureFlagBitsKHR':
--
--     -   'Vulkan.Extensions.VK_KHR_acceleration_structure.BUILD_ACCELERATION_STRUCTURE_ALLOW_DISPLACEMENT_MICROMAP_UPDATE_NV'
--
-- -   Extending
--     'Vulkan.Extensions.VK_EXT_opacity_micromap.MicromapTypeEXT':
--
--     -   'Vulkan.Extensions.VK_EXT_opacity_micromap.MICROMAP_TYPE_DISPLACEMENT_MICROMAP_NV'
--
-- -   Extending
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PipelineCreateFlagBits':
--
--     -   'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RAY_TRACING_DISPLACEMENT_MICROMAP_BIT_NV'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_ACCELERATION_STRUCTURE_TRIANGLES_DISPLACEMENT_MICROMAP_NV'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_DISPLACEMENT_MICROMAP_FEATURES_NV'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_DISPLACEMENT_MICROMAP_PROPERTIES_NV'
--
-- == Issues
--
-- (1) What is the status of this extension?
--
-- -   Provisional and expected to change. The broad structure and encoding
--     format are stable, but there will likely be changes to the
--     structures, enumerant values, and shader interface.
--
-- == Version History
--
-- -   Revision 1, 2023-03-17 (Eric Werness)
--
--     -   Initial public revision
--
-- -   Revision 2, 2023-07-07 (Eric Werness)
--
--     -   Add shader support for decode intrinsics
--
-- == See Also
--
-- 'AccelerationStructureTrianglesDisplacementMicromapNV',
-- 'DisplacementMicromapFormatNV',
-- 'PhysicalDeviceDisplacementMicromapFeaturesNV',
-- 'PhysicalDeviceDisplacementMicromapPropertiesNV'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_NV_displacement_micromap 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_displacement_micromap  ( PhysicalDeviceDisplacementMicromapFeaturesNV(..)
                                                      , PhysicalDeviceDisplacementMicromapPropertiesNV(..)
                                                      , AccelerationStructureTrianglesDisplacementMicromapNV(..)
                                                      , DisplacementMicromapFormatNV( DISPLACEMENT_MICROMAP_FORMAT_64_TRIANGLES_64_BYTES_NV
                                                                                    , DISPLACEMENT_MICROMAP_FORMAT_256_TRIANGLES_128_BYTES_NV
                                                                                    , DISPLACEMENT_MICROMAP_FORMAT_1024_TRIANGLES_128_BYTES_NV
                                                                                    , ..
                                                                                    )
                                                      , NV_DISPLACEMENT_MICROMAP_SPEC_VERSION
                                                      , pattern NV_DISPLACEMENT_MICROMAP_SPEC_VERSION
                                                      , NV_DISPLACEMENT_MICROMAP_EXTENSION_NAME
                                                      , pattern NV_DISPLACEMENT_MICROMAP_EXTENSION_NAME
                                                      , MicromapEXT(..)
                                                      , MicromapUsageEXT(..)
                                                      , DeviceOrHostAddressConstKHR(..)
                                                      , BuildAccelerationStructureFlagBitsKHR(..)
                                                      , BuildAccelerationStructureFlagsKHR
                                                      , MicromapTypeEXT(..)
                                                      ) 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 Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero)
import 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.Word (Word32)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Extensions.VK_KHR_acceleration_structure (DeviceOrHostAddressConstKHR)
import Vulkan.Core10.FundamentalTypes (DeviceSize)
import Vulkan.Core10.Enums.Format (Format)
import Vulkan.Core10.Enums.IndexType (IndexType)
import Vulkan.Extensions.Handles (MicromapEXT)
import Vulkan.Extensions.VK_EXT_opacity_micromap (MicromapUsageEXT)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_ACCELERATION_STRUCTURE_TRIANGLES_DISPLACEMENT_MICROMAP_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_DISPLACEMENT_MICROMAP_FEATURES_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_DISPLACEMENT_MICROMAP_PROPERTIES_NV))
import Vulkan.Extensions.VK_KHR_acceleration_structure (BuildAccelerationStructureFlagBitsKHR(..))
import Vulkan.Extensions.VK_KHR_acceleration_structure (BuildAccelerationStructureFlagsKHR)
import Vulkan.Extensions.VK_KHR_acceleration_structure (DeviceOrHostAddressConstKHR(..))
import Vulkan.Extensions.Handles (MicromapEXT(..))
import Vulkan.Extensions.VK_EXT_opacity_micromap (MicromapTypeEXT(..))
import Vulkan.Extensions.VK_EXT_opacity_micromap (MicromapUsageEXT(..))
-- | VkPhysicalDeviceDisplacementMicromapFeaturesNV - Structure describing
-- the ray tracing displacement micromap features that can be supported by
-- an implementation
--
-- = Members
--
-- This structure describes the following feature:
--
-- = Description
--
-- If the 'PhysicalDeviceDisplacementMicromapFeaturesNV' 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. 'PhysicalDeviceDisplacementMicromapFeaturesNV' /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_displacement_micromap VK_NV_displacement_micromap>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceDisplacementMicromapFeaturesNV = PhysicalDeviceDisplacementMicromapFeaturesNV
  { -- | #features-displacementMicromap# @displacementMicromap@ indicates whether
    -- the implementation supports the displacement micromap feature.
    PhysicalDeviceDisplacementMicromapFeaturesNV -> Bool
displacementMicromap :: Bool }
  deriving (Typeable, PhysicalDeviceDisplacementMicromapFeaturesNV
-> PhysicalDeviceDisplacementMicromapFeaturesNV -> Bool
(PhysicalDeviceDisplacementMicromapFeaturesNV
 -> PhysicalDeviceDisplacementMicromapFeaturesNV -> Bool)
-> (PhysicalDeviceDisplacementMicromapFeaturesNV
    -> PhysicalDeviceDisplacementMicromapFeaturesNV -> Bool)
-> Eq PhysicalDeviceDisplacementMicromapFeaturesNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PhysicalDeviceDisplacementMicromapFeaturesNV
-> PhysicalDeviceDisplacementMicromapFeaturesNV -> Bool
== :: PhysicalDeviceDisplacementMicromapFeaturesNV
-> PhysicalDeviceDisplacementMicromapFeaturesNV -> Bool
$c/= :: PhysicalDeviceDisplacementMicromapFeaturesNV
-> PhysicalDeviceDisplacementMicromapFeaturesNV -> Bool
/= :: PhysicalDeviceDisplacementMicromapFeaturesNV
-> PhysicalDeviceDisplacementMicromapFeaturesNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceDisplacementMicromapFeaturesNV)
#endif
deriving instance Show PhysicalDeviceDisplacementMicromapFeaturesNV

instance ToCStruct PhysicalDeviceDisplacementMicromapFeaturesNV where
  withCStruct :: forall b.
PhysicalDeviceDisplacementMicromapFeaturesNV
-> (Ptr PhysicalDeviceDisplacementMicromapFeaturesNV -> IO b)
-> IO b
withCStruct PhysicalDeviceDisplacementMicromapFeaturesNV
x Ptr PhysicalDeviceDisplacementMicromapFeaturesNV -> IO b
f = Int
-> (Ptr PhysicalDeviceDisplacementMicromapFeaturesNV -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr PhysicalDeviceDisplacementMicromapFeaturesNV -> IO b)
 -> IO b)
-> (Ptr PhysicalDeviceDisplacementMicromapFeaturesNV -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceDisplacementMicromapFeaturesNV
p -> Ptr PhysicalDeviceDisplacementMicromapFeaturesNV
-> PhysicalDeviceDisplacementMicromapFeaturesNV -> IO b -> IO b
forall b.
Ptr PhysicalDeviceDisplacementMicromapFeaturesNV
-> PhysicalDeviceDisplacementMicromapFeaturesNV -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceDisplacementMicromapFeaturesNV
p PhysicalDeviceDisplacementMicromapFeaturesNV
x (Ptr PhysicalDeviceDisplacementMicromapFeaturesNV -> IO b
f Ptr PhysicalDeviceDisplacementMicromapFeaturesNV
p)
  pokeCStruct :: forall b.
Ptr PhysicalDeviceDisplacementMicromapFeaturesNV
-> PhysicalDeviceDisplacementMicromapFeaturesNV -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceDisplacementMicromapFeaturesNV
p PhysicalDeviceDisplacementMicromapFeaturesNV{Bool
$sel:displacementMicromap:PhysicalDeviceDisplacementMicromapFeaturesNV :: PhysicalDeviceDisplacementMicromapFeaturesNV -> Bool
displacementMicromap :: Bool
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDisplacementMicromapFeaturesNV
p Ptr PhysicalDeviceDisplacementMicromapFeaturesNV
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_DISPLACEMENT_MICROMAP_FEATURES_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDisplacementMicromapFeaturesNV
p Ptr PhysicalDeviceDisplacementMicromapFeaturesNV
-> 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 PhysicalDeviceDisplacementMicromapFeaturesNV
p Ptr PhysicalDeviceDisplacementMicromapFeaturesNV
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
displacementMicromap))
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceDisplacementMicromapFeaturesNV -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceDisplacementMicromapFeaturesNV
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDisplacementMicromapFeaturesNV
p Ptr PhysicalDeviceDisplacementMicromapFeaturesNV
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_DISPLACEMENT_MICROMAP_FEATURES_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDisplacementMicromapFeaturesNV
p Ptr PhysicalDeviceDisplacementMicromapFeaturesNV
-> 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 PhysicalDeviceDisplacementMicromapFeaturesNV
p Ptr PhysicalDeviceDisplacementMicromapFeaturesNV
-> 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 PhysicalDeviceDisplacementMicromapFeaturesNV where
  peekCStruct :: Ptr PhysicalDeviceDisplacementMicromapFeaturesNV
-> IO PhysicalDeviceDisplacementMicromapFeaturesNV
peekCStruct Ptr PhysicalDeviceDisplacementMicromapFeaturesNV
p = do
    Bool32
displacementMicromap <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceDisplacementMicromapFeaturesNV
p Ptr PhysicalDeviceDisplacementMicromapFeaturesNV
-> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
    PhysicalDeviceDisplacementMicromapFeaturesNV
-> IO PhysicalDeviceDisplacementMicromapFeaturesNV
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceDisplacementMicromapFeaturesNV
 -> IO PhysicalDeviceDisplacementMicromapFeaturesNV)
-> PhysicalDeviceDisplacementMicromapFeaturesNV
-> IO PhysicalDeviceDisplacementMicromapFeaturesNV
forall a b. (a -> b) -> a -> b
$ Bool -> PhysicalDeviceDisplacementMicromapFeaturesNV
PhysicalDeviceDisplacementMicromapFeaturesNV
             (Bool32 -> Bool
bool32ToBool Bool32
displacementMicromap)

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

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


-- | VkPhysicalDeviceDisplacementMicromapPropertiesNV - Structure describing
-- the displacement micromap properties of a physical device
--
-- = Description
--
-- If the 'PhysicalDeviceDisplacementMicromapPropertiesNV' 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_displacement_micromap VK_NV_displacement_micromap>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceDisplacementMicromapPropertiesNV = PhysicalDeviceDisplacementMicromapPropertiesNV
  { -- | @maxDisplacementMicromapSubdivisionLevel@ is the maximum allowed
    -- @subdivisionLevel@ for displacement micromaps.
    PhysicalDeviceDisplacementMicromapPropertiesNV -> Word32
maxDisplacementMicromapSubdivisionLevel :: Word32 }
  deriving (Typeable, PhysicalDeviceDisplacementMicromapPropertiesNV
-> PhysicalDeviceDisplacementMicromapPropertiesNV -> Bool
(PhysicalDeviceDisplacementMicromapPropertiesNV
 -> PhysicalDeviceDisplacementMicromapPropertiesNV -> Bool)
-> (PhysicalDeviceDisplacementMicromapPropertiesNV
    -> PhysicalDeviceDisplacementMicromapPropertiesNV -> Bool)
-> Eq PhysicalDeviceDisplacementMicromapPropertiesNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PhysicalDeviceDisplacementMicromapPropertiesNV
-> PhysicalDeviceDisplacementMicromapPropertiesNV -> Bool
== :: PhysicalDeviceDisplacementMicromapPropertiesNV
-> PhysicalDeviceDisplacementMicromapPropertiesNV -> Bool
$c/= :: PhysicalDeviceDisplacementMicromapPropertiesNV
-> PhysicalDeviceDisplacementMicromapPropertiesNV -> Bool
/= :: PhysicalDeviceDisplacementMicromapPropertiesNV
-> PhysicalDeviceDisplacementMicromapPropertiesNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceDisplacementMicromapPropertiesNV)
#endif
deriving instance Show PhysicalDeviceDisplacementMicromapPropertiesNV

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

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

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

instance Zero PhysicalDeviceDisplacementMicromapPropertiesNV where
  zero :: PhysicalDeviceDisplacementMicromapPropertiesNV
zero = Word32 -> PhysicalDeviceDisplacementMicromapPropertiesNV
PhysicalDeviceDisplacementMicromapPropertiesNV
           Word32
forall a. Zero a => a
zero


-- | VkAccelerationStructureTrianglesDisplacementMicromapNV - Structure
-- specifying a displacement micromap in a bottom-level acceleration
-- structure
--
-- = Description
--
-- If 'AccelerationStructureTrianglesDisplacementMicromapNV' is included in
-- the @pNext@ chain of a
-- 'Vulkan.Extensions.VK_KHR_acceleration_structure.AccelerationStructureGeometryTrianglesDataKHR'
-- structure, that geometry will reference that micromap.
--
-- For each triangle in the geometry, the acceleration structure build
-- fetches an index from @indexBuffer@ using @indexType@ and @indexStride@.
-- That triangle uses the displacement micromap information from @micromap@
-- at that index plus @baseTriangle@.
--
-- Only one of @pUsageCounts@ or @ppUsageCounts@ /can/ be a valid pointer,
-- the other /must/ be @NULL@. The elements of the non-@NULL@ array
-- describe the total count used to build this geometry. For a given
-- @format@ and @subdivisionLevel@ the number of triangles in this geometry
-- matching those values after indirection /must/ be equal to the sum of
-- matching @count@ provided.
--
-- == Valid Usage
--
-- -   #VUID-VkAccelerationStructureTrianglesDisplacementMicromapNV-pUsageCounts-07992#
--     Only one of @pUsageCounts@ or @ppUsageCounts@ /can/ be a valid
--     pointer, the other /must/ be @NULL@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkAccelerationStructureTrianglesDisplacementMicromapNV-sType-sType#
--     @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_ACCELERATION_STRUCTURE_TRIANGLES_DISPLACEMENT_MICROMAP_NV'
--
-- -   #VUID-VkAccelerationStructureTrianglesDisplacementMicromapNV-displacementBiasAndScaleFormat-parameter#
--     @displacementBiasAndScaleFormat@ /must/ be a valid
--     'Vulkan.Core10.Enums.Format.Format' value
--
-- -   #VUID-VkAccelerationStructureTrianglesDisplacementMicromapNV-displacementVectorFormat-parameter#
--     @displacementVectorFormat@ /must/ be a valid
--     'Vulkan.Core10.Enums.Format.Format' value
--
-- -   #VUID-VkAccelerationStructureTrianglesDisplacementMicromapNV-indexType-parameter#
--     @indexType@ /must/ be a valid
--     'Vulkan.Core10.Enums.IndexType.IndexType' value
--
-- -   #VUID-VkAccelerationStructureTrianglesDisplacementMicromapNV-pUsageCounts-parameter#
--     If @usageCountsCount@ is not @0@, and @pUsageCounts@ is not @NULL@,
--     @pUsageCounts@ /must/ be a valid pointer to an array of
--     @usageCountsCount@
--     'Vulkan.Extensions.VK_EXT_opacity_micromap.MicromapUsageEXT'
--     structures
--
-- -   #VUID-VkAccelerationStructureTrianglesDisplacementMicromapNV-ppUsageCounts-parameter#
--     If @usageCountsCount@ is not @0@, and @ppUsageCounts@ is not @NULL@,
--     @ppUsageCounts@ /must/ be a valid pointer to an array of
--     @usageCountsCount@ valid pointers to
--     'Vulkan.Extensions.VK_EXT_opacity_micromap.MicromapUsageEXT'
--     structures
--
-- -   #VUID-VkAccelerationStructureTrianglesDisplacementMicromapNV-micromap-parameter#
--     If @micromap@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @micromap@ /must/ be a valid 'Vulkan.Extensions.Handles.MicromapEXT'
--     handle
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_displacement_micromap VK_NV_displacement_micromap>,
-- 'Vulkan.Extensions.VK_KHR_acceleration_structure.DeviceOrHostAddressConstKHR',
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize',
-- 'Vulkan.Core10.Enums.Format.Format',
-- 'Vulkan.Core10.Enums.IndexType.IndexType',
-- 'Vulkan.Extensions.Handles.MicromapEXT',
-- 'Vulkan.Extensions.VK_EXT_opacity_micromap.MicromapUsageEXT',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data AccelerationStructureTrianglesDisplacementMicromapNV = AccelerationStructureTrianglesDisplacementMicromapNV
  { -- | @displacementBiasAndScaleFormat@ is the format of displacement bias and
    -- scale used in this displacement micromap reference.
    AccelerationStructureTrianglesDisplacementMicromapNV -> Format
displacementBiasAndScaleFormat :: Format
  , -- | @displacementVectorFormat@ is the format of displacement vector used in
    -- this displacement micromap reference.
    AccelerationStructureTrianglesDisplacementMicromapNV -> Format
displacementVectorFormat :: Format
  , -- | @displacementBiasAndScaleBuffer@ is the address containing the bias and
    -- scale.
    AccelerationStructureTrianglesDisplacementMicromapNV
-> DeviceOrHostAddressConstKHR
displacementBiasAndScaleBuffer :: DeviceOrHostAddressConstKHR
  , -- | @displacementBiasAndScaleStride@ is the byte stride between bias and
    -- scale values.
    AccelerationStructureTrianglesDisplacementMicromapNV -> DeviceSize
displacementBiasAndScaleStride :: DeviceSize
  , -- | @displacementVectorBuffer@ is the address containing the displacement
    -- vector values.
    AccelerationStructureTrianglesDisplacementMicromapNV
-> DeviceOrHostAddressConstKHR
displacementVectorBuffer :: DeviceOrHostAddressConstKHR
  , -- | @displacementVectorStride@ is the byte stride between displacement
    -- vector values.
    AccelerationStructureTrianglesDisplacementMicromapNV -> DeviceSize
displacementVectorStride :: DeviceSize
  , -- | @displacedMicromapPrimitiveFlags@ is the address containing the
    -- primitive flags.
    AccelerationStructureTrianglesDisplacementMicromapNV
-> DeviceOrHostAddressConstKHR
displacedMicromapPrimitiveFlags :: DeviceOrHostAddressConstKHR
  , -- | @displacedMicromapPrimitiveFlagsStride@ is the byte stride between
    -- primitive flag values.
    AccelerationStructureTrianglesDisplacementMicromapNV -> DeviceSize
displacedMicromapPrimitiveFlagsStride :: DeviceSize
  , -- | @indexType@ is the type of triangle indices used when indexing this
    -- micromap.
    AccelerationStructureTrianglesDisplacementMicromapNV -> IndexType
indexType :: IndexType
  , -- | @indexBuffer@ is the address containing the triangle indices.
    AccelerationStructureTrianglesDisplacementMicromapNV
-> DeviceOrHostAddressConstKHR
indexBuffer :: DeviceOrHostAddressConstKHR
  , -- | @indexStride@ is the byte stride between triangle indices.
    AccelerationStructureTrianglesDisplacementMicromapNV -> DeviceSize
indexStride :: DeviceSize
  , -- | @baseTriangle@ is the base value added to the non-negative triangle
    -- indices.
    AccelerationStructureTrianglesDisplacementMicromapNV -> Word32
baseTriangle :: Word32
  , -- | @pUsageCounts@ is a pointer to an array of
    -- 'Vulkan.Extensions.VK_EXT_opacity_micromap.MicromapUsageEXT' structures.
    AccelerationStructureTrianglesDisplacementMicromapNV
-> Vector MicromapUsageEXT
usageCounts :: Vector MicromapUsageEXT
  , -- | @micromap@ is the handle to the micromap object to include in this
    -- geometry.
    AccelerationStructureTrianglesDisplacementMicromapNV -> MicromapEXT
micromap :: MicromapEXT
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (AccelerationStructureTrianglesDisplacementMicromapNV)
#endif
deriving instance Show AccelerationStructureTrianglesDisplacementMicromapNV

instance ToCStruct AccelerationStructureTrianglesDisplacementMicromapNV where
  withCStruct :: forall b.
AccelerationStructureTrianglesDisplacementMicromapNV
-> (Ptr AccelerationStructureTrianglesDisplacementMicromapNV
    -> IO b)
-> IO b
withCStruct AccelerationStructureTrianglesDisplacementMicromapNV
x Ptr AccelerationStructureTrianglesDisplacementMicromapNV -> IO b
f = Int
-> (Ptr AccelerationStructureTrianglesDisplacementMicromapNV
    -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
128 ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV -> IO b)
 -> IO b)
-> (Ptr AccelerationStructureTrianglesDisplacementMicromapNV
    -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p -> Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> AccelerationStructureTrianglesDisplacementMicromapNV
-> IO b
-> IO b
forall b.
Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> AccelerationStructureTrianglesDisplacementMicromapNV
-> IO b
-> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p AccelerationStructureTrianglesDisplacementMicromapNV
x (Ptr AccelerationStructureTrianglesDisplacementMicromapNV -> IO b
f Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p)
  pokeCStruct :: forall b.
Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> AccelerationStructureTrianglesDisplacementMicromapNV
-> IO b
-> IO b
pokeCStruct Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p AccelerationStructureTrianglesDisplacementMicromapNV{Word32
DeviceSize
Vector MicromapUsageEXT
IndexType
Format
MicromapEXT
DeviceOrHostAddressConstKHR
$sel:displacementBiasAndScaleFormat:AccelerationStructureTrianglesDisplacementMicromapNV :: AccelerationStructureTrianglesDisplacementMicromapNV -> Format
$sel:displacementVectorFormat:AccelerationStructureTrianglesDisplacementMicromapNV :: AccelerationStructureTrianglesDisplacementMicromapNV -> Format
$sel:displacementBiasAndScaleBuffer:AccelerationStructureTrianglesDisplacementMicromapNV :: AccelerationStructureTrianglesDisplacementMicromapNV
-> DeviceOrHostAddressConstKHR
$sel:displacementBiasAndScaleStride:AccelerationStructureTrianglesDisplacementMicromapNV :: AccelerationStructureTrianglesDisplacementMicromapNV -> DeviceSize
$sel:displacementVectorBuffer:AccelerationStructureTrianglesDisplacementMicromapNV :: AccelerationStructureTrianglesDisplacementMicromapNV
-> DeviceOrHostAddressConstKHR
$sel:displacementVectorStride:AccelerationStructureTrianglesDisplacementMicromapNV :: AccelerationStructureTrianglesDisplacementMicromapNV -> DeviceSize
$sel:displacedMicromapPrimitiveFlags:AccelerationStructureTrianglesDisplacementMicromapNV :: AccelerationStructureTrianglesDisplacementMicromapNV
-> DeviceOrHostAddressConstKHR
$sel:displacedMicromapPrimitiveFlagsStride:AccelerationStructureTrianglesDisplacementMicromapNV :: AccelerationStructureTrianglesDisplacementMicromapNV -> DeviceSize
$sel:indexType:AccelerationStructureTrianglesDisplacementMicromapNV :: AccelerationStructureTrianglesDisplacementMicromapNV -> IndexType
$sel:indexBuffer:AccelerationStructureTrianglesDisplacementMicromapNV :: AccelerationStructureTrianglesDisplacementMicromapNV
-> DeviceOrHostAddressConstKHR
$sel:indexStride:AccelerationStructureTrianglesDisplacementMicromapNV :: AccelerationStructureTrianglesDisplacementMicromapNV -> DeviceSize
$sel:baseTriangle:AccelerationStructureTrianglesDisplacementMicromapNV :: AccelerationStructureTrianglesDisplacementMicromapNV -> Word32
$sel:usageCounts:AccelerationStructureTrianglesDisplacementMicromapNV :: AccelerationStructureTrianglesDisplacementMicromapNV
-> Vector MicromapUsageEXT
$sel:micromap:AccelerationStructureTrianglesDisplacementMicromapNV :: AccelerationStructureTrianglesDisplacementMicromapNV -> MicromapEXT
displacementBiasAndScaleFormat :: Format
displacementVectorFormat :: Format
displacementBiasAndScaleBuffer :: DeviceOrHostAddressConstKHR
displacementBiasAndScaleStride :: DeviceSize
displacementVectorBuffer :: DeviceOrHostAddressConstKHR
displacementVectorStride :: DeviceSize
displacedMicromapPrimitiveFlags :: DeviceOrHostAddressConstKHR
displacedMicromapPrimitiveFlagsStride :: DeviceSize
indexType :: IndexType
indexBuffer :: DeviceOrHostAddressConstKHR
indexStride :: DeviceSize
baseTriangle :: Word32
usageCounts :: Vector MicromapUsageEXT
micromap :: MicromapEXT
..} IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_ACCELERATION_STRUCTURE_TRIANGLES_DISPLACEMENT_MICROMAP_NV)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Format)) (Format
displacementBiasAndScaleFormat)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Format)) (Format
displacementVectorFormat)
    ((() -> IO b) -> IO b) -> ContT b IO ()
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr DeviceOrHostAddressConstKHR
-> DeviceOrHostAddressConstKHR -> IO b -> IO b
forall b.
Ptr DeviceOrHostAddressConstKHR
-> DeviceOrHostAddressConstKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr DeviceOrHostAddressConstKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DeviceOrHostAddressConstKHR)) (DeviceOrHostAddressConstKHR
displacementBiasAndScaleBuffer) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr DeviceSize -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr DeviceSize)) (DeviceSize
displacementBiasAndScaleStride)
    ((() -> IO b) -> IO b) -> ContT b IO ()
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr DeviceOrHostAddressConstKHR
-> DeviceOrHostAddressConstKHR -> IO b -> IO b
forall b.
Ptr DeviceOrHostAddressConstKHR
-> DeviceOrHostAddressConstKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr DeviceOrHostAddressConstKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr DeviceOrHostAddressConstKHR)) (DeviceOrHostAddressConstKHR
displacementVectorBuffer) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr DeviceSize -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr DeviceSize)) (DeviceSize
displacementVectorStride)
    ((() -> IO b) -> IO b) -> ContT b IO ()
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr DeviceOrHostAddressConstKHR
-> DeviceOrHostAddressConstKHR -> IO b -> IO b
forall b.
Ptr DeviceOrHostAddressConstKHR
-> DeviceOrHostAddressConstKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr DeviceOrHostAddressConstKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr DeviceOrHostAddressConstKHR)) (DeviceOrHostAddressConstKHR
displacedMicromapPrimitiveFlags) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr DeviceSize -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr DeviceSize)) (DeviceSize
displacedMicromapPrimitiveFlagsStride)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr IndexType -> IndexType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr IndexType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr IndexType)) (IndexType
indexType)
    ((() -> IO b) -> IO b) -> ContT b IO ()
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr DeviceOrHostAddressConstKHR
-> DeviceOrHostAddressConstKHR -> IO b -> IO b
forall b.
Ptr DeviceOrHostAddressConstKHR
-> DeviceOrHostAddressConstKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr DeviceOrHostAddressConstKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80 :: Ptr DeviceOrHostAddressConstKHR)) (DeviceOrHostAddressConstKHR
indexBuffer) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr DeviceSize -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
88 :: Ptr DeviceSize)) (DeviceSize
indexStride)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
96 :: Ptr Word32)) (Word32
baseTriangle)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
100 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector MicromapUsageEXT -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector MicromapUsageEXT -> Int) -> Vector MicromapUsageEXT -> Int
forall a b. (a -> b) -> a -> b
$ (Vector MicromapUsageEXT
usageCounts)) :: Word32))
    Ptr MicromapUsageEXT
pPUsageCounts' <- ((Ptr MicromapUsageEXT -> IO b) -> IO b)
-> ContT b IO (Ptr MicromapUsageEXT)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr MicromapUsageEXT -> IO b) -> IO b)
 -> ContT b IO (Ptr MicromapUsageEXT))
-> ((Ptr MicromapUsageEXT -> IO b) -> IO b)
-> ContT b IO (Ptr MicromapUsageEXT)
forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @MicromapUsageEXT ((Vector MicromapUsageEXT -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector MicromapUsageEXT
usageCounts)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
12)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> MicromapUsageEXT -> IO ())
-> Vector MicromapUsageEXT -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i MicromapUsageEXT
e -> Ptr MicromapUsageEXT -> MicromapUsageEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr MicromapUsageEXT
pPUsageCounts' Ptr MicromapUsageEXT -> Int -> Ptr MicromapUsageEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MicromapUsageEXT) (MicromapUsageEXT
e)) (Vector MicromapUsageEXT
usageCounts)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr MicromapUsageEXT) -> Ptr MicromapUsageEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr (Ptr MicromapUsageEXT)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
104 :: Ptr (Ptr MicromapUsageEXT))) (Ptr MicromapUsageEXT
pPUsageCounts')
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr (Ptr MicromapUsageEXT))
-> Ptr (Ptr MicromapUsageEXT) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr (Ptr (Ptr MicromapUsageEXT))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
112 :: Ptr (Ptr (Ptr MicromapUsageEXT)))) (Ptr (Ptr MicromapUsageEXT)
forall a. Ptr a
nullPtr)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr MicromapEXT -> MicromapEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr MicromapEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
120 :: Ptr MicromapEXT)) (MicromapEXT
micromap)
    IO b -> ContT b IO b
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = Int
128
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> IO b -> IO b
pokeZeroCStruct Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_ACCELERATION_STRUCTURE_TRIANGLES_DISPLACEMENT_MICROMAP_NV)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Format)) (Format
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Format)) (Format
forall a. Zero a => a
zero)
    ((() -> IO b) -> IO b) -> ContT b IO ()
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr DeviceOrHostAddressConstKHR
-> DeviceOrHostAddressConstKHR -> IO b -> IO b
forall b.
Ptr DeviceOrHostAddressConstKHR
-> DeviceOrHostAddressConstKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr DeviceOrHostAddressConstKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DeviceOrHostAddressConstKHR)) (DeviceOrHostAddressConstKHR
forall a. Zero a => a
zero) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr DeviceSize -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr DeviceSize)) (DeviceSize
forall a. Zero a => a
zero)
    ((() -> IO b) -> IO b) -> ContT b IO ()
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr DeviceOrHostAddressConstKHR
-> DeviceOrHostAddressConstKHR -> IO b -> IO b
forall b.
Ptr DeviceOrHostAddressConstKHR
-> DeviceOrHostAddressConstKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr DeviceOrHostAddressConstKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr DeviceOrHostAddressConstKHR)) (DeviceOrHostAddressConstKHR
forall a. Zero a => a
zero) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr DeviceSize -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr DeviceSize)) (DeviceSize
forall a. Zero a => a
zero)
    ((() -> IO b) -> IO b) -> ContT b IO ()
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr DeviceOrHostAddressConstKHR
-> DeviceOrHostAddressConstKHR -> IO b -> IO b
forall b.
Ptr DeviceOrHostAddressConstKHR
-> DeviceOrHostAddressConstKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr DeviceOrHostAddressConstKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr DeviceOrHostAddressConstKHR)) (DeviceOrHostAddressConstKHR
forall a. Zero a => a
zero) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr DeviceSize -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr DeviceSize)) (DeviceSize
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr IndexType -> IndexType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr IndexType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr IndexType)) (IndexType
forall a. Zero a => a
zero)
    ((() -> IO b) -> IO b) -> ContT b IO ()
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr DeviceOrHostAddressConstKHR
-> DeviceOrHostAddressConstKHR -> IO b -> IO b
forall b.
Ptr DeviceOrHostAddressConstKHR
-> DeviceOrHostAddressConstKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr DeviceOrHostAddressConstKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80 :: Ptr DeviceOrHostAddressConstKHR)) (DeviceOrHostAddressConstKHR
forall a. Zero a => a
zero) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr DeviceSize -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
88 :: Ptr DeviceSize)) (DeviceSize
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
96 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr (Ptr MicromapUsageEXT))
-> Ptr (Ptr MicromapUsageEXT) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AccelerationStructureTrianglesDisplacementMicromapNV
p Ptr AccelerationStructureTrianglesDisplacementMicromapNV
-> Int -> Ptr (Ptr (Ptr MicromapUsageEXT))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
112 :: Ptr (Ptr (Ptr MicromapUsageEXT)))) (Ptr (Ptr MicromapUsageEXT)
forall a. Ptr a
nullPtr)
    IO b -> ContT b IO b
forall (m :: * -> *) a. Monad m => m a -> ContT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

instance Zero AccelerationStructureTrianglesDisplacementMicromapNV where
  zero :: AccelerationStructureTrianglesDisplacementMicromapNV
zero = Format
-> Format
-> DeviceOrHostAddressConstKHR
-> DeviceSize
-> DeviceOrHostAddressConstKHR
-> DeviceSize
-> DeviceOrHostAddressConstKHR
-> DeviceSize
-> IndexType
-> DeviceOrHostAddressConstKHR
-> DeviceSize
-> Word32
-> Vector MicromapUsageEXT
-> MicromapEXT
-> AccelerationStructureTrianglesDisplacementMicromapNV
AccelerationStructureTrianglesDisplacementMicromapNV
           Format
forall a. Zero a => a
zero
           Format
forall a. Zero a => a
zero
           DeviceOrHostAddressConstKHR
forall a. Zero a => a
zero
           DeviceSize
forall a. Zero a => a
zero
           DeviceOrHostAddressConstKHR
forall a. Zero a => a
zero
           DeviceSize
forall a. Zero a => a
zero
           DeviceOrHostAddressConstKHR
forall a. Zero a => a
zero
           DeviceSize
forall a. Zero a => a
zero
           IndexType
forall a. Zero a => a
zero
           DeviceOrHostAddressConstKHR
forall a. Zero a => a
zero
           DeviceSize
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Vector MicromapUsageEXT
forall a. Monoid a => a
mempty
           MicromapEXT
forall a. Zero a => a
zero


-- | VkDisplacementMicromapFormatNV - Format enum for displacement micromaps
--
-- = Description
--
-- Note
--
-- For compactness, these values are stored as 16-bit in some structures.
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_displacement_micromap VK_NV_displacement_micromap>
newtype DisplacementMicromapFormatNV = DisplacementMicromapFormatNV Int32
  deriving newtype (DisplacementMicromapFormatNV
-> DisplacementMicromapFormatNV -> Bool
(DisplacementMicromapFormatNV
 -> DisplacementMicromapFormatNV -> Bool)
-> (DisplacementMicromapFormatNV
    -> DisplacementMicromapFormatNV -> Bool)
-> Eq DisplacementMicromapFormatNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DisplacementMicromapFormatNV
-> DisplacementMicromapFormatNV -> Bool
== :: DisplacementMicromapFormatNV
-> DisplacementMicromapFormatNV -> Bool
$c/= :: DisplacementMicromapFormatNV
-> DisplacementMicromapFormatNV -> Bool
/= :: DisplacementMicromapFormatNV
-> DisplacementMicromapFormatNV -> Bool
Eq, Eq DisplacementMicromapFormatNV
Eq DisplacementMicromapFormatNV =>
(DisplacementMicromapFormatNV
 -> DisplacementMicromapFormatNV -> Ordering)
-> (DisplacementMicromapFormatNV
    -> DisplacementMicromapFormatNV -> Bool)
-> (DisplacementMicromapFormatNV
    -> DisplacementMicromapFormatNV -> Bool)
-> (DisplacementMicromapFormatNV
    -> DisplacementMicromapFormatNV -> Bool)
-> (DisplacementMicromapFormatNV
    -> DisplacementMicromapFormatNV -> Bool)
-> (DisplacementMicromapFormatNV
    -> DisplacementMicromapFormatNV -> DisplacementMicromapFormatNV)
-> (DisplacementMicromapFormatNV
    -> DisplacementMicromapFormatNV -> DisplacementMicromapFormatNV)
-> Ord DisplacementMicromapFormatNV
DisplacementMicromapFormatNV
-> DisplacementMicromapFormatNV -> Bool
DisplacementMicromapFormatNV
-> DisplacementMicromapFormatNV -> Ordering
DisplacementMicromapFormatNV
-> DisplacementMicromapFormatNV -> DisplacementMicromapFormatNV
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
$ccompare :: DisplacementMicromapFormatNV
-> DisplacementMicromapFormatNV -> Ordering
compare :: DisplacementMicromapFormatNV
-> DisplacementMicromapFormatNV -> Ordering
$c< :: DisplacementMicromapFormatNV
-> DisplacementMicromapFormatNV -> Bool
< :: DisplacementMicromapFormatNV
-> DisplacementMicromapFormatNV -> Bool
$c<= :: DisplacementMicromapFormatNV
-> DisplacementMicromapFormatNV -> Bool
<= :: DisplacementMicromapFormatNV
-> DisplacementMicromapFormatNV -> Bool
$c> :: DisplacementMicromapFormatNV
-> DisplacementMicromapFormatNV -> Bool
> :: DisplacementMicromapFormatNV
-> DisplacementMicromapFormatNV -> Bool
$c>= :: DisplacementMicromapFormatNV
-> DisplacementMicromapFormatNV -> Bool
>= :: DisplacementMicromapFormatNV
-> DisplacementMicromapFormatNV -> Bool
$cmax :: DisplacementMicromapFormatNV
-> DisplacementMicromapFormatNV -> DisplacementMicromapFormatNV
max :: DisplacementMicromapFormatNV
-> DisplacementMicromapFormatNV -> DisplacementMicromapFormatNV
$cmin :: DisplacementMicromapFormatNV
-> DisplacementMicromapFormatNV -> DisplacementMicromapFormatNV
min :: DisplacementMicromapFormatNV
-> DisplacementMicromapFormatNV -> DisplacementMicromapFormatNV
Ord, Ptr DisplacementMicromapFormatNV -> IO DisplacementMicromapFormatNV
Ptr DisplacementMicromapFormatNV
-> Int -> IO DisplacementMicromapFormatNV
Ptr DisplacementMicromapFormatNV
-> Int -> DisplacementMicromapFormatNV -> IO ()
Ptr DisplacementMicromapFormatNV
-> DisplacementMicromapFormatNV -> IO ()
DisplacementMicromapFormatNV -> Int
(DisplacementMicromapFormatNV -> Int)
-> (DisplacementMicromapFormatNV -> Int)
-> (Ptr DisplacementMicromapFormatNV
    -> Int -> IO DisplacementMicromapFormatNV)
-> (Ptr DisplacementMicromapFormatNV
    -> Int -> DisplacementMicromapFormatNV -> IO ())
-> (forall b. Ptr b -> Int -> IO DisplacementMicromapFormatNV)
-> (forall b.
    Ptr b -> Int -> DisplacementMicromapFormatNV -> IO ())
-> (Ptr DisplacementMicromapFormatNV
    -> IO DisplacementMicromapFormatNV)
-> (Ptr DisplacementMicromapFormatNV
    -> DisplacementMicromapFormatNV -> IO ())
-> Storable DisplacementMicromapFormatNV
forall b. Ptr b -> Int -> IO DisplacementMicromapFormatNV
forall b. Ptr b -> Int -> DisplacementMicromapFormatNV -> 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
$csizeOf :: DisplacementMicromapFormatNV -> Int
sizeOf :: DisplacementMicromapFormatNV -> Int
$calignment :: DisplacementMicromapFormatNV -> Int
alignment :: DisplacementMicromapFormatNV -> Int
$cpeekElemOff :: Ptr DisplacementMicromapFormatNV
-> Int -> IO DisplacementMicromapFormatNV
peekElemOff :: Ptr DisplacementMicromapFormatNV
-> Int -> IO DisplacementMicromapFormatNV
$cpokeElemOff :: Ptr DisplacementMicromapFormatNV
-> Int -> DisplacementMicromapFormatNV -> IO ()
pokeElemOff :: Ptr DisplacementMicromapFormatNV
-> Int -> DisplacementMicromapFormatNV -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO DisplacementMicromapFormatNV
peekByteOff :: forall b. Ptr b -> Int -> IO DisplacementMicromapFormatNV
$cpokeByteOff :: forall b. Ptr b -> Int -> DisplacementMicromapFormatNV -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> DisplacementMicromapFormatNV -> IO ()
$cpeek :: Ptr DisplacementMicromapFormatNV -> IO DisplacementMicromapFormatNV
peek :: Ptr DisplacementMicromapFormatNV -> IO DisplacementMicromapFormatNV
$cpoke :: Ptr DisplacementMicromapFormatNV
-> DisplacementMicromapFormatNV -> IO ()
poke :: Ptr DisplacementMicromapFormatNV
-> DisplacementMicromapFormatNV -> IO ()
Storable, DisplacementMicromapFormatNV
DisplacementMicromapFormatNV -> Zero DisplacementMicromapFormatNV
forall a. a -> Zero a
$czero :: DisplacementMicromapFormatNV
zero :: DisplacementMicromapFormatNV
Zero)

-- Note that the zero instance does not produce a valid value, passing 'zero' to Vulkan will result in an error

-- | 'DISPLACEMENT_MICROMAP_FORMAT_64_TRIANGLES_64_BYTES_NV' indicates that
-- the given micromap format encodes 64 micro-triangles worth of
-- displacements in 64 bytes as described in
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#displacement-micromap-encoding Displacement Micromap Encoding>.
pattern $bDISPLACEMENT_MICROMAP_FORMAT_64_TRIANGLES_64_BYTES_NV :: DisplacementMicromapFormatNV
$mDISPLACEMENT_MICROMAP_FORMAT_64_TRIANGLES_64_BYTES_NV :: forall {r}.
DisplacementMicromapFormatNV -> ((# #) -> r) -> ((# #) -> r) -> r
DISPLACEMENT_MICROMAP_FORMAT_64_TRIANGLES_64_BYTES_NV = DisplacementMicromapFormatNV 1

-- | 'DISPLACEMENT_MICROMAP_FORMAT_256_TRIANGLES_128_BYTES_NV' indicates that
-- the given micromap format encodes 256 micro-triangles worth of
-- displacements in 128 bytes as described in
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#displacement-micromap-encoding Displacement Micromap Encoding>.
pattern $bDISPLACEMENT_MICROMAP_FORMAT_256_TRIANGLES_128_BYTES_NV :: DisplacementMicromapFormatNV
$mDISPLACEMENT_MICROMAP_FORMAT_256_TRIANGLES_128_BYTES_NV :: forall {r}.
DisplacementMicromapFormatNV -> ((# #) -> r) -> ((# #) -> r) -> r
DISPLACEMENT_MICROMAP_FORMAT_256_TRIANGLES_128_BYTES_NV = DisplacementMicromapFormatNV 2

-- | 'DISPLACEMENT_MICROMAP_FORMAT_1024_TRIANGLES_128_BYTES_NV' indicates
-- that the given micromap format encodes 1024 micro-triangles worth of
-- displacements in 128 bytes as described in
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#displacement-micromap-encoding Displacement Micromap Encoding>.
pattern $bDISPLACEMENT_MICROMAP_FORMAT_1024_TRIANGLES_128_BYTES_NV :: DisplacementMicromapFormatNV
$mDISPLACEMENT_MICROMAP_FORMAT_1024_TRIANGLES_128_BYTES_NV :: forall {r}.
DisplacementMicromapFormatNV -> ((# #) -> r) -> ((# #) -> r) -> r
DISPLACEMENT_MICROMAP_FORMAT_1024_TRIANGLES_128_BYTES_NV = DisplacementMicromapFormatNV 3

{-# COMPLETE
  DISPLACEMENT_MICROMAP_FORMAT_64_TRIANGLES_64_BYTES_NV
  , DISPLACEMENT_MICROMAP_FORMAT_256_TRIANGLES_128_BYTES_NV
  , DISPLACEMENT_MICROMAP_FORMAT_1024_TRIANGLES_128_BYTES_NV ::
    DisplacementMicromapFormatNV
  #-}

conNameDisplacementMicromapFormatNV :: String
conNameDisplacementMicromapFormatNV :: String
conNameDisplacementMicromapFormatNV = String
"DisplacementMicromapFormatNV"

enumPrefixDisplacementMicromapFormatNV :: String
enumPrefixDisplacementMicromapFormatNV :: String
enumPrefixDisplacementMicromapFormatNV = String
"DISPLACEMENT_MICROMAP_FORMAT_"

showTableDisplacementMicromapFormatNV :: [(DisplacementMicromapFormatNV, String)]
showTableDisplacementMicromapFormatNV :: [(DisplacementMicromapFormatNV, String)]
showTableDisplacementMicromapFormatNV =
  [
    ( DisplacementMicromapFormatNV
DISPLACEMENT_MICROMAP_FORMAT_64_TRIANGLES_64_BYTES_NV
    , String
"64_TRIANGLES_64_BYTES_NV"
    )
  ,
    ( DisplacementMicromapFormatNV
DISPLACEMENT_MICROMAP_FORMAT_256_TRIANGLES_128_BYTES_NV
    , String
"256_TRIANGLES_128_BYTES_NV"
    )
  ,
    ( DisplacementMicromapFormatNV
DISPLACEMENT_MICROMAP_FORMAT_1024_TRIANGLES_128_BYTES_NV
    , String
"1024_TRIANGLES_128_BYTES_NV"
    )
  ]

instance Show DisplacementMicromapFormatNV where
  showsPrec :: Int -> DisplacementMicromapFormatNV -> ShowS
showsPrec =
    String
-> [(DisplacementMicromapFormatNV, String)]
-> String
-> (DisplacementMicromapFormatNV -> Int32)
-> (Int32 -> ShowS)
-> Int
-> DisplacementMicromapFormatNV
-> ShowS
forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
      String
enumPrefixDisplacementMicromapFormatNV
      [(DisplacementMicromapFormatNV, String)]
showTableDisplacementMicromapFormatNV
      String
conNameDisplacementMicromapFormatNV
      (\(DisplacementMicromapFormatNV Int32
x) -> Int32
x)
      (Int -> Int32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11)

instance Read DisplacementMicromapFormatNV where
  readPrec :: ReadPrec DisplacementMicromapFormatNV
readPrec =
    String
-> [(DisplacementMicromapFormatNV, String)]
-> String
-> (Int32 -> DisplacementMicromapFormatNV)
-> ReadPrec DisplacementMicromapFormatNV
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
      String
enumPrefixDisplacementMicromapFormatNV
      [(DisplacementMicromapFormatNV, String)]
showTableDisplacementMicromapFormatNV
      String
conNameDisplacementMicromapFormatNV
      Int32 -> DisplacementMicromapFormatNV
DisplacementMicromapFormatNV

type NV_DISPLACEMENT_MICROMAP_SPEC_VERSION = 2

-- No documentation found for TopLevel "VK_NV_DISPLACEMENT_MICROMAP_SPEC_VERSION"
pattern NV_DISPLACEMENT_MICROMAP_SPEC_VERSION :: forall a . Integral a => a
pattern $bNV_DISPLACEMENT_MICROMAP_SPEC_VERSION :: forall a. Integral a => a
$mNV_DISPLACEMENT_MICROMAP_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
NV_DISPLACEMENT_MICROMAP_SPEC_VERSION = 2


type NV_DISPLACEMENT_MICROMAP_EXTENSION_NAME = "VK_NV_displacement_micromap"

-- No documentation found for TopLevel "VK_NV_DISPLACEMENT_MICROMAP_EXTENSION_NAME"
pattern NV_DISPLACEMENT_MICROMAP_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bNV_DISPLACEMENT_MICROMAP_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mNV_DISPLACEMENT_MICROMAP_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
NV_DISPLACEMENT_MICROMAP_EXTENSION_NAME = "VK_NV_displacement_micromap"