{-# language CPP #-}
-- | = Name
--
-- VK_NV_extended_sparse_address_space - device extension
--
-- == VK_NV_extended_sparse_address_space
--
-- [__Name String__]
--     @VK_NV_extended_sparse_address_space@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     493
--
-- [__Revision__]
--     1
--
-- [__Ratification Status__]
--     Not ratified
--
-- [__Extension and Version Dependencies__; __Contact__]
--
--     -   Russell Chou
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_NV_extended_sparse_address_space] @russellcnv%0A*Here describe the issue or question you have about the VK_NV_extended_sparse_address_space extension* >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2023-10-03
--
-- [__Contributors__]
--
--     -   Russell Chou, NVIDIA
--
--     -   Christoph Kubisch, NVIDIA
--
--     -   Eric Werness, NVIDIA
--
--     -   Jeff Bolz, NVIDIA
--
-- == Description
--
-- Implementations may be able to support an extended address space for
-- sparse memory resources, but only for a certain set of usages.
--
-- This extension adds a query for the extended limit, and the supported
-- usages that are allowed for that limit. This limit is an increase to
-- 'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@sparseAddressSpaceSize@
-- when the 'Vulkan.Core10.Handles.Image' or 'Vulkan.Core10.Handles.Buffer'
-- uses only usages that are supported.
--
-- == New Structures
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDeviceExtendedSparseAddressSpaceFeaturesNV'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2':
--
--     -   'PhysicalDeviceExtendedSparseAddressSpacePropertiesNV'
--
-- == New Enum Constants
--
-- -   'NV_EXTENDED_SPARSE_ADDRESS_SPACE_EXTENSION_NAME'
--
-- -   'NV_EXTENDED_SPARSE_ADDRESS_SPACE_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_EXTENDED_SPARSE_ADDRESS_SPACE_FEATURES_NV'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_EXTENDED_SPARSE_ADDRESS_SPACE_PROPERTIES_NV'
--
-- == Version History
--
-- -   Revision 1, 2023-10-03 (Russell Chou)
--
--     -   Initial draft
--
-- == See Also
--
-- 'PhysicalDeviceExtendedSparseAddressSpaceFeaturesNV',
-- 'PhysicalDeviceExtendedSparseAddressSpacePropertiesNV'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_NV_extended_sparse_address_space 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_extended_sparse_address_space  ( PhysicalDeviceExtendedSparseAddressSpaceFeaturesNV(..)
                                                              , PhysicalDeviceExtendedSparseAddressSpacePropertiesNV(..)
                                                              , NV_EXTENDED_SPARSE_ADDRESS_SPACE_SPEC_VERSION
                                                              , pattern NV_EXTENDED_SPARSE_ADDRESS_SPACE_SPEC_VERSION
                                                              , NV_EXTENDED_SPARSE_ADDRESS_SPACE_EXTENSION_NAME
                                                              , pattern NV_EXTENDED_SPARSE_ADDRESS_SPACE_EXTENSION_NAME
                                                              ) where

import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
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.Kind (Type)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Enums.BufferUsageFlagBits (BufferUsageFlags)
import Vulkan.Core10.FundamentalTypes (DeviceSize)
import Vulkan.Core10.Enums.ImageUsageFlagBits (ImageUsageFlags)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_EXTENDED_SPARSE_ADDRESS_SPACE_FEATURES_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_EXTENDED_SPARSE_ADDRESS_SPACE_PROPERTIES_NV))
-- | VkPhysicalDeviceExtendedSparseAddressSpaceFeaturesNV - Structure
-- describing feature to use extended sparse address space
--
-- = Members
--
-- This structure describes the following feature:
--
-- = Description
--
-- If the 'PhysicalDeviceExtendedSparseAddressSpaceFeaturesNV' 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. 'PhysicalDeviceExtendedSparseAddressSpaceFeaturesNV' /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_extended_sparse_address_space VK_NV_extended_sparse_address_space>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceExtendedSparseAddressSpaceFeaturesNV = PhysicalDeviceExtendedSparseAddressSpaceFeaturesNV
  { -- | #features-extendedSparseAddressSpace# @extendedSparseAddressSpace@
    -- indicates that the implementation supports allowing certain usages of
    -- sparse memory resources to exceed
    -- 'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@sparseAddressSpaceSize@.
    -- See 'PhysicalDeviceExtendedSparseAddressSpacePropertiesNV'.
    PhysicalDeviceExtendedSparseAddressSpaceFeaturesNV -> Bool
extendedSparseAddressSpace :: Bool }
  deriving (Typeable, PhysicalDeviceExtendedSparseAddressSpaceFeaturesNV
-> PhysicalDeviceExtendedSparseAddressSpaceFeaturesNV -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceExtendedSparseAddressSpaceFeaturesNV
-> PhysicalDeviceExtendedSparseAddressSpaceFeaturesNV -> Bool
$c/= :: PhysicalDeviceExtendedSparseAddressSpaceFeaturesNV
-> PhysicalDeviceExtendedSparseAddressSpaceFeaturesNV -> Bool
== :: PhysicalDeviceExtendedSparseAddressSpaceFeaturesNV
-> PhysicalDeviceExtendedSparseAddressSpaceFeaturesNV -> Bool
$c== :: PhysicalDeviceExtendedSparseAddressSpaceFeaturesNV
-> PhysicalDeviceExtendedSparseAddressSpaceFeaturesNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceExtendedSparseAddressSpaceFeaturesNV)
#endif
deriving instance Show PhysicalDeviceExtendedSparseAddressSpaceFeaturesNV

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

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

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


