{-# language CPP #-}
-- No documentation found for Chapter "Promoted_From_VK_KHR_dedicated_allocation"
module Vulkan.Core11.Promoted_From_VK_KHR_dedicated_allocation  ( MemoryDedicatedRequirements(..)
                                                                , MemoryDedicatedAllocateInfo(..)
                                                                , StructureType(..)
                                                                ) 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.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_MEMORY_DEDICATED_ALLOCATE_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_MEMORY_DEDICATED_REQUIREMENTS))
import Vulkan.Core10.Enums.StructureType (StructureType(..))
-- | VkMemoryDedicatedRequirements - Structure describing dedicated
-- allocation requirements of buffer and image resources
--
-- = Description
--
-- To determine the dedicated allocation requirements of a buffer or image
-- resource, add a 'MemoryDedicatedRequirements' structure to the @pNext@
-- chain of the
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_memory_requirements2.MemoryRequirements2'
-- structure passed as the @pMemoryRequirements@ parameter of
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_memory_requirements2.getBufferMemoryRequirements2'
-- or
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_memory_requirements2.getImageMemoryRequirements2',
-- respectively.
--
-- Constraints on the values returned for buffer resources are:
--
-- -   @requiresDedicatedAllocation@ /may/ be
--     'Vulkan.Core10.FundamentalTypes.TRUE' if the @pNext@ chain of
--     'Vulkan.Core10.Buffer.BufferCreateInfo' for the call to
--     'Vulkan.Core10.Buffer.createBuffer' used to create the buffer being
--     queried included a
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExternalMemoryBufferCreateInfo'
--     structure, and any of the handle types specified in
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExternalMemoryBufferCreateInfo'::@handleTypes@
--     requires dedicated allocation, as reported by
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory_capabilities.getPhysicalDeviceExternalBufferProperties'
--     in
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory_capabilities.ExternalBufferProperties'::@externalMemoryProperties.externalMemoryFeatures@.
--     Otherwise, @requiresDedicatedAllocation@ will be
--     'Vulkan.Core10.FundamentalTypes.FALSE'.
--
-- -   When the implementation sets @requiresDedicatedAllocation@ to
--     'Vulkan.Core10.FundamentalTypes.TRUE', it /must/ also set
--     @prefersDedicatedAllocation@ to
--     'Vulkan.Core10.FundamentalTypes.TRUE'.
--
-- -   If
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_SPARSE_BINDING_BIT'
--     was set in 'Vulkan.Core10.Buffer.BufferCreateInfo'::@flags@ when
--     @buffer@ was created, then both @prefersDedicatedAllocation@ and
--     @requiresDedicatedAllocation@ will be
--     'Vulkan.Core10.FundamentalTypes.FALSE'.
--
-- Constraints on the values returned for image resources are:
--
-- -   @requiresDedicatedAllocation@ /may/ be
--     'Vulkan.Core10.FundamentalTypes.TRUE' if the @pNext@ chain of
--     'Vulkan.Core10.Image.ImageCreateInfo' for the call to
--     'Vulkan.Core10.Image.createImage' used to create the image being
--     queried included a
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExternalMemoryImageCreateInfo'
--     structure, and any of the handle types specified in
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory.ExternalMemoryImageCreateInfo'::@handleTypes@
--     requires dedicated allocation, as reported by
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceImageFormatProperties2'
--     in
--     'Vulkan.Core11.Promoted_From_VK_KHR_external_memory_capabilities.ExternalImageFormatProperties'::@externalMemoryProperties.externalMemoryFeatures@.
--
-- -   @requiresDedicatedAllocation@ /may/ be
--     'Vulkan.Core10.FundamentalTypes.TRUE' if the image’s tiling is
--     'Vulkan.Core10.Enums.ImageTiling.IMAGE_TILING_DRM_FORMAT_MODIFIER_EXT'.
--
-- -   @requiresDedicatedAllocation@ will otherwise be
--     'Vulkan.Core10.FundamentalTypes.FALSE'
--
-- -   If
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SPARSE_BINDING_BIT'
--     was set in 'Vulkan.Core10.Image.ImageCreateInfo'::@flags@ when
--     @image@ was created, then both @prefersDedicatedAllocation@ and
--     @requiresDedicatedAllocation@ will be
--     'Vulkan.Core10.FundamentalTypes.FALSE'.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkMemoryDedicatedRequirements-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_MEMORY_DEDICATED_REQUIREMENTS'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_1 VK_VERSION_1_1>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data MemoryDedicatedRequirements = MemoryDedicatedRequirements
  { -- | @prefersDedicatedAllocation@ specifies that the implementation would
    -- prefer a dedicated allocation for this resource. The application is
    -- still free to suballocate the resource but it /may/ get better
    -- performance if a dedicated allocation is used.
    MemoryDedicatedRequirements -> Bool
prefersDedicatedAllocation :: Bool
  , -- | @requiresDedicatedAllocation@ specifies that a dedicated allocation is
    -- required for this resource.
    MemoryDedicatedRequirements -> Bool
requiresDedicatedAllocation :: Bool
  }
  deriving (Typeable, MemoryDedicatedRequirements -> MemoryDedicatedRequirements -> Bool
(MemoryDedicatedRequirements
 -> MemoryDedicatedRequirements -> Bool)
-> (MemoryDedicatedRequirements
    -> MemoryDedicatedRequirements -> Bool)
-> Eq MemoryDedicatedRequirements
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemoryDedicatedRequirements -> MemoryDedicatedRequirements -> Bool
$c/= :: MemoryDedicatedRequirements -> MemoryDedicatedRequirements -> Bool
== :: MemoryDedicatedRequirements -> MemoryDedicatedRequirements -> Bool
$c== :: MemoryDedicatedRequirements -> MemoryDedicatedRequirements -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MemoryDedicatedRequirements)
#endif
deriving instance Show MemoryDedicatedRequirements

