{-# language CPP #-}
-- | = Name
--
-- VK_NV_dedicated_allocation - device extension
--
-- == VK_NV_dedicated_allocation
--
-- [__Name String__]
--     @VK_NV_dedicated_allocation@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     27
--
-- [__Revision__]
--     1
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires Vulkan 1.0
--
-- [__Deprecation state__]
--
--     -   /Deprecated/ by @VK_KHR_dedicated_allocation@ extension
--
--         -   Which in turn was /promoted/ to
--             <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#versions-1.1-promotions Vulkan 1.1>
--
-- [__Contact__]
--
--     -   Jeff Bolz
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_NV_dedicated_allocation] @jeffbolznv%0A<<Here describe the issue or question you have about the VK_NV_dedicated_allocation extension>> >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2016-05-31
--
-- [__IP Status__]
--     No known IP claims.
--
-- [__Contributors__]
--
--     -   Jeff Bolz, NVIDIA
--
-- == Description
--
-- This extension allows device memory to be allocated for a particular
-- buffer or image resource, which on some devices can significantly
-- improve the performance of that resource. Normal device memory
-- allocations must support memory aliasing and sparse binding, which could
-- interfere with optimizations like framebuffer compression or efficient
-- page table usage. This is important for render targets and very large
-- resources, but need not (and probably should not) be used for smaller
-- resources that can benefit from suballocation.
--
-- This extension adds a few small structures to resource creation and
-- memory allocation: a new structure that flags whether am image\/buffer
-- will have a dedicated allocation, and a structure indicating the image
-- or buffer that an allocation will be bound to.
--
-- == New Structures
--
-- -   Extending 'Vulkan.Core10.Buffer.BufferCreateInfo':
--
--     -   'DedicatedAllocationBufferCreateInfoNV'
--
-- -   Extending 'Vulkan.Core10.Image.ImageCreateInfo':
--
--     -   'DedicatedAllocationImageCreateInfoNV'
--
-- -   Extending 'Vulkan.Core10.Memory.MemoryAllocateInfo':
--
--     -   'DedicatedAllocationMemoryAllocateInfoNV'
--
-- == New Enum Constants
--
-- -   'NV_DEDICATED_ALLOCATION_EXTENSION_NAME'
--
-- -   'NV_DEDICATED_ALLOCATION_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_DEDICATED_ALLOCATION_BUFFER_CREATE_INFO_NV'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_DEDICATED_ALLOCATION_IMAGE_CREATE_INFO_NV'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_DEDICATED_ALLOCATION_MEMORY_ALLOCATE_INFO_NV'
--
-- == Examples
--
-- >     // Create an image with
-- >     // VkDedicatedAllocationImageCreateInfoNV::dedicatedAllocation
-- >     // set to VK_TRUE
-- >
-- >     VkDedicatedAllocationImageCreateInfoNV dedicatedImageInfo =
-- >     {
-- >         VK_STRUCTURE_TYPE_DEDICATED_ALLOCATION_IMAGE_CREATE_INFO_NV,            // sType
-- >         NULL,                                                                   // pNext
-- >         VK_TRUE,                                                                // dedicatedAllocation
-- >     };
-- >
-- >     VkImageCreateInfo imageCreateInfo =
-- >     {
-- >         VK_STRUCTURE_TYPE_IMAGE_CREATE_INFO,    // sType
-- >         &dedicatedImageInfo                     // pNext
-- >         // Other members set as usual
-- >     };
-- >
-- >     VkImage image;
-- >     VkResult result = vkCreateImage(
-- >         device,
-- >         &imageCreateInfo,
-- >         NULL,                       // pAllocator
-- >         &image);
-- >
-- >     VkMemoryRequirements memoryRequirements;
-- >     vkGetImageMemoryRequirements(
-- >         device,
-- >         image,
-- >         &memoryRequirements);
-- >
-- >     // Allocate memory with VkDedicatedAllocationMemoryAllocateInfoNV::image
-- >     // pointing to the image we are allocating the memory for
-- >
-- >     VkDedicatedAllocationMemoryAllocateInfoNV dedicatedInfo =
-- >     {
-- >         VK_STRUCTURE_TYPE_DEDICATED_ALLOCATION_MEMORY_ALLOCATE_INFO_NV,             // sType
-- >         NULL,                                                                       // pNext
-- >         image,                                                                      // image
-- >         VK_NULL_HANDLE,                                                             // buffer
-- >     };
-- >
-- >     VkMemoryAllocateInfo memoryAllocateInfo =
-- >     {
-- >         VK_STRUCTURE_TYPE_MEMORY_ALLOCATE_INFO,                 // sType
-- >         &dedicatedInfo,                                         // pNext
-- >         memoryRequirements.size,                                // allocationSize
-- >         FindMemoryTypeIndex(memoryRequirements.memoryTypeBits), // memoryTypeIndex
-- >     };
-- >
-- >     VkDeviceMemory memory;
-- >     vkAllocateMemory(
-- >         device,
-- >         &memoryAllocateInfo,
-- >         NULL,                       // pAllocator
-- >         &memory);
-- >
-- >     // Bind the image to the memory
-- >
-- >     vkBindImageMemory(
-- >         device,
-- >         image,
-- >         memory,
-- >         0);
--
-- == Version History
--
-- -   Revision 1, 2016-05-31 (Jeff Bolz)
--
--     -   Internal revisions
--
-- == See Also
--
-- 'DedicatedAllocationBufferCreateInfoNV',
-- 'DedicatedAllocationImageCreateInfoNV',
-- 'DedicatedAllocationMemoryAllocateInfoNV'
--
-- == Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#VK_NV_dedicated_allocation 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_dedicated_allocation  ( DedicatedAllocationImageCreateInfoNV(..)
                                                     , DedicatedAllocationBufferCreateInfoNV(..)
                                                     , DedicatedAllocationMemoryAllocateInfoNV(..)
                                                     , NV_DEDICATED_ALLOCATION_SPEC_VERSION
                                                     , pattern NV_DEDICATED_ALLOCATION_SPEC_VERSION
                                                     , NV_DEDICATED_ALLOCATION_EXTENSION_NAME
                                                     , pattern NV_DEDICATED_ALLOCATION_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.Handles (Buffer)
