{-# language CPP #-}
-- | = Name
--
-- VK_VALVE_mutable_descriptor_type - device extension
--
-- == VK_VALVE_mutable_descriptor_type
--
-- [__Name String__]
--     @VK_VALVE_mutable_descriptor_type@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     352
--
-- [__Revision__]
--     1
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires Vulkan 1.0
--
--     -   Requires @VK_KHR_maintenance3@
--
-- [__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_VALVE_mutable_descriptor_type] @Joshua-Ashton%0A<<Here describe the issue or question you have about the VK_VALVE_mutable_descriptor_type extension>> >
--
--     -   Hans-Kristian Arntzen
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_VALVE_mutable_descriptor_type] @HansKristian-Work%0A<<Here describe the issue or question you have about the VK_VALVE_mutable_descriptor_type extension>> >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2020-12-02
--
-- [__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
--
-- -   'MutableDescriptorTypeListVALVE'
--
-- -   Extending
--     'Vulkan.Core10.DescriptorSet.DescriptorSetLayoutCreateInfo',
--     'Vulkan.Core10.DescriptorSet.DescriptorPoolCreateInfo':
--
--     -   'MutableDescriptorTypeCreateInfoVALVE'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDeviceMutableDescriptorTypeFeaturesVALVE'
--
-- == New Enum Constants
--
-- -   'VALVE_MUTABLE_DESCRIPTOR_TYPE_EXTENSION_NAME'
--
-- -   'VALVE_MUTABLE_DESCRIPTOR_TYPE_SPEC_VERSION'
--
-- -   Extending
--     'Vulkan.Core10.Enums.DescriptorPoolCreateFlagBits.DescriptorPoolCreateFlagBits':
--
--     -   'Vulkan.Core10.Enums.DescriptorPoolCreateFlagBits.DESCRIPTOR_POOL_CREATE_HOST_ONLY_BIT_VALVE'
--
-- -   Extending
--     'Vulkan.Core10.Enums.DescriptorSetLayoutCreateFlagBits.DescriptorSetLayoutCreateFlagBits':
--
--     -   'Vulkan.Core10.Enums.DescriptorSetLayoutCreateFlagBits.DESCRIPTOR_SET_LAYOUT_CREATE_HOST_ONLY_POOL_BIT_VALVE'
--
-- -   Extending 'Vulkan.Core10.Enums.DescriptorType.DescriptorType':
--
--     -   'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_MUTABLE_VALVE'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_MUTABLE_DESCRIPTOR_TYPE_CREATE_INFO_VALVE'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_MUTABLE_DESCRIPTOR_TYPE_FEATURES_VALVE'
--
-- == Version History
--
-- -   Revision 1, 2020-12-01 (Joshua Ashton, Hans-Kristian Arntzen)
--
--     -   Initial specification, squashed from public draft.
--
-- == See Also
--
-- 'MutableDescriptorTypeCreateInfoVALVE',
-- 'MutableDescriptorTypeListVALVE',
-- 'PhysicalDeviceMutableDescriptorTypeFeaturesVALVE'
--
-- == Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VALVE_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_VALVE_mutable_descriptor_type  ( PhysicalDeviceMutableDescriptorTypeFeaturesVALVE(..)
                                                           , MutableDescriptorTypeListVALVE(..)
                                                           , MutableDescriptorTypeCreateInfoVALVE(..)
                                                           , VALVE_MUTABLE_DESCRIPTOR_TYPE_SPEC_VERSION
                                                           , pattern VALVE_MUTABLE_DESCRIPTOR_TYPE_SPEC_VERSION
                                                           , VALVE_MUTABLE_DESCRIPTOR_TYPE_EXTENSION_NAME
                                                           , pattern VALVE_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_VALVE))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_MUTABLE_DESCRIPTOR_TYPE_FEATURES_VALVE))
