{-# language CPP #-}
-- | = Name
--
-- VK_EXT_mutable_descriptor_type - device extension
--
-- == VK_EXT_mutable_descriptor_type
--
-- [__Name String__]
--     @VK_EXT_mutable_descriptor_type@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     495
--
-- [__Revision__]
--     1
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires support for Vulkan 1.0
--
--     -   Requires @VK_KHR_maintenance3@ to be enabled for any
--         device-level functionality
--
-- [__Special Use__]
--
--     -   <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#extendingvulkan-compatibility-specialuse D3D support>
--
-- [__Contact__]
--
--     -   Joshua Ashton
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_EXT_mutable_descriptor_type] @Joshua-Ashton%0A*Here describe the issue or question you have about the VK_EXT_mutable_descriptor_type extension* >
--
--     -   Hans-Kristian Arntzen
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_EXT_mutable_descriptor_type] @HansKristian-Work%0A*Here describe the issue or question you have about the VK_EXT_mutable_descriptor_type extension* >
--
-- [__Extension Proposal__]
--     <https://github.com/KhronosGroup/Vulkan-Docs/tree/main/proposals/VK_EXT_mutable_descriptor_type.adoc VK_EXT_mutable_descriptor_type>
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2022-08-22
--
-- [__IP Status__]
--     No known IP claims.
--
-- [__Contributors__]
--
--     -   Joshua Ashton, Valve
--
--     -   Hans-Kristian Arntzen, Valve
--
-- == Description
--
-- This extension allows applications to reduce descriptor memory footprint
-- by allowing a descriptor to be able to mutate to a given list of
-- descriptor types depending on which descriptor types are written into,
-- or copied into a descriptor set.
--
-- The main use case this extension intends to address is descriptor
-- indexing with
-- 'Vulkan.Core12.Enums.DescriptorBindingFlagBits.DESCRIPTOR_BINDING_VARIABLE_DESCRIPTOR_COUNT_BIT'
-- where the descriptor types are completely generic, as this means
-- applications can allocate one large descriptor set, rather than having
-- one large descriptor set per descriptor type, which significantly bloats
-- descriptor memory usage and causes performance issues.
--
-- This extension also adds a mechanism to declare that a descriptor pool,
-- and therefore the descriptor sets that are allocated from it, reside
-- only in host memory; as such these descriptors can only be
-- updated\/copied, but not bound.
--
-- These features together allow much more efficient emulation of the raw
-- D3D12 binding model. This extension is primarily intended to be useful
-- for API layering efforts.
--
-- == New Structures
--
-- -   'MutableDescriptorTypeListEXT'
--
-- -   Extending
--     'Vulkan.Core10.DescriptorSet.DescriptorSetLayoutCreateInfo',
--     'Vulkan.Core10.DescriptorSet.DescriptorPoolCreateInfo':
--
--     -   'MutableDescriptorTypeCreateInfoEXT'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDeviceMutableDescriptorTypeFeaturesEXT'
--
-- == New Enum Constants
--
-- -   'EXT_MUTABLE_DESCRIPTOR_TYPE_EXTENSION_NAME'
--
-- -   'EXT_MUTABLE_DESCRIPTOR_TYPE_SPEC_VERSION'
--
-- -   Extending
--     'Vulkan.Core10.Enums.DescriptorPoolCreateFlagBits.DescriptorPoolCreateFlagBits':
--
--     -   'Vulkan.Core10.Enums.DescriptorPoolCreateFlagBits.DESCRIPTOR_POOL_CREATE_HOST_ONLY_BIT_EXT'
--
-- -   Extending
--     'Vulkan.Core10.Enums.DescriptorSetLayoutCreateFlagBits.DescriptorSetLayoutCreateFlagBits':
--
--     -   'Vulkan.Core10.Enums.DescriptorSetLayoutCreateFlagBits.DESCRIPTOR_SET_LAYOUT_CREATE_HOST_ONLY_POOL_BIT_EXT'
--
-- -   Extending 'Vulkan.Core10.Enums.DescriptorType.DescriptorType':
--
--     -   'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_MUTABLE_EXT'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_MUTABLE_DESCRIPTOR_TYPE_CREATE_INFO_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_MUTABLE_DESCRIPTOR_TYPE_FEATURES_EXT'
--
-- == Version History
--
-- -   Revision 1, 2022-08-22 (Jon Leech)
--
--     -   Initial version, promoted from
--         <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VALVE_mutable_descriptor_type VK_VALVE_mutable_descriptor_type>.
--
-- == See Also
--
-- 'MutableDescriptorTypeCreateInfoEXT', 'MutableDescriptorTypeListEXT',
-- 'PhysicalDeviceMutableDescriptorTypeFeaturesEXT'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_EXT_mutable_descriptor_type Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_EXT_mutable_descriptor_type  ( PhysicalDeviceMutableDescriptorTypeFeaturesEXT(..)
                                                         , MutableDescriptorTypeListEXT(..)
                                                         , MutableDescriptorTypeCreateInfoEXT(..)
                                                         , EXT_MUTABLE_DESCRIPTOR_TYPE_SPEC_VERSION
                                                         , pattern EXT_MUTABLE_DESCRIPTOR_TYPE_SPEC_VERSION
                                                         , EXT_MUTABLE_DESCRIPTOR_TYPE_EXTENSION_NAME
                                                         , pattern EXT_MUTABLE_DESCRIPTOR_TYPE_EXTENSION_NAME
                                                         ) where