import Vulkan.Core10.Handles (Image)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_DEDICATED_ALLOCATION_BUFFER_CREATE_INFO_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_DEDICATED_ALLOCATION_IMAGE_CREATE_INFO_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_DEDICATED_ALLOCATION_MEMORY_ALLOCATE_INFO_NV))
-- | VkDedicatedAllocationImageCreateInfoNV - Specify that an image is bound
-- to a dedicated memory resource
--
-- = Description
--
-- Note
--
-- Using a dedicated allocation for color and depth\/stencil attachments or
-- other large images /may/ improve performance on some devices.
--
-- == Valid Usage
--
-- -   #VUID-VkDedicatedAllocationImageCreateInfoNV-dedicatedAllocation-00994#
--     If @dedicatedAllocation@ is 'Vulkan.Core10.FundamentalTypes.TRUE',
--     'Vulkan.Core10.Image.ImageCreateInfo'::@flags@ /must/ not include
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SPARSE_BINDING_BIT',
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SPARSE_RESIDENCY_BIT',
--     or
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SPARSE_ALIASED_BIT'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkDedicatedAllocationImageCreateInfoNV-sType-sType# @sType@
--     /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_DEDICATED_ALLOCATION_IMAGE_CREATE_INFO_NV'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_dedicated_allocation VK_NV_dedicated_allocation>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data DedicatedAllocationImageCreateInfoNV = DedicatedAllocationImageCreateInfoNV
  { -- | @dedicatedAllocation@ specifies whether the image will have a dedicated
    -- allocation bound to it.
    DedicatedAllocationImageCreateInfoNV -> Bool
dedicatedAllocation :: Bool }
  deriving (Typeable, DedicatedAllocationImageCreateInfoNV
-> DedicatedAllocationImageCreateInfoNV -> Bool
(DedicatedAllocationImageCreateInfoNV
 -> DedicatedAllocationImageCreateInfoNV -> Bool)
-> (DedicatedAllocationImageCreateInfoNV
    -> DedicatedAllocationImageCreateInfoNV -> Bool)
-> Eq DedicatedAllocationImageCreateInfoNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DedicatedAllocationImageCreateInfoNV
-> DedicatedAllocationImageCreateInfoNV -> Bool
$c/= :: DedicatedAllocationImageCreateInfoNV
-> DedicatedAllocationImageCreateInfoNV -> Bool
== :: DedicatedAllocationImageCreateInfoNV
-> DedicatedAllocationImageCreateInfoNV -> Bool
$c== :: DedicatedAllocationImageCreateInfoNV
-> DedicatedAllocationImageCreateInfoNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DedicatedAllocationImageCreateInfoNV)
#endif
deriving instance Show DedicatedAllocationImageCreateInfoNV

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

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

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