-- | VkPhysicalDeviceExtendedSparseAddressSpacePropertiesNV - Structure
-- describing sparse address space limits of an implementation
--
-- = Description
--
-- If the 'PhysicalDeviceExtendedSparseAddressSpacePropertiesNV' 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_extended_sparse_address_space VK_NV_extended_sparse_address_space>,
-- 'Vulkan.Core10.Enums.BufferUsageFlagBits.BufferUsageFlags',
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize',
-- 'Vulkan.Core10.Enums.ImageUsageFlagBits.ImageUsageFlags',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceExtendedSparseAddressSpacePropertiesNV = PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
  { -- | #limits-extendedSparseAddressSpaceSize# @extendedSparseAddressSpaceSize@
    -- is the total amount of address space available, in bytes, for sparse
    -- memory resources of all usages if the
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-extendedSparseAddressSpace extendedSparseAddressSpace>
    -- feature is enabled. This /must/ be greater than or equal to
    -- 'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@sparseAddressSpaceSize@,
    -- and the difference in space /must/ only be used with usages allowed
    -- below. This is an upper bound on the sum of the sizes of all sparse
    -- resources, regardless of whether any memory is bound to them.
    PhysicalDeviceExtendedSparseAddressSpacePropertiesNV -> DeviceSize
extendedSparseAddressSpaceSize :: DeviceSize
  , -- | #limits-extendedSparseImageUsageFlags# @extendedSparseImageUsageFlags@
    -- is a bitmask of
    -- 'Vulkan.Core10.Enums.ImageUsageFlagBits.ImageUsageFlagBits' of usages
    -- which /may/ allow an implementation to use the full
    -- @extendedSparseAddressSpaceSize@ space.
    PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
-> ImageUsageFlags
extendedSparseImageUsageFlags :: ImageUsageFlags
  , -- | #limits-extendedSparseBufferUsageFlags# @extendedSparseBufferUsageFlags@
    -- is a bitmask of
    -- 'Vulkan.Core10.Enums.BufferUsageFlagBits.BufferUsageFlagBits' of usages
    -- which /may/ allow an implementation to use the full
    -- @extendedSparseAddressSpaceSize@ space.
    PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
-> BufferUsageFlags
extendedSparseBufferUsageFlags :: BufferUsageFlags
  }
  deriving (Typeable, PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
-> PhysicalDeviceExtendedSparseAddressSpacePropertiesNV -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
-> PhysicalDeviceExtendedSparseAddressSpacePropertiesNV -> Bool
$c/= :: PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
-> PhysicalDeviceExtendedSparseAddressSpacePropertiesNV -> Bool
== :: PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
-> PhysicalDeviceExtendedSparseAddressSpacePropertiesNV -> Bool
$c== :: PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
-> PhysicalDeviceExtendedSparseAddressSpacePropertiesNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceExtendedSparseAddressSpacePropertiesNV)
#endif
deriving instance Show PhysicalDeviceExtendedSparseAddressSpacePropertiesNV

instance ToCStruct PhysicalDeviceExtendedSparseAddressSpacePropertiesNV where
  withCStruct :: forall b.
PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
-> (Ptr PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
    -> IO b)