import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
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 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 Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.CStruct.Utils (advancePtrBytes)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Enums.DescriptorType (DescriptorType)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_MUTABLE_DESCRIPTOR_TYPE_CREATE_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_MUTABLE_DESCRIPTOR_TYPE_FEATURES_EXT))
-- | VkPhysicalDeviceMutableDescriptorTypeFeaturesEXT - Structure describing
-- whether the mutable descriptor type is supported
--
-- = Members
--
-- This structure describes the following feature:
--
-- = Description
--
-- -   @sType@ is the type of this structure.
--
-- -   @pNext@ is @NULL@ or a pointer to a structure extending this
--     structure.
--
-- -   #features-mutableDescriptorType# @mutableDescriptorType@ indicates
--     that the implementation /must/ support using the
--     'Vulkan.Core10.Enums.DescriptorType.DescriptorType' of
--     'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_MUTABLE_EXT'
--     with at least the following descriptor types, where any combination
--     of the types /must/ be supported:
--
--     -   'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_SAMPLED_IMAGE'
--
--     -   'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_STORAGE_IMAGE'
--
--     -   'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_UNIFORM_TEXEL_BUFFER'
--
--     -   'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_STORAGE_TEXEL_BUFFER'
--
--     -   'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_UNIFORM_BUFFER'
--
--     -   'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_STORAGE_BUFFER'
--
-- -   Additionally, @mutableDescriptorType@ indicates that:
--
--     -   Non-uniform descriptor indexing /must/ be supported if all
--         descriptor types in a 'MutableDescriptorTypeListEXT' for
--         'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_MUTABLE_EXT'
--         have the corresponding non-uniform indexing features enabled in
--         'Vulkan.Core12.Promoted_From_VK_EXT_descriptor_indexing.PhysicalDeviceDescriptorIndexingFeatures'.
--
--     -   'Vulkan.Core12.Enums.DescriptorBindingFlagBits.DESCRIPTOR_BINDING_UPDATE_AFTER_BIND_BIT'
--         with @descriptorType@ of
--         'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_MUTABLE_EXT'
--         relaxes the list of required descriptor types to the descriptor
--         types which have the corresponding update-after-bind feature
--         enabled in
--         'Vulkan.Core12.Promoted_From_VK_EXT_descriptor_indexing.PhysicalDeviceDescriptorIndexingFeatures'.
--
--     -   Dynamically uniform descriptor indexing /must/ be supported if
--         all descriptor types in a 'MutableDescriptorTypeListEXT' for
--         'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_MUTABLE_EXT'
--         have the corresponding dynamic indexing features enabled.
--
--     -   'Vulkan.Core10.Enums.DescriptorSetLayoutCreateFlagBits.DESCRIPTOR_SET_LAYOUT_CREATE_HOST_ONLY_POOL_BIT_EXT'
--         /must/ be supported.
--
--     -   'Vulkan.Core10.Enums.DescriptorPoolCreateFlagBits.DESCRIPTOR_POOL_CREATE_HOST_ONLY_BIT_EXT'
--         /must/ be supported.
--
-- If the 'PhysicalDeviceMutableDescriptorTypeFeaturesEXT' 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. 'PhysicalDeviceMutableDescriptorTypeFeaturesEXT' /can/ also
-- be used in the @pNext@ chain of 'Vulkan.Core10.Device.DeviceCreateInfo'
-- to selectively enable these features.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkPhysicalDeviceMutableDescriptorTypeFeaturesEXT-sType-sType#
--     @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_MUTABLE_DESCRIPTOR_TYPE_FEATURES_EXT'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_mutable_descriptor_type VK_EXT_mutable_descriptor_type>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VALVE_mutable_descriptor_type VK_VALVE_mutable_descriptor_type>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceMutableDescriptorTypeFeaturesEXT = PhysicalDeviceMutableDescriptorTypeFeaturesEXT
  { -- No documentation found for Nested "VkPhysicalDeviceMutableDescriptorTypeFeaturesEXT" "mutableDescriptorType"
    PhysicalDeviceMutableDescriptorTypeFeaturesEXT -> Bool
mutableDescriptorType :: Bool }
  deriving (Typeable, PhysicalDeviceMutableDescriptorTypeFeaturesEXT
-> PhysicalDeviceMutableDescriptorTypeFeaturesEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceMutableDescriptorTypeFeaturesEXT
-> PhysicalDeviceMutableDescriptorTypeFeaturesEXT -> Bool
$c/= :: PhysicalDeviceMutableDescriptorTypeFeaturesEXT
-> PhysicalDeviceMutableDescriptorTypeFeaturesEXT -> Bool
== :: PhysicalDeviceMutableDescriptorTypeFeaturesEXT
-> PhysicalDeviceMutableDescriptorTypeFeaturesEXT -> Bool
$c== :: PhysicalDeviceMutableDescriptorTypeFeaturesEXT
-> PhysicalDeviceMutableDescriptorTypeFeaturesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceMutableDescriptorTypeFeaturesEXT)
#endif
deriving instance Show PhysicalDeviceMutableDescriptorTypeFeaturesEXT

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

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

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

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