-- | VkPhysicalDeviceMutableDescriptorTypeFeaturesVALVE - 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_VALVE'
--     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 'MutableDescriptorTypeListVALVE' for
--         'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_MUTABLE_VALVE'
--         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_VALVE'
--         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 'MutableDescriptorTypeListVALVE' for
--         'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_MUTABLE_VALVE'
--         have the corresponding dynamic indexing features enabled.
--
--     -   'Vulkan.Core10.Enums.DescriptorSetLayoutCreateFlagBits.DESCRIPTOR_SET_LAYOUT_CREATE_HOST_ONLY_POOL_BIT_VALVE'
--         /must/ be supported.
--
--     -   'Vulkan.Core10.Enums.DescriptorPoolCreateFlagBits.DESCRIPTOR_POOL_CREATE_HOST_ONLY_BIT_VALVE'
--         /must/ be supported.
--
-- If the 'PhysicalDeviceMutableDescriptorTypeFeaturesVALVE' 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. 'PhysicalDeviceMutableDescriptorTypeFeaturesVALVE' /can/ also
-- be used in the @pNext@ chain of 'Vulkan.Core10.Device.DeviceCreateInfo'
-- to selectively enable these features.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkPhysicalDeviceMutableDescriptorTypeFeaturesVALVE-sType-sType#
--     @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_MUTABLE_DESCRIPTOR_TYPE_FEATURES_VALVE'
--
-- = See Also
--
-- <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 PhysicalDeviceMutableDescriptorTypeFeaturesVALVE = PhysicalDeviceMutableDescriptorTypeFeaturesVALVE
  { -- No documentation found for Nested "VkPhysicalDeviceMutableDescriptorTypeFeaturesVALVE" "mutableDescriptorType"
    PhysicalDeviceMutableDescriptorTypeFeaturesVALVE -> Bool
mutableDescriptorType :: Bool }
  deriving (Typeable, PhysicalDeviceMutableDescriptorTypeFeaturesVALVE
-> PhysicalDeviceMutableDescriptorTypeFeaturesVALVE -> Bool
(PhysicalDeviceMutableDescriptorTypeFeaturesVALVE
 -> PhysicalDeviceMutableDescriptorTypeFeaturesVALVE -> Bool)
-> (PhysicalDeviceMutableDescriptorTypeFeaturesVALVE
    -> PhysicalDeviceMutableDescriptorTypeFeaturesVALVE -> Bool)
-> Eq PhysicalDeviceMutableDescriptorTypeFeaturesVALVE
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceMutableDescriptorTypeFeaturesVALVE
-> PhysicalDeviceMutableDescriptorTypeFeaturesVALVE -> Bool
$c/= :: PhysicalDeviceMutableDescriptorTypeFeaturesVALVE
-> PhysicalDeviceMutableDescriptorTypeFeaturesVALVE -> Bool
== :: PhysicalDeviceMutableDescriptorTypeFeaturesVALVE
-> PhysicalDeviceMutableDescriptorTypeFeaturesVALVE -> Bool
$c== :: PhysicalDeviceMutableDescriptorTypeFeaturesVALVE
-> PhysicalDeviceMutableDescriptorTypeFeaturesVALVE -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceMutableDescriptorTypeFeaturesVALVE)
#endif
deriving instance Show PhysicalDeviceMutableDescriptorTypeFeaturesVALVE

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

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

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


-- | VkMutableDescriptorTypeListVALVE - Structure describing descriptor types
-- that a given descriptor may mutate to
--
-- == Valid Usage
--
-- -   #VUID-VkMutableDescriptorTypeListVALVE-descriptorTypeCount-04597#
--     @descriptorTypeCount@ /must/ not be @0@ if the corresponding binding
--     is of
--     'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_MUTABLE_VALVE'
--
-- -   #VUID-VkMutableDescriptorTypeListVALVE-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_VALVE'
--     type
--
-- -   #VUID-VkMutableDescriptorTypeListVALVE-descriptorTypeCount-04599#
--     @descriptorTypeCount@ /must/ be @0@ if the corresponding binding is
--     not of
--     'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_MUTABLE_VALVE'
--
-- -   #VUID-VkMutableDescriptorTypeListVALVE-pDescriptorTypes-04600#
--     @pDescriptorTypes@ /must/ not contain
--     'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_MUTABLE_VALVE'
--
-- -   #VUID-VkMutableDescriptorTypeListVALVE-pDescriptorTypes-04601#
--     @pDescriptorTypes@ /must/ not contain
--     'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_STORAGE_BUFFER_DYNAMIC'
--
-- -   #VUID-VkMutableDescriptorTypeListVALVE-pDescriptorTypes-04602#
--     @pDescriptorTypes@ /must/ not contain
--     'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_UNIFORM_BUFFER_DYNAMIC'
--
-- -   #VUID-VkMutableDescriptorTypeListVALVE-pDescriptorTypes-04603#
--     @pDescriptorTypes@ /must/ not contain
--     'Vulkan.Core10.Enums.DescriptorType.DESCRIPTOR_TYPE_INLINE_UNIFORM_BLOCK_EXT'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkMutableDescriptorTypeListVALVE-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_VALVE_mutable_descriptor_type VK_VALVE_mutable_descriptor_type>,
-- 'Vulkan.Core10.Enums.DescriptorType.DescriptorType',
-- 'MutableDescriptorTypeCreateInfoVALVE'
data MutableDescriptorTypeListVALVE = MutableDescriptorTypeListVALVE
  { -- | @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.
    MutableDescriptorTypeListVALVE -> Vector DescriptorType
descriptorTypes :: Vector DescriptorType }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MutableDescriptorTypeListVALVE)
#endif
deriving instance Show MutableDescriptorTypeListVALVE

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

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

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