instance ToCStruct MemoryDedicatedRequirements where
  withCStruct :: forall b.
MemoryDedicatedRequirements
-> (Ptr MemoryDedicatedRequirements -> IO b) -> IO b
withCStruct MemoryDedicatedRequirements
x Ptr MemoryDedicatedRequirements -> IO b
f = Int -> (Ptr MemoryDedicatedRequirements -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr MemoryDedicatedRequirements -> IO b) -> IO b)
-> (Ptr MemoryDedicatedRequirements -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr MemoryDedicatedRequirements
p -> Ptr MemoryDedicatedRequirements
-> MemoryDedicatedRequirements -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr MemoryDedicatedRequirements
p MemoryDedicatedRequirements
x (Ptr MemoryDedicatedRequirements -> IO b
f Ptr MemoryDedicatedRequirements
p)
  pokeCStruct :: forall b.
Ptr MemoryDedicatedRequirements
-> MemoryDedicatedRequirements -> IO b -> IO b
pokeCStruct Ptr MemoryDedicatedRequirements
p MemoryDedicatedRequirements{Bool
requiresDedicatedAllocation :: Bool
prefersDedicatedAllocation :: Bool
$sel:requiresDedicatedAllocation:MemoryDedicatedRequirements :: MemoryDedicatedRequirements -> Bool
$sel:prefersDedicatedAllocation:MemoryDedicatedRequirements :: MemoryDedicatedRequirements -> Bool
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryDedicatedRequirements
p Ptr MemoryDedicatedRequirements -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_DEDICATED_REQUIREMENTS)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryDedicatedRequirements
p Ptr MemoryDedicatedRequirements -> 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 MemoryDedicatedRequirements
p Ptr MemoryDedicatedRequirements -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
prefersDedicatedAllocation))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryDedicatedRequirements
p Ptr MemoryDedicatedRequirements -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
requiresDedicatedAllocation))
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr MemoryDedicatedRequirements -> IO b -> IO b
pokeZeroCStruct Ptr MemoryDedicatedRequirements
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryDedicatedRequirements
p Ptr MemoryDedicatedRequirements -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_DEDICATED_REQUIREMENTS)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryDedicatedRequirements
p Ptr MemoryDedicatedRequirements -> 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 MemoryDedicatedRequirements
p Ptr MemoryDedicatedRequirements -> 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))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryDedicatedRequirements
p Ptr MemoryDedicatedRequirements -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO b
f

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

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

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