-- | VkMutableDescriptorTypeListEXT - Structure describing descriptor types
-- that a given descriptor may mutate to
--
-- == Valid Usage
--
-- -   #VUID-VkMutableDescriptorTypeListEXT-descriptorTypeCount-04597#
--     @descriptorTypeCount@ /must/ not be @0@ if the corresponding binding
--     is of
--     'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_MUTABLE_EXT'
--
-- -   #VUID-VkMutableDescriptorTypeListEXT-pDescriptorTypes-04598#
--     @pDescriptorTypes@ /must/ be a valid pointer to an array of
--     @descriptorTypeCount@ valid, unique
--     'Vulkan.Core10.Enums.DescriptorType.DescriptorType' values if the
--     given binding is of
--     'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_MUTABLE_EXT'
--     type
--
-- -   #VUID-VkMutableDescriptorTypeListEXT-descriptorTypeCount-04599#
--     @descriptorTypeCount@ /must/ be @0@ if the corresponding binding is
--     not of
--     'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_MUTABLE_EXT'
--
-- -   #VUID-VkMutableDescriptorTypeListEXT-pDescriptorTypes-04600#
--     @pDescriptorTypes@ /must/ not contain
--     'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_MUTABLE_EXT'
--
-- -   #VUID-VkMutableDescriptorTypeListEXT-pDescriptorTypes-04601#
--     @pDescriptorTypes@ /must/ not contain
--     'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_STORAGE_BUFFER_DYNAMIC'
--
-- -   #VUID-VkMutableDescriptorTypeListEXT-pDescriptorTypes-04602#
--     @pDescriptorTypes@ /must/ not contain
--     'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_UNIFORM_BUFFER_DYNAMIC'
--
-- -   #VUID-VkMutableDescriptorTypeListEXT-pDescriptorTypes-04603#
--     @pDescriptorTypes@ /must/ not contain
--     'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_INLINE_UNIFORM_BLOCK'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkMutableDescriptorTypeListEXT-pDescriptorTypes-parameter# If
--     @descriptorTypeCount@ is not @0@, @pDescriptorTypes@ /must/ be a
--     valid pointer to an array of @descriptorTypeCount@ valid
--     'Vulkan.Core10.Enums.DescriptorType.DescriptorType' values
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_mutable_descriptor_type VK_EXT_mutable_descriptor_type>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VALVE_mutable_descriptor_type VK_VALVE_mutable_descriptor_type>,
-- 'Vulkan.Core10.Enums.DescriptorType.DescriptorType',
-- 'MutableDescriptorTypeCreateInfoEXT'
data MutableDescriptorTypeListEXT = MutableDescriptorTypeListEXT
  { -- | @pDescriptorTypes@ is @NULL@ or a pointer to an array of
    -- @descriptorTypeCount@
    -- 'Vulkan.Core10.Enums.DescriptorType.DescriptorType' values defining
    -- which descriptor types a given binding may mutate to.
    MutableDescriptorTypeListEXT -> Vector DescriptorType
descriptorTypes :: Vector DescriptorType }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MutableDescriptorTypeListEXT)
#endif
deriving instance Show MutableDescriptorTypeListEXT