-- | VkMutableDescriptorTypeCreateInfoVALVE - 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 'MutableDescriptorTypeListVALVE' 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
-- 'MutableDescriptorTypeCreateInfoVALVE'::@pMutableDescriptorTypeLists@[i].
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkMutableDescriptorTypeCreateInfoVALVE-sType-sType# @sType@
--     /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_MUTABLE_DESCRIPTOR_TYPE_CREATE_INFO_VALVE'
--
-- -   #VUID-VkMutableDescriptorTypeCreateInfoVALVE-pMutableDescriptorTypeLists-parameter#
--     If @mutableDescriptorTypeListCount@ is not @0@,
--     @pMutableDescriptorTypeLists@ /must/ be a valid pointer to an array
--     of @mutableDescriptorTypeListCount@ valid
--     'MutableDescriptorTypeListVALVE' structures
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VALVE_mutable_descriptor_type VK_VALVE_mutable_descriptor_type>,
-- 'MutableDescriptorTypeListVALVE',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data MutableDescriptorTypeCreateInfoVALVE = MutableDescriptorTypeCreateInfoVALVE
  { -- | @pMutableDescriptorTypeLists@ is a pointer to an array of
    -- 'MutableDescriptorTypeListVALVE' structures.
    MutableDescriptorTypeCreateInfoVALVE
-> Vector MutableDescriptorTypeListVALVE
mutableDescriptorTypeLists :: Vector MutableDescriptorTypeListVALVE }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MutableDescriptorTypeCreateInfoVALVE)
#endif
deriving instance Show MutableDescriptorTypeCreateInfoVALVE

instance ToCStruct MutableDescriptorTypeCreateInfoVALVE where
  withCStruct :: MutableDescriptorTypeCreateInfoVALVE
-> (Ptr MutableDescriptorTypeCreateInfoVALVE -> IO b) -> IO b
withCStruct MutableDescriptorTypeCreateInfoVALVE
x Ptr MutableDescriptorTypeCreateInfoVALVE -> IO b
f = Int -> (Ptr MutableDescriptorTypeCreateInfoVALVE -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr MutableDescriptorTypeCreateInfoVALVE -> IO b) -> IO b)
-> (Ptr MutableDescriptorTypeCreateInfoVALVE -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr MutableDescriptorTypeCreateInfoVALVE
p -> Ptr MutableDescriptorTypeCreateInfoVALVE
-> MutableDescriptorTypeCreateInfoVALVE -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr MutableDescriptorTypeCreateInfoVALVE
p MutableDescriptorTypeCreateInfoVALVE
x (Ptr MutableDescriptorTypeCreateInfoVALVE -> IO b
f Ptr MutableDescriptorTypeCreateInfoVALVE
p)
  pokeCStruct :: Ptr MutableDescriptorTypeCreateInfoVALVE
-> MutableDescriptorTypeCreateInfoVALVE -> IO b -> IO b
pokeCStruct Ptr MutableDescriptorTypeCreateInfoVALVE
p MutableDescriptorTypeCreateInfoVALVE{Vector MutableDescriptorTypeListVALVE
mutableDescriptorTypeLists :: Vector MutableDescriptorTypeListVALVE
$sel:mutableDescriptorTypeLists:MutableDescriptorTypeCreateInfoVALVE :: MutableDescriptorTypeCreateInfoVALVE
-> Vector MutableDescriptorTypeListVALVE
..} 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 (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 MutableDescriptorTypeCreateInfoVALVE
p Ptr MutableDescriptorTypeCreateInfoVALVE
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MUTABLE_DESCRIPTOR_TYPE_CREATE_INFO_VALVE)
    IO () -> ContT b IO ()
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 MutableDescriptorTypeCreateInfoVALVE
p Ptr MutableDescriptorTypeCreateInfoVALVE -> 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 (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 MutableDescriptorTypeCreateInfoVALVE
p Ptr MutableDescriptorTypeCreateInfoVALVE -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector MutableDescriptorTypeListVALVE -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector MutableDescriptorTypeListVALVE -> Int)
-> Vector MutableDescriptorTypeListVALVE -> Int
forall a b. (a -> b) -> a -> b
$ (Vector MutableDescriptorTypeListVALVE
mutableDescriptorTypeLists)) :: Word32))
    Ptr MutableDescriptorTypeListVALVE