-> IO b
withCStruct PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
x Ptr PhysicalDeviceExtendedSparseAddressSpacePropertiesNV -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
p PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
x (Ptr PhysicalDeviceExtendedSparseAddressSpacePropertiesNV -> IO b
f Ptr PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
p)
  pokeCStruct :: forall b.
Ptr PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
-> PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
-> IO b
-> IO b
pokeCStruct Ptr PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
p PhysicalDeviceExtendedSparseAddressSpacePropertiesNV{DeviceSize
ImageUsageFlags
BufferUsageFlags
extendedSparseBufferUsageFlags :: BufferUsageFlags
extendedSparseImageUsageFlags :: ImageUsageFlags
extendedSparseAddressSpaceSize :: DeviceSize
$sel:extendedSparseBufferUsageFlags:PhysicalDeviceExtendedSparseAddressSpacePropertiesNV :: PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
-> BufferUsageFlags
$sel:extendedSparseImageUsageFlags:PhysicalDeviceExtendedSparseAddressSpacePropertiesNV :: PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
-> ImageUsageFlags
$sel:extendedSparseAddressSpaceSize:PhysicalDeviceExtendedSparseAddressSpacePropertiesNV :: PhysicalDeviceExtendedSparseAddressSpacePropertiesNV -> DeviceSize
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_EXTENDED_SPARSE_ADDRESS_SPACE_PROPERTIES_NV)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
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 PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceSize)) (DeviceSize
extendedSparseAddressSpaceSize)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageUsageFlags)) (ImageUsageFlags
extendedSparseImageUsageFlags)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr BufferUsageFlags)) (BufferUsageFlags
extendedSparseBufferUsageFlags)
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
-> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_EXTENDED_SPARSE_ADDRESS_SPACE_PROPERTIES_NV)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
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 PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageUsageFlags)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr BufferUsageFlags)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct PhysicalDeviceExtendedSparseAddressSpacePropertiesNV where
  peekCStruct :: Ptr PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
-> IO PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
peekCStruct Ptr PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
p = do
    DeviceSize
extendedSparseAddressSpaceSize <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceSize))
    ImageUsageFlags
extendedSparseImageUsageFlags <- forall a. Storable a => Ptr a -> IO a
peek @ImageUsageFlags ((Ptr PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageUsageFlags))
    BufferUsageFlags
extendedSparseBufferUsageFlags <- forall a. Storable a => Ptr a -> IO a
peek @BufferUsageFlags ((Ptr PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr BufferUsageFlags))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DeviceSize
-> ImageUsageFlags
-> BufferUsageFlags
-> PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
             DeviceSize
extendedSparseAddressSpaceSize
             ImageUsageFlags
extendedSparseImageUsageFlags
             BufferUsageFlags
extendedSparseBufferUsageFlags

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

instance Zero PhysicalDeviceExtendedSparseAddressSpacePropertiesNV where
  zero :: PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
zero = DeviceSize
-> ImageUsageFlags
-> BufferUsageFlags
-> PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
PhysicalDeviceExtendedSparseAddressSpacePropertiesNV
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


type NV_EXTENDED_SPARSE_ADDRESS_SPACE_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_NV_EXTENDED_SPARSE_ADDRESS_SPACE_SPEC_VERSION"
pattern NV_EXTENDED_SPARSE_ADDRESS_SPACE_SPEC_VERSION :: forall a . Integral a => a
pattern $bNV_EXTENDED_SPARSE_ADDRESS_SPACE_SPEC_VERSION :: forall a. Integral a => a
$mNV_EXTENDED_SPARSE_ADDRESS_SPACE_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
NV_EXTENDED_SPARSE_ADDRESS_SPACE_SPEC_VERSION = 1


type NV_EXTENDED_SPARSE_ADDRESS_SPACE_EXTENSION_NAME = "VK_NV_extended_sparse_address_space"

-- No documentation found for TopLevel "VK_NV_EXTENDED_SPARSE_ADDRESS_SPACE_EXTENSION_NAME"
pattern NV_EXTENDED_SPARSE_ADDRESS_SPACE_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bNV_EXTENDED_SPARSE_ADDRESS_SPACE_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mNV_EXTENDED_SPARSE_ADDRESS_SPACE_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
NV_EXTENDED_SPARSE_ADDRESS_SPACE_EXTENSION_NAME = "VK_NV_extended_sparse_address_space"