instance ToCStruct MutableDescriptorTypeListEXT where
  withCStruct :: forall b.
MutableDescriptorTypeListEXT
-> (Ptr MutableDescriptorTypeListEXT -> IO b) -> IO b
withCStruct MutableDescriptorTypeListEXT
x Ptr MutableDescriptorTypeListEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
16 forall a b. (a -> b) -> a -> b
$ \Ptr MutableDescriptorTypeListEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr MutableDescriptorTypeListEXT
p MutableDescriptorTypeListEXT
x (Ptr MutableDescriptorTypeListEXT -> IO b
f Ptr MutableDescriptorTypeListEXT
p)
  pokeCStruct :: forall b.
Ptr MutableDescriptorTypeListEXT
-> MutableDescriptorTypeListEXT -> IO b -> IO b
pokeCStruct Ptr MutableDescriptorTypeListEXT
p MutableDescriptorTypeListEXT{Vector DescriptorType
descriptorTypes :: Vector DescriptorType
$sel:descriptorTypes:MutableDescriptorTypeListEXT :: MutableDescriptorTypeListEXT -> Vector DescriptorType
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MutableDescriptorTypeListEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector DescriptorType
descriptorTypes)) :: Word32))
    Ptr DescriptorType
pPDescriptorTypes' <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @DescriptorType ((forall a. Vector a -> Int
Data.Vector.length (Vector DescriptorType
descriptorTypes)) forall a. Num a => a -> a -> a
* Int
4)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i DescriptorType
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr DescriptorType
pPDescriptorTypes' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
4 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr DescriptorType) (DescriptorType
e)) (Vector DescriptorType
descriptorTypes)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MutableDescriptorTypeListEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr DescriptorType))) (Ptr DescriptorType
pPDescriptorTypes')
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = Int
16
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr MutableDescriptorTypeListEXT -> IO b -> IO b
pokeZeroCStruct Ptr MutableDescriptorTypeListEXT
_ IO b
f = IO b
f

instance FromCStruct MutableDescriptorTypeListEXT where
  peekCStruct :: Ptr MutableDescriptorTypeListEXT -> IO MutableDescriptorTypeListEXT
peekCStruct Ptr MutableDescriptorTypeListEXT
p = do
    Word32
descriptorTypeCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr MutableDescriptorTypeListEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32))
    Ptr DescriptorType
pDescriptorTypes <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr DescriptorType) ((Ptr MutableDescriptorTypeListEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr DescriptorType)))
    Vector DescriptorType