pPMutableDescriptorTypeLists' <- ((Ptr MutableDescriptorTypeListVALVE -> IO b) -> IO b)
-> ContT b IO (Ptr MutableDescriptorTypeListVALVE)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr MutableDescriptorTypeListVALVE -> IO b) -> IO b)
 -> ContT b IO (Ptr MutableDescriptorTypeListVALVE))
-> ((Ptr MutableDescriptorTypeListVALVE -> IO b) -> IO b)
-> ContT b IO (Ptr MutableDescriptorTypeListVALVE)
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr MutableDescriptorTypeListVALVE -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @MutableDescriptorTypeListVALVE ((Vector MutableDescriptorTypeListVALVE -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector MutableDescriptorTypeListVALVE
mutableDescriptorTypeLists)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16)
    (Int -> MutableDescriptorTypeListVALVE -> ContT b IO ())
-> Vector MutableDescriptorTypeListVALVE -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i MutableDescriptorTypeListVALVE
e -> ((() -> 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 MutableDescriptorTypeListVALVE
-> MutableDescriptorTypeListVALVE -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (Ptr MutableDescriptorTypeListVALVE
pPMutableDescriptorTypeLists' Ptr MutableDescriptorTypeListVALVE
-> Int -> Ptr MutableDescriptorTypeListVALVE
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MutableDescriptorTypeListVALVE) (MutableDescriptorTypeListVALVE
e) (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
$ ())) (Vector MutableDescriptorTypeListVALVE
mutableDescriptorTypeLists)
    IO () -> ContT b IO ()
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 MutableDescriptorTypeListVALVE)
-> Ptr MutableDescriptorTypeListVALVE -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MutableDescriptorTypeCreateInfoVALVE
p Ptr MutableDescriptorTypeCreateInfoVALVE
-> Int -> Ptr (Ptr MutableDescriptorTypeListVALVE)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr MutableDescriptorTypeListVALVE))) (Ptr MutableDescriptorTypeListVALVE
pPMutableDescriptorTypeLists')
    IO b -> ContT b IO b
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
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr MutableDescriptorTypeCreateInfoVALVE -> IO b -> IO b
pokeZeroCStruct Ptr MutableDescriptorTypeCreateInfoVALVE
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MutableDescriptorTypeCreateInfoVALVE
p Ptr MutableDescriptorTypeCreateInfoVALVE
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MUTABLE_DESCRIPTOR_TYPE_CREATE_INFO_VALVE)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MutableDescriptorTypeCreateInfoVALVE
p Ptr MutableDescriptorTypeCreateInfoVALVE -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO b
f

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

instance Zero MutableDescriptorTypeCreateInfoVALVE where
  zero :: MutableDescriptorTypeCreateInfoVALVE
zero = Vector MutableDescriptorTypeListVALVE
-> MutableDescriptorTypeCreateInfoVALVE
MutableDescriptorTypeCreateInfoVALVE
           Vector MutableDescriptorTypeListVALVE
forall a. Monoid a => a
mempty


type VALVE_MUTABLE_DESCRIPTOR_TYPE_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_VALVE_MUTABLE_DESCRIPTOR_TYPE_SPEC_VERSION"
pattern VALVE_MUTABLE_DESCRIPTOR_TYPE_SPEC_VERSION :: forall a . Integral a => a
pattern $bVALVE_MUTABLE_DESCRIPTOR_TYPE_SPEC_VERSION :: a
$mVALVE_MUTABLE_DESCRIPTOR_TYPE_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
VALVE_MUTABLE_DESCRIPTOR_TYPE_SPEC_VERSION = 1


type VALVE_MUTABLE_DESCRIPTOR_TYPE_EXTENSION_NAME = "VK_VALVE_mutable_descriptor_type"

-- No documentation found for TopLevel "VK_VALVE_MUTABLE_DESCRIPTOR_TYPE_EXTENSION_NAME"
pattern VALVE_MUTABLE_DESCRIPTOR_TYPE_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bVALVE_MUTABLE_DESCRIPTOR_TYPE_EXTENSION_NAME :: a
$mVALVE_MUTABLE_DESCRIPTOR_TYPE_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
VALVE_MUTABLE_DESCRIPTOR_TYPE_EXTENSION_NAME = "VK_VALVE_mutable_descriptor_type"