-- | VkDedicatedAllocationBufferCreateInfoNV - Specify that a buffer is bound
-- to a dedicated memory resource
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_dedicated_allocation VK_NV_dedicated_allocation>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data DedicatedAllocationBufferCreateInfoNV = DedicatedAllocationBufferCreateInfoNV
  { -- | @dedicatedAllocation@ specifies whether the buffer will have a dedicated
    -- allocation bound to it.
    DedicatedAllocationBufferCreateInfoNV -> Bool
dedicatedAllocation :: Bool }
  deriving (Typeable, DedicatedAllocationBufferCreateInfoNV
-> DedicatedAllocationBufferCreateInfoNV -> Bool
(DedicatedAllocationBufferCreateInfoNV
 -> DedicatedAllocationBufferCreateInfoNV -> Bool)
-> (DedicatedAllocationBufferCreateInfoNV
    -> DedicatedAllocationBufferCreateInfoNV -> Bool)
-> Eq DedicatedAllocationBufferCreateInfoNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DedicatedAllocationBufferCreateInfoNV
-> DedicatedAllocationBufferCreateInfoNV -> Bool
$c/= :: DedicatedAllocationBufferCreateInfoNV
-> DedicatedAllocationBufferCreateInfoNV -> Bool
== :: DedicatedAllocationBufferCreateInfoNV
-> DedicatedAllocationBufferCreateInfoNV -> Bool
$c== :: DedicatedAllocationBufferCreateInfoNV
-> DedicatedAllocationBufferCreateInfoNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DedicatedAllocationBufferCreateInfoNV)
#endif
deriving instance Show DedicatedAllocationBufferCreateInfoNV

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

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

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