pDescriptorTypes' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
descriptorTypeCount) (\Int
i -> forall a. Storable a => Ptr a -> IO a
peek @DescriptorType ((Ptr DescriptorType
pDescriptorTypes forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
4 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr DescriptorType)))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Vector DescriptorType -> MutableDescriptorTypeListEXT
MutableDescriptorTypeListEXT
             Vector DescriptorType
pDescriptorTypes'

instance Zero MutableDescriptorTypeListEXT where
  zero :: MutableDescriptorTypeListEXT
zero = Vector DescriptorType -> MutableDescriptorTypeListEXT
MutableDescriptorTypeListEXT
           forall a. Monoid a => a
mempty


-- | VkMutableDescriptorTypeCreateInfoEXT - Structure describing the list of
-- possible active descriptor types for mutable type descriptors
--
-- = Description
--
-- If @mutableDescriptorTypeListCount@ is zero or if this structure is not
-- included in the @pNext@ chain, the 'MutableDescriptorTypeListEXT' for
-- each element is considered to be zero or @NULL@ for each member.
-- Otherwise, the descriptor set layout binding at
-- 'Vulkan.Core10.DescriptorSet.DescriptorSetLayoutCreateInfo'::@pBindings@[i]
-- uses the descriptor type lists in
-- 'MutableDescriptorTypeCreateInfoEXT'::@pMutableDescriptorTypeLists@[i].
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkMutableDescriptorTypeCreateInfoEXT-sType-sType# @sType@
--     /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_MUTABLE_DESCRIPTOR_TYPE_CREATE_INFO_EXT'
--
-- -   #VUID-VkMutableDescriptorTypeCreateInfoEXT-pMutableDescriptorTypeLists-parameter#
--     If @mutableDescriptorTypeListCount@ is not @0@,
--     @pMutableDescriptorTypeLists@ /must/ be a valid pointer to an array
--     of @mutableDescriptorTypeListCount@ valid
--     'MutableDescriptorTypeListEXT' structures
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_mutable_descriptor_type VK_EXT_mutable_descriptor_type>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VALVE_mutable_descriptor_type VK_VALVE_mutable_descriptor_type>,
-- 'MutableDescriptorTypeListEXT',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data MutableDescriptorTypeCreateInfoEXT = MutableDescriptorTypeCreateInfoEXT
  { -- | @pMutableDescriptorTypeLists@ is a pointer to an array of
    -- 'MutableDescriptorTypeListEXT' structures.
    MutableDescriptorTypeCreateInfoEXT
-> Vector MutableDescriptorTypeListEXT
mutableDescriptorTypeLists :: Vector MutableDescriptorTypeListEXT }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MutableDescriptorTypeCreateInfoEXT)
#endif
deriving instance Show MutableDescriptorTypeCreateInfoEXT

instance ToCStruct MutableDescriptorTypeCreateInfoEXT where
  withCStruct :: forall b.
MutableDescriptorTypeCreateInfoEXT
-> (Ptr MutableDescriptorTypeCreateInfoEXT -> IO b) -> IO b
withCStruct MutableDescriptorTypeCreateInfoEXT
x Ptr MutableDescriptorTypeCreateInfoEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \Ptr MutableDescriptorTypeCreateInfoEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr MutableDescriptorTypeCreateInfoEXT
p MutableDescriptorTypeCreateInfoEXT
x (Ptr MutableDescriptorTypeCreateInfoEXT -> IO b
f Ptr MutableDescriptorTypeCreateInfoEXT
p)
  pokeCStruct :: forall b.
Ptr MutableDescriptorTypeCreateInfoEXT
-> MutableDescriptorTypeCreateInfoEXT -> IO b -> IO b
pokeCStruct Ptr MutableDescriptorTypeCreateInfoEXT
p MutableDescriptorTypeCreateInfoEXT{Vector MutableDescriptorTypeListEXT
mutableDescriptorTypeLists :: Vector MutableDescriptorTypeListEXT
$sel:mutableDescriptorTypeLists:MutableDescriptorTypeCreateInfoEXT :: MutableDescriptorTypeCreateInfoEXT
-> Vector MutableDescriptorTypeListEXT
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MutableDescriptorTypeCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MUTABLE_DESCRIPTOR_TYPE_CREATE_INFO_EXT)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MutableDescriptorTypeCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MutableDescriptorTypeCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector MutableDescriptorTypeListEXT
mutableDescriptorTypeLists)) :: Word32))
    Ptr MutableDescriptorTypeListEXT