-- | VkMemoryDedicatedAllocateInfo - Specify a dedicated memory allocation
-- resource
--
-- == Valid Usage
--
-- -   #VUID-VkMemoryDedicatedAllocateInfo-image-01432# At least one of
--     @image@ and @buffer@ /must/ be
--     'Vulkan.Core10.APIConstants.NULL_HANDLE'
--
-- -   #VUID-VkMemoryDedicatedAllocateInfo-image-02964# If @image@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE' and the memory is not an
--     imported Android Hardware Buffer,
--     'Vulkan.Core10.Memory.MemoryAllocateInfo'::@allocationSize@ /must/
--     equal the
--     'Vulkan.Core10.MemoryManagement.MemoryRequirements'::@size@ of the
--     image
--
-- -   #VUID-VkMemoryDedicatedAllocateInfo-image-01434# If @image@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', @image@ /must/ have been
--     created without
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SPARSE_BINDING_BIT'
--     set in 'Vulkan.Core10.Image.ImageCreateInfo'::@flags@
--
-- -   #VUID-VkMemoryDedicatedAllocateInfo-buffer-02965# If @buffer@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE' and the memory is not an
--     imported Android Hardware Buffer,
--     'Vulkan.Core10.Memory.MemoryAllocateInfo'::@allocationSize@ /must/
--     equal the
--     'Vulkan.Core10.MemoryManagement.MemoryRequirements'::@size@ of the
--     buffer
--
-- -   #VUID-VkMemoryDedicatedAllocateInfo-buffer-01436# If @buffer@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', @buffer@ /must/ have been
--     created without
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_SPARSE_BINDING_BIT'
--     set in 'Vulkan.Core10.Buffer.BufferCreateInfo'::@flags@
--
-- -   #VUID-VkMemoryDedicatedAllocateInfo-image-01876# If @image@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE' and
--     'Vulkan.Core10.Memory.MemoryAllocateInfo' defines a memory import
--     operation with handle type
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_OPAQUE_WIN32_BIT',
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_OPAQUE_WIN32_KMT_BIT',
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_D3D11_TEXTURE_BIT',
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_D3D11_TEXTURE_KMT_BIT',
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_D3D12_HEAP_BIT',
--     or
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_D3D12_RESOURCE_BIT',
--     and the external handle was created by the Vulkan API, then 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-VkMemoryDedicatedAllocateInfo-buffer-01877# If @buffer@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE' and
--     'Vulkan.Core10.Memory.MemoryAllocateInfo' defines a memory import
--     operation with handle type
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_OPAQUE_WIN32_BIT',
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_OPAQUE_WIN32_KMT_BIT',
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_D3D11_TEXTURE_BIT',
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_D3D11_TEXTURE_KMT_BIT',
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_D3D12_HEAP_BIT',
--     or
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_D3D12_RESOURCE_BIT',
--     and the external handle was created by the Vulkan API, then the
--     memory being imported /must/ also be a dedicated buffer allocation
--     and @buffer@ /must/ be identical to the buffer associated with the
--     imported memory
--
-- -   #VUID-VkMemoryDedicatedAllocateInfo-image-01878# If @image@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE' and
--     'Vulkan.Core10.Memory.MemoryAllocateInfo' defines a memory import
--     operation with handle type
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_OPAQUE_FD_BIT',
--     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-VkMemoryDedicatedAllocateInfo-buffer-01879# If @buffer@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE' and
--     'Vulkan.Core10.Memory.MemoryAllocateInfo' defines a memory import
--     operation with handle type
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_OPAQUE_FD_BIT',
--     the memory being imported /must/ also be a dedicated buffer
--     allocation and @buffer@ /must/ be identical to the buffer associated
--     with the imported memory
--
-- -   #VUID-VkMemoryDedicatedAllocateInfo-image-01797# If @image@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', @image@ /must/ not have
--     been created with
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_DISJOINT_BIT'
--     set in 'Vulkan.Core10.Image.ImageCreateInfo'::@flags@
--
-- -   #VUID-VkMemoryDedicatedAllocateInfo-image-04751# If @image@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE' and
--     'Vulkan.Core10.Memory.MemoryAllocateInfo' defines a memory import
--     operation with handle type
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_ZIRCON_VMO_BIT_FUCHSIA',
--     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-VkMemoryDedicatedAllocateInfo-buffer-04752# If @buffer@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE' and
--     'Vulkan.Core10.Memory.MemoryAllocateInfo' defines a memory import
--     operation with handle type
--     'Vulkan.Core11.Enums.ExternalMemoryHandleTypeFlagBits.EXTERNAL_MEMORY_HANDLE_TYPE_ZIRCON_VMO_BIT_FUCHSIA',
--     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-VkMemoryDedicatedAllocateInfo-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_MEMORY_DEDICATED_ALLOCATE_INFO'
--
-- -   #VUID-VkMemoryDedicatedAllocateInfo-image-parameter# If @image@ is
--     not 'Vulkan.Core10.APIConstants.NULL_HANDLE', @image@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Image' handle
--
-- -   #VUID-VkMemoryDedicatedAllocateInfo-buffer-parameter# If @buffer@ is
--     not 'Vulkan.Core10.APIConstants.NULL_HANDLE', @buffer@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Buffer' handle
--
-- -   #VUID-VkMemoryDedicatedAllocateInfo-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_VERSION_1_1 VK_VERSION_1_1>,
-- 'Vulkan.Core10.Handles.Buffer', 'Vulkan.Core10.Handles.Image',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data MemoryDedicatedAllocateInfo = MemoryDedicatedAllocateInfo
  { -- | @image@ is 'Vulkan.Core10.APIConstants.NULL_HANDLE' or a handle of an
    -- image which this memory will be bound to.
    MemoryDedicatedAllocateInfo -> Image
image :: Image
  , -- | @buffer@ is 'Vulkan.Core10.APIConstants.NULL_HANDLE' or a handle of a
    -- buffer which this memory will be bound to.
    MemoryDedicatedAllocateInfo -> Buffer
buffer :: Buffer
  }
  deriving (Typeable, MemoryDedicatedAllocateInfo -> MemoryDedicatedAllocateInfo -> Bool
(MemoryDedicatedAllocateInfo
 -> MemoryDedicatedAllocateInfo -> Bool)
-> (MemoryDedicatedAllocateInfo
    -> MemoryDedicatedAllocateInfo -> Bool)
-> Eq MemoryDedicatedAllocateInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemoryDedicatedAllocateInfo -> MemoryDedicatedAllocateInfo -> Bool
$c/= :: MemoryDedicatedAllocateInfo -> MemoryDedicatedAllocateInfo -> Bool
== :: MemoryDedicatedAllocateInfo -> MemoryDedicatedAllocateInfo -> Bool
$c== :: MemoryDedicatedAllocateInfo -> MemoryDedicatedAllocateInfo -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MemoryDedicatedAllocateInfo)
#endif
deriving instance Show MemoryDedicatedAllocateInfo

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

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

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