-- | VkDedicatedAllocationMemoryAllocateInfoNV - Specify a dedicated memory
-- allocation resource
--
-- == Valid Usage
--
-- -   #VUID-VkDedicatedAllocationMemoryAllocateInfoNV-image-00649# At
--     least one of @image@ and @buffer@ /must/ be
--     'Vulkan.Core10.APIConstants.NULL_HANDLE'
--
-- -   #VUID-VkDedicatedAllocationMemoryAllocateInfoNV-image-00650# If
--     @image@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE', the image
--     /must/ have been created with
--     'DedicatedAllocationImageCreateInfoNV'::@dedicatedAllocation@ equal
--     to 'Vulkan.Core10.FundamentalTypes.TRUE'
--
-- -   #VUID-VkDedicatedAllocationMemoryAllocateInfoNV-buffer-00651# If
--     @buffer@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE', the buffer
--     /must/ have been created with
--     'DedicatedAllocationBufferCreateInfoNV'::@dedicatedAllocation@ equal
--     to 'Vulkan.Core10.FundamentalTypes.TRUE'
--
-- -   #VUID-VkDedicatedAllocationMemoryAllocateInfoNV-image-00652# If
--     @image@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     'Vulkan.Core10.Memory.MemoryAllocateInfo'::@allocationSize@ /must/
--     equal the
--     'Vulkan.Core10.MemoryManagement.MemoryRequirements'::@size@ of the
--     image
--
-- -   #VUID-VkDedicatedAllocationMemoryAllocateInfoNV-buffer-00653# If
--     @buffer@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     'Vulkan.Core10.Memory.MemoryAllocateInfo'::@allocationSize@ /must/
--     equal the
--     'Vulkan.Core10.MemoryManagement.MemoryRequirements'::@size@ of the
--     buffer
--
-- -   #VUID-VkDedicatedAllocationMemoryAllocateInfoNV-image-00654# If
--     @image@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE' and
--     'Vulkan.Core10.Memory.MemoryAllocateInfo' defines a memory import
--     operation, the memory being imported /must/ also be a dedicated
--     image allocation and @image@ /must/ be identical to the image
--     associated with the imported memory
--
-- -   #VUID-VkDedicatedAllocationMemoryAllocateInfoNV-buffer-00655# If
--     @buffer@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE' and
--     'Vulkan.Core10.Memory.MemoryAllocateInfo' defines a memory import
--     operation, the memory being imported /must/ also be a dedicated
--     buffer allocation and @buffer@ /must/ be identical to the buffer
--     associated with the imported memory
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkDedicatedAllocationMemoryAllocateInfoNV-sType-sType# @sType@
--     /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_DEDICATED_ALLOCATION_MEMORY_ALLOCATE_INFO_NV'
--
-- -   #VUID-VkDedicatedAllocationMemoryAllocateInfoNV-image-parameter# If
--     @image@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE', @image@
--     /must/ be a valid 'Vulkan.Core10.Handles.Image' handle
--
-- -   #VUID-VkDedicatedAllocationMemoryAllocateInfoNV-buffer-parameter# If
--     @buffer@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE', @buffer@
--     /must/ be a valid 'Vulkan.Core10.Handles.Buffer' handle
--
-- -   #VUID-VkDedicatedAllocationMemoryAllocateInfoNV-commonparent# Both
--     of @buffer@, and @image@ that are valid handles of non-ignored
--     parameters /must/ have been created, allocated, or retrieved from
--     the same 'Vulkan.Core10.Handles.Device'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_dedicated_allocation VK_NV_dedicated_allocation>,
-- 'Vulkan.Core10.Handles.Buffer', 'Vulkan.Core10.Handles.Image',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data DedicatedAllocationMemoryAllocateInfoNV = DedicatedAllocationMemoryAllocateInfoNV
  { -- | @image@ is 'Vulkan.Core10.APIConstants.NULL_HANDLE' or a handle of an
    -- image which this memory will be bound to.
    DedicatedAllocationMemoryAllocateInfoNV -> Image
image :: Image
  , -- | @buffer@ is 'Vulkan.Core10.APIConstants.NULL_HANDLE' or a handle of a
    -- buffer which this memory will be bound to.
    DedicatedAllocationMemoryAllocateInfoNV -> Buffer
buffer :: Buffer
  }
  deriving (Typeable, DedicatedAllocationMemoryAllocateInfoNV
-> DedicatedAllocationMemoryAllocateInfoNV -> Bool
(DedicatedAllocationMemoryAllocateInfoNV
 -> DedicatedAllocationMemoryAllocateInfoNV -> Bool)
-> (DedicatedAllocationMemoryAllocateInfoNV
    -> DedicatedAllocationMemoryAllocateInfoNV -> Bool)
-> Eq DedicatedAllocationMemoryAllocateInfoNV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DedicatedAllocationMemoryAllocateInfoNV
-> DedicatedAllocationMemoryAllocateInfoNV -> Bool
$c/= :: DedicatedAllocationMemoryAllocateInfoNV
-> DedicatedAllocationMemoryAllocateInfoNV -> Bool
== :: DedicatedAllocationMemoryAllocateInfoNV
-> DedicatedAllocationMemoryAllocateInfoNV -> Bool
$c== :: DedicatedAllocationMemoryAllocateInfoNV
-> DedicatedAllocationMemoryAllocateInfoNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DedicatedAllocationMemoryAllocateInfoNV)
#endif
deriving instance Show DedicatedAllocationMemoryAllocateInfoNV

instance ToCStruct DedicatedAllocationMemoryAllocateInfoNV where
  withCStruct :: DedicatedAllocationMemoryAllocateInfoNV
-> (Ptr DedicatedAllocationMemoryAllocateInfoNV -> IO b) -> IO b
withCStruct DedicatedAllocationMemoryAllocateInfoNV
x Ptr DedicatedAllocationMemoryAllocateInfoNV -> IO b
f = Int
-> (Ptr DedicatedAllocationMemoryAllocateInfoNV -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr DedicatedAllocationMemoryAllocateInfoNV -> IO b) -> IO b)
-> (Ptr DedicatedAllocationMemoryAllocateInfoNV -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr DedicatedAllocationMemoryAllocateInfoNV
p -> Ptr DedicatedAllocationMemoryAllocateInfoNV
-> DedicatedAllocationMemoryAllocateInfoNV -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr DedicatedAllocationMemoryAllocateInfoNV
p DedicatedAllocationMemoryAllocateInfoNV
x (Ptr DedicatedAllocationMemoryAllocateInfoNV -> IO b
f Ptr DedicatedAllocationMemoryAllocateInfoNV
p)
  pokeCStruct :: Ptr DedicatedAllocationMemoryAllocateInfoNV
-> DedicatedAllocationMemoryAllocateInfoNV -> IO b -> IO b
pokeCStruct Ptr DedicatedAllocationMemoryAllocateInfoNV
p DedicatedAllocationMemoryAllocateInfoNV{Image
Buffer
buffer :: Buffer
image :: Image
$sel:buffer:DedicatedAllocationMemoryAllocateInfoNV :: DedicatedAllocationMemoryAllocateInfoNV -> Buffer
$sel:image:DedicatedAllocationMemoryAllocateInfoNV :: DedicatedAllocationMemoryAllocateInfoNV -> Image
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DedicatedAllocationMemoryAllocateInfoNV
p Ptr DedicatedAllocationMemoryAllocateInfoNV
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEDICATED_ALLOCATION_MEMORY_ALLOCATE_INFO_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DedicatedAllocationMemoryAllocateInfoNV
p Ptr DedicatedAllocationMemoryAllocateInfoNV -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Image -> Image -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DedicatedAllocationMemoryAllocateInfoNV
p Ptr DedicatedAllocationMemoryAllocateInfoNV -> Int -> Ptr Image
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Image)) (Image
image)
    Ptr Buffer -> Buffer -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DedicatedAllocationMemoryAllocateInfoNV