pPMutableDescriptorTypeLists' <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @MutableDescriptorTypeListEXT ((forall a. Vector a -> Int
Data.Vector.length (Vector MutableDescriptorTypeListEXT
mutableDescriptorTypeLists)) forall a. Num a => a -> a -> a
* Int
16)
    forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i MutableDescriptorTypeListEXT
e -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (Ptr MutableDescriptorTypeListEXT
pPMutableDescriptorTypeLists' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
16 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MutableDescriptorTypeListEXT) (MutableDescriptorTypeListEXT
e) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())) (Vector MutableDescriptorTypeListEXT
mutableDescriptorTypeLists)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MutableDescriptorTypeCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr MutableDescriptorTypeListEXT))) (Ptr MutableDescriptorTypeListEXT
pPMutableDescriptorTypeLists')
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr MutableDescriptorTypeCreateInfoEXT -> IO b -> IO b
pokeZeroCStruct Ptr MutableDescriptorTypeCreateInfoEXT
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MutableDescriptorTypeCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MUTABLE_DESCRIPTOR_TYPE_CREATE_INFO_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MutableDescriptorTypeCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    IO b
f

instance FromCStruct MutableDescriptorTypeCreateInfoEXT where
  peekCStruct :: Ptr MutableDescriptorTypeCreateInfoEXT
-> IO MutableDescriptorTypeCreateInfoEXT
peekCStruct Ptr MutableDescriptorTypeCreateInfoEXT
p = do
    Word32
mutableDescriptorTypeListCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr MutableDescriptorTypeCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    Ptr MutableDescriptorTypeListEXT
pMutableDescriptorTypeLists <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr MutableDescriptorTypeListEXT) ((Ptr MutableDescriptorTypeCreateInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr MutableDescriptorTypeListEXT)))
    Vector MutableDescriptorTypeListEXT
pMutableDescriptorTypeLists' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
mutableDescriptorTypeListCount) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @MutableDescriptorTypeListEXT ((Ptr MutableDescriptorTypeListEXT
pMutableDescriptorTypeLists forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
16 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MutableDescriptorTypeListEXT)))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Vector MutableDescriptorTypeListEXT
-> MutableDescriptorTypeCreateInfoEXT
MutableDescriptorTypeCreateInfoEXT
             Vector MutableDescriptorTypeListEXT
pMutableDescriptorTypeLists'

instance Zero MutableDescriptorTypeCreateInfoEXT where
  zero :: MutableDescriptorTypeCreateInfoEXT
zero = Vector MutableDescriptorTypeListEXT
-> MutableDescriptorTypeCreateInfoEXT
MutableDescriptorTypeCreateInfoEXT
           forall a. Monoid a => a
mempty


type EXT_MUTABLE_DESCRIPTOR_TYPE_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_EXT_MUTABLE_DESCRIPTOR_TYPE_SPEC_VERSION"
pattern EXT_MUTABLE_DESCRIPTOR_TYPE_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_MUTABLE_DESCRIPTOR_TYPE_SPEC_VERSION :: forall a. Integral a => a
$mEXT_MUTABLE_DESCRIPTOR_TYPE_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_MUTABLE_DESCRIPTOR_TYPE_SPEC_VERSION = 1


type EXT_MUTABLE_DESCRIPTOR_TYPE_EXTENSION_NAME = "VK_EXT_mutable_descriptor_type"

-- No documentation found for TopLevel "VK_EXT_MUTABLE_DESCRIPTOR_TYPE_EXTENSION_NAME"
pattern EXT_MUTABLE_DESCRIPTOR_TYPE_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_MUTABLE_DESCRIPTOR_TYPE_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mEXT_MUTABLE_DESCRIPTOR_TYPE_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_MUTABLE_DESCRIPTOR_TYPE_EXTENSION_NAME = "VK_EXT_mutable_descriptor_type"