p Ptr DedicatedAllocationMemoryAllocateInfoNV -> Int -> Ptr Buffer
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Buffer)) (Buffer
buffer)
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr DedicatedAllocationMemoryAllocateInfoNV -> IO b -> IO b
pokeZeroCStruct Ptr DedicatedAllocationMemoryAllocateInfoNV
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DedicatedAllocationMemoryAllocateInfoNV
p Ptr DedicatedAllocationMemoryAllocateInfoNV
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_DEDICATED_ALLOCATION_MEMORY_ALLOCATE_INFO_NV)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DedicatedAllocationMemoryAllocateInfoNV
p Ptr DedicatedAllocationMemoryAllocateInfoNV -> 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 DedicatedAllocationMemoryAllocateInfoNV where
  peekCStruct :: Ptr DedicatedAllocationMemoryAllocateInfoNV
-> IO DedicatedAllocationMemoryAllocateInfoNV
peekCStruct Ptr DedicatedAllocationMemoryAllocateInfoNV
p = do
    Image
image <- Ptr Image -> IO Image
forall a. Storable a => Ptr a -> IO a
peek @Image ((Ptr DedicatedAllocationMemoryAllocateInfoNV
p Ptr DedicatedAllocationMemoryAllocateInfoNV -> Int -> Ptr Image
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Image))
    Buffer
buffer <- Ptr Buffer -> IO Buffer
forall a. Storable a => Ptr a -> IO a
peek @Buffer ((Ptr DedicatedAllocationMemoryAllocateInfoNV
p Ptr DedicatedAllocationMemoryAllocateInfoNV -> Int -> Ptr Buffer
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Buffer))
    DedicatedAllocationMemoryAllocateInfoNV
-> IO DedicatedAllocationMemoryAllocateInfoNV
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DedicatedAllocationMemoryAllocateInfoNV
 -> IO DedicatedAllocationMemoryAllocateInfoNV)
-> DedicatedAllocationMemoryAllocateInfoNV
-> IO DedicatedAllocationMemoryAllocateInfoNV
forall a b. (a -> b) -> a -> b
$ Image -> Buffer -> DedicatedAllocationMemoryAllocateInfoNV
DedicatedAllocationMemoryAllocateInfoNV
             Image
image Buffer
buffer

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

instance Zero DedicatedAllocationMemoryAllocateInfoNV where
  zero :: DedicatedAllocationMemoryAllocateInfoNV
zero = Image -> Buffer -> DedicatedAllocationMemoryAllocateInfoNV
DedicatedAllocationMemoryAllocateInfoNV
           Image
forall a. Zero a => a
zero
           Buffer
forall a. Zero a => a
zero


type NV_DEDICATED_ALLOCATION_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_NV_DEDICATED_ALLOCATION_SPEC_VERSION"
pattern NV_DEDICATED_ALLOCATION_SPEC_VERSION :: forall a . Integral a => a
pattern $bNV_DEDICATED_ALLOCATION_SPEC_VERSION :: a
$mNV_DEDICATED_ALLOCATION_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
NV_DEDICATED_ALLOCATION_SPEC_VERSION = 1


type NV_DEDICATED_ALLOCATION_EXTENSION_NAME = "VK_NV_dedicated_allocation"

-- No documentation found for TopLevel "VK_NV_DEDICATED_ALLOCATION_EXTENSION_NAME"
pattern NV_DEDICATED_ALLOCATION_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bNV_DEDICATED_ALLOCATION_EXTENSION_NAME :: a
$mNV_DEDICATED_ALLOCATION_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
NV_DEDICATED_ALLOCATION_EXTENSION_NAME = "VK_NV_dedicated_allocation"