{-# language CPP #-}
-- No documentation found for Chapter "OtherTypes"
module Vulkan.Core10.OtherTypes  ( MemoryBarrier(..)
                                 , BufferMemoryBarrier(..)
                                 , ImageMemoryBarrier(..)
                                 , PipelineCacheHeaderVersionOne(..)
                                 , DrawIndirectCommand(..)
                                 , DrawIndexedIndirectCommand(..)
                                 , DispatchIndirectCommand(..)
                                 , BaseOutStructure(..)
                                 , BaseInStructure(..)
                                 , ObjectType(..)
                                 , VendorId(..)
                                 ) where

import Vulkan.CStruct.Utils (FixedArray)
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytes)
import GHC.Ptr (castPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Data.Type.Equality ((:~:)(Refl))
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 Data.Int (Int32)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Word (Word8)
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Vulkan.CStruct.Utils (peekByteStringFromSizedVectorPtr)
import Vulkan.CStruct.Utils (pokeFixedLengthByteString)
import Vulkan.Core10.Enums.AccessFlagBits (AccessFlags)
import Vulkan.Core10.Handles (Buffer)
import Vulkan.CStruct.Extends (Chain)
import Vulkan.Core10.FundamentalTypes (DeviceSize)
import Vulkan.CStruct.Extends (Extends)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (Extensible(..))
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_external_memory_acquire_unmodified (ExternalMemoryAcquireUnmodifiedEXT)
import Vulkan.Core10.Handles (Image)
import Vulkan.Core10.Enums.ImageLayout (ImageLayout)
import Vulkan.Core10.ImageView (ImageSubresourceRange)
import Vulkan.CStruct.Extends (PeekChain)
import Vulkan.CStruct.Extends (PeekChain(..))
import Vulkan.Core10.Enums.PipelineCacheHeaderVersion (PipelineCacheHeaderVersion)
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (PokeChain(..))
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_sample_locations (SampleLocationsInfoEXT)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.APIConstants (UUID_SIZE)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_BUFFER_MEMORY_BARRIER))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_IMAGE_MEMORY_BARRIER))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_MEMORY_BARRIER))
import Vulkan.CStruct.Extends (BaseInStructure(..))
import Vulkan.CStruct.Extends (BaseOutStructure(..))
import Vulkan.Core10.Enums.ObjectType (ObjectType(..))
import Vulkan.Core10.Enums.VendorId (VendorId(..))
-- | VkMemoryBarrier - Structure specifying a global memory barrier
--
-- = Description
--
-- The first
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-dependencies-access-scopes access scope>
-- is limited to access types in the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-access-masks source access mask>
-- specified by @srcAccessMask@.
--
-- The second
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-dependencies-access-scopes access scope>
-- is limited to access types in the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-access-masks destination access mask>
-- specified by @dstAccessMask@.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'Vulkan.Core10.Enums.AccessFlagBits.AccessFlags',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'Vulkan.Core10.CommandBufferBuilding.cmdPipelineBarrier',
-- 'Vulkan.Core10.CommandBufferBuilding.cmdWaitEvents'
data MemoryBarrier = MemoryBarrier
  { -- | @srcAccessMask@ is a bitmask of
    -- 'Vulkan.Core10.Enums.AccessFlagBits.AccessFlagBits' specifying a
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-access-masks source access mask>.
    --
    -- #VUID-VkMemoryBarrier-srcAccessMask-parameter# @srcAccessMask@ /must/ be
    -- a valid combination of
    -- 'Vulkan.Core10.Enums.AccessFlagBits.AccessFlagBits' values
    MemoryBarrier -> AccessFlags
srcAccessMask :: AccessFlags
  , -- | @dstAccessMask@ is a bitmask of
    -- 'Vulkan.Core10.Enums.AccessFlagBits.AccessFlagBits' specifying a
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-access-masks destination access mask>.
    --
    -- #VUID-VkMemoryBarrier-dstAccessMask-parameter# @dstAccessMask@ /must/ be
    -- a valid combination of
    -- 'Vulkan.Core10.Enums.AccessFlagBits.AccessFlagBits' values
    MemoryBarrier -> AccessFlags
dstAccessMask :: AccessFlags
  }
  deriving (Typeable, MemoryBarrier -> MemoryBarrier -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemoryBarrier -> MemoryBarrier -> Bool
$c/= :: MemoryBarrier -> MemoryBarrier -> Bool
== :: MemoryBarrier -> MemoryBarrier -> Bool
$c== :: MemoryBarrier -> MemoryBarrier -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MemoryBarrier)
#endif
deriving instance Show MemoryBarrier

instance ToCStruct MemoryBarrier where
  withCStruct :: forall b. MemoryBarrier -> (Ptr MemoryBarrier -> IO b) -> IO b
withCStruct MemoryBarrier
x Ptr MemoryBarrier -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr MemoryBarrier
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr MemoryBarrier
p MemoryBarrier
x (Ptr MemoryBarrier -> IO b
f Ptr MemoryBarrier
p)
  pokeCStruct :: forall b. Ptr MemoryBarrier -> MemoryBarrier -> IO b -> IO b
pokeCStruct Ptr MemoryBarrier
p MemoryBarrier{AccessFlags
dstAccessMask :: AccessFlags
srcAccessMask :: AccessFlags
$sel:dstAccessMask:MemoryBarrier :: MemoryBarrier -> AccessFlags
$sel:srcAccessMask:MemoryBarrier :: MemoryBarrier -> AccessFlags
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryBarrier
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_BARRIER)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryBarrier
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 MemoryBarrier
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr AccessFlags)) (AccessFlags
srcAccessMask)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryBarrier
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr AccessFlags)) (AccessFlags
dstAccessMask)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr MemoryBarrier -> IO b -> IO b
pokeZeroCStruct Ptr MemoryBarrier
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryBarrier
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_BARRIER)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryBarrier
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    IO b
f

instance FromCStruct MemoryBarrier where
  peekCStruct :: Ptr MemoryBarrier -> IO MemoryBarrier
peekCStruct Ptr MemoryBarrier
p = do
    AccessFlags
srcAccessMask <- forall a. Storable a => Ptr a -> IO a
peek @AccessFlags ((Ptr MemoryBarrier
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr AccessFlags))
    AccessFlags
dstAccessMask <- forall a. Storable a => Ptr a -> IO a
peek @AccessFlags ((Ptr MemoryBarrier
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr AccessFlags))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ AccessFlags -> AccessFlags -> MemoryBarrier
MemoryBarrier
             AccessFlags
srcAccessMask AccessFlags
dstAccessMask

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

instance Zero MemoryBarrier where
  zero :: MemoryBarrier
zero = AccessFlags -> AccessFlags -> MemoryBarrier
MemoryBarrier
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkBufferMemoryBarrier - Structure specifying a buffer memory barrier
--
-- = Description
--
-- The first
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-dependencies-access-scopes access scope>
-- is limited to access to memory through the specified buffer range, via
-- access types in the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-access-masks source access mask>
-- specified by @srcAccessMask@. If @srcAccessMask@ includes
-- 'Vulkan.Core10.Enums.AccessFlagBits.ACCESS_HOST_WRITE_BIT', a
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-dependencies-available-and-visible memory domain operation>
-- is performed where available memory in the host domain is also made
-- available to the device domain.
--
-- The second
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-dependencies-access-scopes access scope>
-- is limited to access to memory through the specified buffer range, via
-- access types in the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-access-masks destination access mask>
-- specified by @dstAccessMask@. If @dstAccessMask@ includes
-- 'Vulkan.Core10.Enums.AccessFlagBits.ACCESS_HOST_WRITE_BIT' or
-- 'Vulkan.Core10.Enums.AccessFlagBits.ACCESS_HOST_READ_BIT', a
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-dependencies-available-and-visible memory domain operation>
-- is performed where available memory in the device domain is also made
-- available to the host domain.
--
-- Note
--
-- When
-- 'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_HOST_COHERENT_BIT'
-- is used, available memory in host domain is automatically made visible
-- to host domain, and any host write is automatically made available to
-- host domain.
--
-- If @srcQueueFamilyIndex@ is not equal to @dstQueueFamilyIndex@, and
-- @srcQueueFamilyIndex@ is equal to the current queue family, then the
-- memory barrier defines a
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-queue-transfers-release queue family release operation>
-- for the specified buffer range, and the second access scope includes no
-- access, as if @dstAccessMask@ was @0@.
--
-- If @dstQueueFamilyIndex@ is not equal to @srcQueueFamilyIndex@, and
-- @dstQueueFamilyIndex@ is equal to the current queue family, then the
-- memory barrier defines a
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-queue-transfers-acquire queue family acquire operation>
-- for the specified buffer range, and the first access scope includes no
-- access, as if @srcAccessMask@ was @0@.
--
-- == Valid Usage
--
-- -   #VUID-VkBufferMemoryBarrier-offset-01187# @offset@ /must/ be less
--     than the size of @buffer@
--
-- -   #VUID-VkBufferMemoryBarrier-size-01188# If @size@ is not equal to
--     'Vulkan.Core10.APIConstants.WHOLE_SIZE', @size@ /must/ be greater
--     than @0@
--
-- -   #VUID-VkBufferMemoryBarrier-size-01189# If @size@ is not equal to
--     'Vulkan.Core10.APIConstants.WHOLE_SIZE', @size@ /must/ be less than
--     or equal to than the size of @buffer@ minus @offset@
--
-- -   #VUID-VkBufferMemoryBarrier-buffer-01931# If @buffer@ is non-sparse
--     then it /must/ be bound completely and contiguously to a single
--     'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   #VUID-VkBufferMemoryBarrier-buffer-09095# If @buffer@ was created
--     with a sharing mode of
--     'Vulkan.Core10.Enums.SharingMode.SHARING_MODE_EXCLUSIVE', and
--     @srcQueueFamilyIndex@ and @dstQueueFamilyIndex@ are not equal,
--     @srcQueueFamilyIndex@ /must/ be
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_EXTERNAL',
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_FOREIGN_EXT', or a valid
--     queue family
--
-- -   #VUID-VkBufferMemoryBarrier-buffer-09096# If @buffer@ was created
--     with a sharing mode of
--     'Vulkan.Core10.Enums.SharingMode.SHARING_MODE_EXCLUSIVE', and
--     @srcQueueFamilyIndex@ and @dstQueueFamilyIndex@ are not equal,
--     @dstQueueFamilyIndex@ /must/ be
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_EXTERNAL',
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_FOREIGN_EXT', or a valid
--     queue family
--
-- -   #VUID-VkBufferMemoryBarrier-srcQueueFamilyIndex-04087# If
--     @srcQueueFamilyIndex@ is not equal to @dstQueueFamilyIndex@, at
--     least one of @srcQueueFamilyIndex@ or @dstQueueFamilyIndex@ /must/
--     not be 'Vulkan.Core10.APIConstants.QUEUE_FAMILY_EXTERNAL' or
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_FOREIGN_EXT'
--
-- -   #VUID-VkBufferMemoryBarrier-None-09097# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_external_memory VK_KHR_external_memory>
--     extension is not enabled, and the value of
--     'Vulkan.Core10.DeviceInitialization.ApplicationInfo'::@apiVersion@
--     used to create the 'Vulkan.Core10.Handles.Instance' is not greater
--     than or equal to Version 1.1, @srcQueueFamilyIndex@ /must/ not be
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_EXTERNAL'
--
-- -   #VUID-VkBufferMemoryBarrier-None-09098# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_external_memory VK_KHR_external_memory>
--     extension is not enabled, and the value of
--     'Vulkan.Core10.DeviceInitialization.ApplicationInfo'::@apiVersion@
--     used to create the 'Vulkan.Core10.Handles.Instance' is not greater
--     than or equal to Version 1.1, @dstQueueFamilyIndex@ /must/ not be
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_EXTERNAL'
--
-- -   #VUID-VkBufferMemoryBarrier-srcQueueFamilyIndex-09099# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_queue_family_foreign VK_EXT_queue_family_foreign>
--     extension is not enabled @srcQueueFamilyIndex@ /must/ not be
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_FOREIGN_EXT'
--
-- -   #VUID-VkBufferMemoryBarrier-dstQueueFamilyIndex-09100# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_queue_family_foreign VK_EXT_queue_family_foreign>
--     extension is not enabled @dstQueueFamilyIndex@ /must/ not be
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_FOREIGN_EXT'
--
-- -   #VUID-VkBufferMemoryBarrier-None-09049# If the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-synchronization2 synchronization2>
--     feature is not enabled, and @buffer@ was created with a sharing mode
--     of 'Vulkan.Core10.Enums.SharingMode.SHARING_MODE_CONCURRENT', at
--     least one of @srcQueueFamilyIndex@ and @dstQueueFamilyIndex@ /must/
--     be 'Vulkan.Core10.APIConstants.QUEUE_FAMILY_IGNORED'
--
-- -   #VUID-VkBufferMemoryBarrier-None-09050# If the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-synchronization2 synchronization2>
--     feature is not enabled, and @buffer@ was created with a sharing mode
--     of 'Vulkan.Core10.Enums.SharingMode.SHARING_MODE_CONCURRENT',
--     @srcQueueFamilyIndex@ /must/ be
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_IGNORED' or
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_EXTERNAL'
--
-- -   #VUID-VkBufferMemoryBarrier-None-09051# If the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-synchronization2 synchronization2>
--     feature is not enabled, and @buffer@ was created with a sharing mode
--     of 'Vulkan.Core10.Enums.SharingMode.SHARING_MODE_CONCURRENT',
--     @dstQueueFamilyIndex@ /must/ be
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_IGNORED' or
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_EXTERNAL'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkBufferMemoryBarrier-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_BUFFER_MEMORY_BARRIER'
--
-- -   #VUID-VkBufferMemoryBarrier-pNext-pNext# @pNext@ /must/ be @NULL@ or
--     a pointer to a valid instance of
--     'Vulkan.Extensions.VK_EXT_external_memory_acquire_unmodified.ExternalMemoryAcquireUnmodifiedEXT'
--
-- -   #VUID-VkBufferMemoryBarrier-sType-unique# The @sType@ value of each
--     struct in the @pNext@ chain /must/ be unique
--
-- -   #VUID-VkBufferMemoryBarrier-buffer-parameter# @buffer@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Buffer' handle
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'Vulkan.Core10.Enums.AccessFlagBits.AccessFlags',
-- 'Vulkan.Core10.Handles.Buffer',
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'Vulkan.Core10.CommandBufferBuilding.cmdPipelineBarrier',
-- 'Vulkan.Core10.CommandBufferBuilding.cmdWaitEvents'
data BufferMemoryBarrier (es :: [Type]) = BufferMemoryBarrier
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    forall (es :: [*]). BufferMemoryBarrier es -> Chain es
next :: Chain es
  , -- | @srcAccessMask@ is a bitmask of
    -- 'Vulkan.Core10.Enums.AccessFlagBits.AccessFlagBits' specifying a
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-access-masks source access mask>.
    forall (es :: [*]). BufferMemoryBarrier es -> AccessFlags
srcAccessMask :: AccessFlags
  , -- | @dstAccessMask@ is a bitmask of
    -- 'Vulkan.Core10.Enums.AccessFlagBits.AccessFlagBits' specifying a
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-access-masks destination access mask>.
    forall (es :: [*]). BufferMemoryBarrier es -> AccessFlags
dstAccessMask :: AccessFlags
  , -- | @srcQueueFamilyIndex@ is the source queue family for a
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>.
    forall (es :: [*]). BufferMemoryBarrier es -> Word32
srcQueueFamilyIndex :: Word32
  , -- | @dstQueueFamilyIndex@ is the destination queue family for a
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>.
    forall (es :: [*]). BufferMemoryBarrier es -> Word32
dstQueueFamilyIndex :: Word32
  , -- | @buffer@ is a handle to the buffer whose backing memory is affected by
    -- the barrier.
    forall (es :: [*]). BufferMemoryBarrier es -> Buffer
buffer :: Buffer
  , -- | @offset@ is an offset in bytes into the backing memory for @buffer@;
    -- this is relative to the base offset as bound to the buffer (see
    -- 'Vulkan.Core10.MemoryManagement.bindBufferMemory').
    forall (es :: [*]). BufferMemoryBarrier es -> DeviceSize
offset :: DeviceSize
  , -- | @size@ is a size in bytes of the affected area of backing memory for
    -- @buffer@, or 'Vulkan.Core10.APIConstants.WHOLE_SIZE' to use the range
    -- from @offset@ to the end of the buffer.
    forall (es :: [*]). BufferMemoryBarrier es -> DeviceSize
size :: DeviceSize
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (BufferMemoryBarrier (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (BufferMemoryBarrier es)

instance Extensible BufferMemoryBarrier where
  extensibleTypeName :: String
extensibleTypeName = String
"BufferMemoryBarrier"
  setNext :: forall (ds :: [*]) (es :: [*]).
BufferMemoryBarrier ds -> Chain es -> BufferMemoryBarrier es
setNext BufferMemoryBarrier{Word32
DeviceSize
Chain ds
Buffer
AccessFlags
size :: DeviceSize
offset :: DeviceSize
buffer :: Buffer
dstQueueFamilyIndex :: Word32
srcQueueFamilyIndex :: Word32
dstAccessMask :: AccessFlags
srcAccessMask :: AccessFlags
next :: Chain ds
$sel:size:BufferMemoryBarrier :: forall (es :: [*]). BufferMemoryBarrier es -> DeviceSize
$sel:offset:BufferMemoryBarrier :: forall (es :: [*]). BufferMemoryBarrier es -> DeviceSize
$sel:buffer:BufferMemoryBarrier :: forall (es :: [*]). BufferMemoryBarrier es -> Buffer
$sel:dstQueueFamilyIndex:BufferMemoryBarrier :: forall (es :: [*]). BufferMemoryBarrier es -> Word32
$sel:srcQueueFamilyIndex:BufferMemoryBarrier :: forall (es :: [*]). BufferMemoryBarrier es -> Word32
$sel:dstAccessMask:BufferMemoryBarrier :: forall (es :: [*]). BufferMemoryBarrier es -> AccessFlags
$sel:srcAccessMask:BufferMemoryBarrier :: forall (es :: [*]). BufferMemoryBarrier es -> AccessFlags
$sel:next:BufferMemoryBarrier :: forall (es :: [*]). BufferMemoryBarrier es -> Chain es
..} Chain es
next' = BufferMemoryBarrier{$sel:next:BufferMemoryBarrier :: Chain es
next = Chain es
next', Word32
DeviceSize
Buffer
AccessFlags
size :: DeviceSize
offset :: DeviceSize
buffer :: Buffer
dstQueueFamilyIndex :: Word32
srcQueueFamilyIndex :: Word32
dstAccessMask :: AccessFlags
srcAccessMask :: AccessFlags
$sel:size:BufferMemoryBarrier :: DeviceSize
$sel:offset:BufferMemoryBarrier :: DeviceSize
$sel:buffer:BufferMemoryBarrier :: Buffer
$sel:dstQueueFamilyIndex:BufferMemoryBarrier :: Word32
$sel:srcQueueFamilyIndex:BufferMemoryBarrier :: Word32
$sel:dstAccessMask:BufferMemoryBarrier :: AccessFlags
$sel:srcAccessMask:BufferMemoryBarrier :: AccessFlags
..}
  getNext :: forall (es :: [*]). BufferMemoryBarrier es -> Chain es
getNext BufferMemoryBarrier{Word32
DeviceSize
Chain es
Buffer
AccessFlags
size :: DeviceSize
offset :: DeviceSize
buffer :: Buffer
dstQueueFamilyIndex :: Word32
srcQueueFamilyIndex :: Word32
dstAccessMask :: AccessFlags
srcAccessMask :: AccessFlags
next :: Chain es
$sel:size:BufferMemoryBarrier :: forall (es :: [*]). BufferMemoryBarrier es -> DeviceSize
$sel:offset:BufferMemoryBarrier :: forall (es :: [*]). BufferMemoryBarrier es -> DeviceSize
$sel:buffer:BufferMemoryBarrier :: forall (es :: [*]). BufferMemoryBarrier es -> Buffer
$sel:dstQueueFamilyIndex:BufferMemoryBarrier :: forall (es :: [*]). BufferMemoryBarrier es -> Word32
$sel:srcQueueFamilyIndex:BufferMemoryBarrier :: forall (es :: [*]). BufferMemoryBarrier es -> Word32
$sel:dstAccessMask:BufferMemoryBarrier :: forall (es :: [*]). BufferMemoryBarrier es -> AccessFlags
$sel:srcAccessMask:BufferMemoryBarrier :: forall (es :: [*]). BufferMemoryBarrier es -> AccessFlags
$sel:next:BufferMemoryBarrier :: forall (es :: [*]). BufferMemoryBarrier es -> Chain es
..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends BufferMemoryBarrier e => b) -> Maybe b
  extends :: forall e b (proxy :: * -> *).
Typeable e =>
proxy e -> (Extends BufferMemoryBarrier e => b) -> Maybe b
extends proxy e
_ Extends BufferMemoryBarrier e => b
f
    | Just e :~: ExternalMemoryAcquireUnmodifiedEXT
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ExternalMemoryAcquireUnmodifiedEXT = forall a. a -> Maybe a
Just Extends BufferMemoryBarrier e => b
f
    | Bool
otherwise = forall a. Maybe a
Nothing

instance ( Extendss BufferMemoryBarrier es
         , PokeChain es ) => ToCStruct (BufferMemoryBarrier es) where
  withCStruct :: forall b.
BufferMemoryBarrier es
-> (Ptr (BufferMemoryBarrier es) -> IO b) -> IO b
withCStruct BufferMemoryBarrier es
x Ptr (BufferMemoryBarrier es) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
56 forall a b. (a -> b) -> a -> b
$ \Ptr (BufferMemoryBarrier es)
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (BufferMemoryBarrier es)
p BufferMemoryBarrier es
x (Ptr (BufferMemoryBarrier es) -> IO b
f Ptr (BufferMemoryBarrier es)
p)
  pokeCStruct :: forall b.
Ptr (BufferMemoryBarrier es)
-> BufferMemoryBarrier es -> IO b -> IO b
pokeCStruct Ptr (BufferMemoryBarrier es)
p BufferMemoryBarrier{Word32
DeviceSize
Chain es
Buffer
AccessFlags
size :: DeviceSize
offset :: DeviceSize
buffer :: Buffer
dstQueueFamilyIndex :: Word32
srcQueueFamilyIndex :: Word32
dstAccessMask :: AccessFlags
srcAccessMask :: AccessFlags
next :: Chain es
$sel:size:BufferMemoryBarrier :: forall (es :: [*]). BufferMemoryBarrier es -> DeviceSize
$sel:offset:BufferMemoryBarrier :: forall (es :: [*]). BufferMemoryBarrier es -> DeviceSize
$sel:buffer:BufferMemoryBarrier :: forall (es :: [*]). BufferMemoryBarrier es -> Buffer
$sel:dstQueueFamilyIndex:BufferMemoryBarrier :: forall (es :: [*]). BufferMemoryBarrier es -> Word32
$sel:srcQueueFamilyIndex:BufferMemoryBarrier :: forall (es :: [*]). BufferMemoryBarrier es -> Word32
$sel:dstAccessMask:BufferMemoryBarrier :: forall (es :: [*]). BufferMemoryBarrier es -> AccessFlags
$sel:srcAccessMask:BufferMemoryBarrier :: forall (es :: [*]). BufferMemoryBarrier es -> AccessFlags
$sel:next:BufferMemoryBarrier :: forall (es :: [*]). BufferMemoryBarrier es -> Chain es
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_BUFFER_MEMORY_BARRIER)
    Ptr ()
pNext'' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext''
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr AccessFlags)) (AccessFlags
srcAccessMask)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr AccessFlags)) (AccessFlags
dstAccessMask)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Word32
srcQueueFamilyIndex)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (Word32
dstQueueFamilyIndex)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Buffer)) (Buffer
buffer)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr DeviceSize)) (DeviceSize
offset)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr DeviceSize)) (DeviceSize
size)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = Int
56
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr (BufferMemoryBarrier es) -> IO b -> IO b
pokeZeroCStruct Ptr (BufferMemoryBarrier es)
p IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_BUFFER_MEMORY_BARRIER)
    Ptr ()
pNext' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext'
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr AccessFlags)) (forall a. Zero a => a
zero)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr AccessFlags)) (forall a. Zero a => a
zero)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Buffer)) (forall a. Zero a => a
zero)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f

instance ( Extendss BufferMemoryBarrier es
         , PeekChain es ) => FromCStruct (BufferMemoryBarrier es) where
  peekCStruct :: Ptr (BufferMemoryBarrier es) -> IO (BufferMemoryBarrier es)
peekCStruct Ptr (BufferMemoryBarrier es)
p = do
    Ptr ()
pNext <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ())))
    Chain es
next <- forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
    AccessFlags
srcAccessMask <- forall a. Storable a => Ptr a -> IO a
peek @AccessFlags ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr AccessFlags))
    AccessFlags
dstAccessMask <- forall a. Storable a => Ptr a -> IO a
peek @AccessFlags ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr AccessFlags))
    Word32
srcQueueFamilyIndex <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32))
    Word32
dstQueueFamilyIndex <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32))
    Buffer
buffer <- forall a. Storable a => Ptr a -> IO a
peek @Buffer ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Buffer))
    DeviceSize
offset <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr DeviceSize))
    DeviceSize
size <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr (BufferMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr DeviceSize))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (es :: [*]).
Chain es
-> AccessFlags
-> AccessFlags
-> Word32
-> Word32
-> Buffer
-> DeviceSize
-> DeviceSize
-> BufferMemoryBarrier es
BufferMemoryBarrier
             Chain es
next
             AccessFlags
srcAccessMask
             AccessFlags
dstAccessMask
             Word32
srcQueueFamilyIndex
             Word32
dstQueueFamilyIndex
             Buffer
buffer
             DeviceSize
offset
             DeviceSize
size

instance es ~ '[] => Zero (BufferMemoryBarrier es) where
  zero :: BufferMemoryBarrier es
zero = forall (es :: [*]).
Chain es
-> AccessFlags
-> AccessFlags
-> Word32
-> Word32
-> Buffer
-> DeviceSize
-> DeviceSize
-> BufferMemoryBarrier es
BufferMemoryBarrier
           ()
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkImageMemoryBarrier - Structure specifying the parameters of an image
-- memory barrier
--
-- = Description
--
-- The first
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-dependencies-access-scopes access scope>
-- is limited to access to memory through the specified image subresource
-- range, via access types in the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-access-masks source access mask>
-- specified by @srcAccessMask@. If @srcAccessMask@ includes
-- 'Vulkan.Core10.Enums.AccessFlagBits.ACCESS_HOST_WRITE_BIT', memory
-- writes performed by that access type are also made visible, as that
-- access type is not performed through a resource.
--
-- The second
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-dependencies-access-scopes access scope>
-- is limited to access to memory through the specified image subresource
-- range, via access types in the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-access-masks destination access mask>
-- specified by @dstAccessMask@. If @dstAccessMask@ includes
-- 'Vulkan.Core10.Enums.AccessFlagBits.ACCESS_HOST_WRITE_BIT' or
-- 'Vulkan.Core10.Enums.AccessFlagBits.ACCESS_HOST_READ_BIT', available
-- memory writes are also made visible to accesses of those types, as those
-- access types are not performed through a resource.
--
-- If @srcQueueFamilyIndex@ is not equal to @dstQueueFamilyIndex@, and
-- @srcQueueFamilyIndex@ is equal to the current queue family, then the
-- memory barrier defines a
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-queue-transfers-release queue family release operation>
-- for the specified image subresource range, and the second access scope
-- includes no access, as if @dstAccessMask@ was @0@.
--
-- If @dstQueueFamilyIndex@ is not equal to @srcQueueFamilyIndex@, and
-- @dstQueueFamilyIndex@ is equal to the current queue family, then the
-- memory barrier defines a
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-queue-transfers-acquire queue family acquire operation>
-- for the specified image subresource range, and the first access scope
-- includes no access, as if @srcAccessMask@ was @0@.
--
-- If the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-synchronization2 synchronization2>
-- feature is not enabled or @oldLayout@ is not equal to @newLayout@,
-- @oldLayout@ and @newLayout@ define an
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>
-- for the specified image subresource range.
--
-- Note
--
-- If the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-synchronization2 synchronization2>
-- feature is enabled, when the old and new layout are equal, the layout
-- values are ignored - data is preserved no matter what values are
-- specified, or what layout the image is currently in.
--
-- If @image@ has a multi-planar format and the image is /disjoint/, then
-- including
-- 'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_COLOR_BIT' in the
-- @aspectMask@ member of @subresourceRange@ is equivalent to including
-- 'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_0_BIT',
-- 'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_1_BIT', and
-- (for three-plane formats only)
-- 'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_2_BIT'.
--
-- == Valid Usage
--
-- -   #VUID-VkImageMemoryBarrier-oldLayout-01208# If @srcQueueFamilyIndex@
--     and @dstQueueFamilyIndex@ define a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>
--     or @oldLayout@ and @newLayout@ define an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>,
--     and @oldLayout@ or @newLayout@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL'
--     then @image@ /must/ have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_COLOR_ATTACHMENT_BIT'
--
-- -   #VUID-VkImageMemoryBarrier-oldLayout-01209# If @srcQueueFamilyIndex@
--     and @dstQueueFamilyIndex@ define a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>
--     or @oldLayout@ and @newLayout@ define an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>,
--     and @oldLayout@ or @newLayout@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL'
--     then @image@ /must/ have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT'
--
-- -   #VUID-VkImageMemoryBarrier-oldLayout-01210# If @srcQueueFamilyIndex@
--     and @dstQueueFamilyIndex@ define a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>
--     or @oldLayout@ and @newLayout@ define an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>,
--     and @oldLayout@ or @newLayout@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_STENCIL_READ_ONLY_OPTIMAL'
--     then @image@ /must/ have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT'
--
-- -   #VUID-VkImageMemoryBarrier-oldLayout-01211# If @srcQueueFamilyIndex@
--     and @dstQueueFamilyIndex@ define a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>
--     or @oldLayout@ and @newLayout@ define an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>,
--     and @oldLayout@ or @newLayout@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL'
--     then @image@ /must/ have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_SAMPLED_BIT' or
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_INPUT_ATTACHMENT_BIT'
--
-- -   #VUID-VkImageMemoryBarrier-oldLayout-01212# If @srcQueueFamilyIndex@
--     and @dstQueueFamilyIndex@ define a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>
--     or @oldLayout@ and @newLayout@ define an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>,
--     and @oldLayout@ or @newLayout@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_TRANSFER_SRC_OPTIMAL'
--     then @image@ /must/ have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_TRANSFER_SRC_BIT'
--
-- -   #VUID-VkImageMemoryBarrier-oldLayout-01213# If @srcQueueFamilyIndex@
--     and @dstQueueFamilyIndex@ define a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>
--     or @oldLayout@ and @newLayout@ define an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>,
--     and @oldLayout@ or @newLayout@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL'
--     then @image@ /must/ have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_TRANSFER_DST_BIT'
--
-- -   #VUID-VkImageMemoryBarrier-oldLayout-01197# If @srcQueueFamilyIndex@
--     and @dstQueueFamilyIndex@ define a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>
--     or @oldLayout@ and @newLayout@ define an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>,
--     @oldLayout@ /must/ be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_UNDEFINED' or the
--     current layout of the image subresources affected by the barrier
--
-- -   #VUID-VkImageMemoryBarrier-newLayout-01198# If @srcQueueFamilyIndex@
--     and @dstQueueFamilyIndex@ define a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>
--     or @oldLayout@ and @newLayout@ define an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>,
--     @newLayout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_UNDEFINED' or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_PREINITIALIZED'
--
-- -   #VUID-VkImageMemoryBarrier-oldLayout-01658# If @srcQueueFamilyIndex@
--     and @dstQueueFamilyIndex@ define a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>
--     or @oldLayout@ and @newLayout@ define an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>,
--     and @oldLayout@ or @newLayout@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_STENCIL_ATTACHMENT_OPTIMAL'
--     then @image@ /must/ have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT'
--
-- -   #VUID-VkImageMemoryBarrier-oldLayout-01659# If @srcQueueFamilyIndex@
--     and @dstQueueFamilyIndex@ define a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>
--     or @oldLayout@ and @newLayout@ define an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>,
--     and @oldLayout@ or @newLayout@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_STENCIL_READ_ONLY_OPTIMAL'
--     then @image@ /must/ have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT'
--
-- -   #VUID-VkImageMemoryBarrier-srcQueueFamilyIndex-04065# If
--     @srcQueueFamilyIndex@ and @dstQueueFamilyIndex@ define a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>
--     or @oldLayout@ and @newLayout@ define an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>,
--     and @oldLayout@ or @newLayout@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_OPTIMAL'
--     then @image@ /must/ have been created with at least one of
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT',
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_SAMPLED_BIT', or
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_INPUT_ATTACHMENT_BIT'
--
-- -   #VUID-VkImageMemoryBarrier-srcQueueFamilyIndex-04066# If
--     @srcQueueFamilyIndex@ and @dstQueueFamilyIndex@ define a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>
--     or @oldLayout@ and @newLayout@ define an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>,
--     and @oldLayout@ or @newLayout@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_OPTIMAL'
--     then @image@ /must/ have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT'
--     set
--
-- -   #VUID-VkImageMemoryBarrier-srcQueueFamilyIndex-04067# If
--     @srcQueueFamilyIndex@ and @dstQueueFamilyIndex@ define a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>
--     or @oldLayout@ and @newLayout@ define an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>,
--     and @oldLayout@ or @newLayout@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_STENCIL_READ_ONLY_OPTIMAL'
--     then @image@ /must/ have been created with at least one of
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT',
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_SAMPLED_BIT', or
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_INPUT_ATTACHMENT_BIT'
--
-- -   #VUID-VkImageMemoryBarrier-srcQueueFamilyIndex-04068# If
--     @srcQueueFamilyIndex@ and @dstQueueFamilyIndex@ define a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>
--     or @oldLayout@ and @newLayout@ define an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>,
--     and @oldLayout@ or @newLayout@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_STENCIL_ATTACHMENT_OPTIMAL'
--     then @image@ /must/ have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT'
--     set
--
-- -   #VUID-VkImageMemoryBarrier-synchronization2-07793# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-synchronization2 synchronization2>
--     feature is not enabled, @oldLayout@ /must/ not be
--     'Vulkan.Extensions.VK_KHR_synchronization2.IMAGE_LAYOUT_ATTACHMENT_OPTIMAL_KHR'
--     or
--     'Vulkan.Extensions.VK_KHR_synchronization2.IMAGE_LAYOUT_READ_ONLY_OPTIMAL_KHR'
--
-- -   #VUID-VkImageMemoryBarrier-synchronization2-07794# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-synchronization2 synchronization2>
--     feature is not enabled, @newLayout@ /must/ not be
--     'Vulkan.Extensions.VK_KHR_synchronization2.IMAGE_LAYOUT_ATTACHMENT_OPTIMAL_KHR'
--     or
--     'Vulkan.Extensions.VK_KHR_synchronization2.IMAGE_LAYOUT_READ_ONLY_OPTIMAL_KHR'
--
-- -   #VUID-VkImageMemoryBarrier-srcQueueFamilyIndex-03938# If
--     @srcQueueFamilyIndex@ and @dstQueueFamilyIndex@ define a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>
--     or @oldLayout@ and @newLayout@ define an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>,
--     and @oldLayout@ or @newLayout@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_ATTACHMENT_OPTIMAL',
--     @image@ /must/ have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_COLOR_ATTACHMENT_BIT'
--     or
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT'
--
-- -   #VUID-VkImageMemoryBarrier-srcQueueFamilyIndex-03939# If
--     @srcQueueFamilyIndex@ and @dstQueueFamilyIndex@ define a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>
--     or @oldLayout@ and @newLayout@ define an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>,
--     and @oldLayout@ or @newLayout@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_READ_ONLY_OPTIMAL',
--     @image@ /must/ have been created with at least one of
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT',
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_SAMPLED_BIT', or
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_INPUT_ATTACHMENT_BIT'
--
-- -   #VUID-VkImageMemoryBarrier-oldLayout-02088# If @srcQueueFamilyIndex@
--     and @dstQueueFamilyIndex@ define a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>
--     or @oldLayout@ and @newLayout@ define an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>,
--     and @oldLayout@ or @newLayout@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_FRAGMENT_SHADING_RATE_ATTACHMENT_OPTIMAL_KHR'
--     then @image@ /must/ have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_FRAGMENT_SHADING_RATE_ATTACHMENT_BIT_KHR'
--     set
--
-- -   #VUID-VkImageMemoryBarrier-image-09117# If @image@ was created with
--     a sharing mode of
--     'Vulkan.Core10.Enums.SharingMode.SHARING_MODE_EXCLUSIVE', and
--     @srcQueueFamilyIndex@ and @dstQueueFamilyIndex@ are not equal,
--     @srcQueueFamilyIndex@ /must/ be
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_EXTERNAL',
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_FOREIGN_EXT', or a valid
--     queue family
--
-- -   #VUID-VkImageMemoryBarrier-image-09118# If @image@ was created with
--     a sharing mode of
--     'Vulkan.Core10.Enums.SharingMode.SHARING_MODE_EXCLUSIVE', and
--     @srcQueueFamilyIndex@ and @dstQueueFamilyIndex@ are not equal,
--     @dstQueueFamilyIndex@ /must/ be
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_EXTERNAL',
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_FOREIGN_EXT', or a valid
--     queue family
--
-- -   #VUID-VkImageMemoryBarrier-srcQueueFamilyIndex-04070# If
--     @srcQueueFamilyIndex@ is not equal to @dstQueueFamilyIndex@, at
--     least one of @srcQueueFamilyIndex@ or @dstQueueFamilyIndex@ /must/
--     not be 'Vulkan.Core10.APIConstants.QUEUE_FAMILY_EXTERNAL' or
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_FOREIGN_EXT'
--
-- -   #VUID-VkImageMemoryBarrier-None-09119# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_external_memory VK_KHR_external_memory>
--     extension is not enabled, and the value of
--     'Vulkan.Core10.DeviceInitialization.ApplicationInfo'::@apiVersion@
--     used to create the 'Vulkan.Core10.Handles.Instance' is not greater
--     than or equal to Version 1.1, @srcQueueFamilyIndex@ /must/ not be
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_EXTERNAL'
--
-- -   #VUID-VkImageMemoryBarrier-None-09120# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_external_memory VK_KHR_external_memory>
--     extension is not enabled, and the value of
--     'Vulkan.Core10.DeviceInitialization.ApplicationInfo'::@apiVersion@
--     used to create the 'Vulkan.Core10.Handles.Instance' is not greater
--     than or equal to Version 1.1, @dstQueueFamilyIndex@ /must/ not be
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_EXTERNAL'
--
-- -   #VUID-VkImageMemoryBarrier-srcQueueFamilyIndex-09121# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_queue_family_foreign VK_EXT_queue_family_foreign>
--     extension is not enabled @srcQueueFamilyIndex@ /must/ not be
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_FOREIGN_EXT'
--
-- -   #VUID-VkImageMemoryBarrier-dstQueueFamilyIndex-09122# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_queue_family_foreign VK_EXT_queue_family_foreign>
--     extension is not enabled @dstQueueFamilyIndex@ /must/ not be
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_FOREIGN_EXT'
--
-- -   #VUID-VkImageMemoryBarrier-srcQueueFamilyIndex-07120# If
--     @srcQueueFamilyIndex@ and @dstQueueFamilyIndex@ define a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>
--     or @oldLayout@ and @newLayout@ define an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>,
--     and @oldLayout@ or @newLayout@ is
--     @VK_IMAGE_LAYOUT_VIDEO_DECODE_SRC_KHR@ then @image@ /must/ have been
--     created with @VK_IMAGE_USAGE_VIDEO_DECODE_SRC_BIT_KHR@
--
-- -   #VUID-VkImageMemoryBarrier-srcQueueFamilyIndex-07121# If
--     @srcQueueFamilyIndex@ and @dstQueueFamilyIndex@ define a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>
--     or @oldLayout@ and @newLayout@ define an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>,
--     and @oldLayout@ or @newLayout@ is
--     @VK_IMAGE_LAYOUT_VIDEO_DECODE_DST_KHR@ then @image@ /must/ have been
--     created with @VK_IMAGE_USAGE_VIDEO_DECODE_DST_BIT_KHR@
--
-- -   #VUID-VkImageMemoryBarrier-srcQueueFamilyIndex-07122# If
--     @srcQueueFamilyIndex@ and @dstQueueFamilyIndex@ define a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>
--     or @oldLayout@ and @newLayout@ define an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>,
--     and @oldLayout@ or @newLayout@ is
--     @VK_IMAGE_LAYOUT_VIDEO_DECODE_DPB_KHR@ then @image@ /must/ have been
--     created with @VK_IMAGE_USAGE_VIDEO_DECODE_DPB_BIT_KHR@
--
-- -   #VUID-VkImageMemoryBarrier-srcQueueFamilyIndex-07123# If
--     @srcQueueFamilyIndex@ and @dstQueueFamilyIndex@ define a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>
--     or @oldLayout@ and @newLayout@ define an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>,
--     and @oldLayout@ or @newLayout@ is
--     @VK_IMAGE_LAYOUT_VIDEO_ENCODE_SRC_KHR@ then @image@ /must/ have been
--     created with @VK_IMAGE_USAGE_VIDEO_ENCODE_SRC_BIT_KHR@
--
-- -   #VUID-VkImageMemoryBarrier-srcQueueFamilyIndex-07124# If
--     @srcQueueFamilyIndex@ and @dstQueueFamilyIndex@ define a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>
--     or @oldLayout@ and @newLayout@ define an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>,
--     and @oldLayout@ or @newLayout@ is
--     @VK_IMAGE_LAYOUT_VIDEO_ENCODE_DST_KHR@ then @image@ /must/ have been
--     created with @VK_IMAGE_USAGE_VIDEO_ENCODE_DST_BIT_KHR@
--
-- -   #VUID-VkImageMemoryBarrier-srcQueueFamilyIndex-07125# If
--     @srcQueueFamilyIndex@ and @dstQueueFamilyIndex@ define a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>
--     or @oldLayout@ and @newLayout@ define an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>,
--     and @oldLayout@ or @newLayout@ is
--     @VK_IMAGE_LAYOUT_VIDEO_ENCODE_DPB_KHR@ then @image@ /must/ have been
--     created with @VK_IMAGE_USAGE_VIDEO_ENCODE_DPB_BIT_KHR@
--
-- -   #VUID-VkImageMemoryBarrier-srcQueueFamilyIndex-07006# If
--     @srcQueueFamilyIndex@ and @dstQueueFamilyIndex@ define a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>
--     or @oldLayout@ and @newLayout@ define an
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>,
--     and @oldLayout@ or @newLayout@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_ATTACHMENT_FEEDBACK_LOOP_OPTIMAL_EXT'
--     then @image@ /must/ have been created with either the
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_COLOR_ATTACHMENT_BIT'
--     or
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT'
--     usage bits, and the
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_INPUT_ATTACHMENT_BIT'
--     or 'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_SAMPLED_BIT'
--     usage bits, and the
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_ATTACHMENT_FEEDBACK_LOOP_BIT_EXT'
--     usage bit
--
-- -   #VUID-VkImageMemoryBarrier-attachmentFeedbackLoopLayout-07313# If
--     the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-attachmentFeedbackLoopLayout attachmentFeedbackLoopLayout>
--     feature is not enabled, @newLayout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_ATTACHMENT_FEEDBACK_LOOP_OPTIMAL_EXT'
--
-- -   #VUID-VkImageMemoryBarrier-subresourceRange-01486#
--     @subresourceRange.baseMipLevel@ /must/ be less than the @mipLevels@
--     specified in 'Vulkan.Core10.Image.ImageCreateInfo' when @image@ was
--     created
--
-- -   #VUID-VkImageMemoryBarrier-subresourceRange-01724# If
--     @subresourceRange.levelCount@ is not
--     'Vulkan.Core10.APIConstants.REMAINING_MIP_LEVELS',
--     @subresourceRange.baseMipLevel@ + @subresourceRange.levelCount@
--     /must/ be less than or equal to the @mipLevels@ specified in
--     'Vulkan.Core10.Image.ImageCreateInfo' when @image@ was created
--
-- -   #VUID-VkImageMemoryBarrier-subresourceRange-01488#
--     @subresourceRange.baseArrayLayer@ /must/ be less than the
--     @arrayLayers@ specified in 'Vulkan.Core10.Image.ImageCreateInfo'
--     when @image@ was created
--
-- -   #VUID-VkImageMemoryBarrier-subresourceRange-01725# If
--     @subresourceRange.layerCount@ is not
--     'Vulkan.Core10.APIConstants.REMAINING_ARRAY_LAYERS',
--     @subresourceRange.baseArrayLayer@ + @subresourceRange.layerCount@
--     /must/ be less than or equal to the @arrayLayers@ specified in
--     'Vulkan.Core10.Image.ImageCreateInfo' when @image@ was created
--
-- -   #VUID-VkImageMemoryBarrier-image-01932# If @image@ is non-sparse
--     then it /must/ be bound completely and contiguously to a single
--     'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   #VUID-VkImageMemoryBarrier-image-09241# If @image@ has a color
--     format that is single-plane, then the @aspectMask@ member of
--     @subresourceRange@ /must/ be
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_COLOR_BIT'
--
-- -   #VUID-VkImageMemoryBarrier-image-09242# If @image@ has a color
--     format and is not /disjoint/, then the @aspectMask@ member of
--     @subresourceRange@ /must/ be
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_COLOR_BIT'
--
-- -   #VUID-VkImageMemoryBarrier-image-01672# If @image@ has a
--     multi-planar format and the image is /disjoint/, then the
--     @aspectMask@ member of @subresourceRange@ /must/ include at least
--     one
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-planes-image-aspect multi-planar aspect mask>
--     bit or
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_COLOR_BIT'
--
-- -   #VUID-VkImageMemoryBarrier-image-03319# If @image@ has a
--     depth\/stencil format with both depth and stencil and the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-separateDepthStencilLayouts separateDepthStencilLayouts>
--     feature is enabled, then the @aspectMask@ member of
--     @subresourceRange@ /must/ include either or both
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_DEPTH_BIT' and
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_STENCIL_BIT'
--
-- -   #VUID-VkImageMemoryBarrier-image-03320# If @image@ has a
--     depth\/stencil format with both depth and stencil and the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-separateDepthStencilLayouts separateDepthStencilLayouts>
--     feature is not enabled, then the @aspectMask@ member of
--     @subresourceRange@ /must/ include both
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_DEPTH_BIT' and
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_STENCIL_BIT'
--
-- -   #VUID-VkImageMemoryBarrier-aspectMask-08702# If the @aspectMask@
--     member of @subresourceRange@ includes
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_DEPTH_BIT',
--     @oldLayout@ and @newLayout@ /must/ not be one of
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_STENCIL_ATTACHMENT_OPTIMAL'
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_STENCIL_READ_ONLY_OPTIMAL'
--
-- -   #VUID-VkImageMemoryBarrier-aspectMask-08703# If the @aspectMask@
--     member of @subresourceRange@ includes
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_STENCIL_BIT',
--     @oldLayout@ and @newLayout@ /must/ not be one of
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_OPTIMAL'
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_OPTIMAL'
--
-- -   #VUID-VkImageMemoryBarrier-None-09052# If the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-synchronization2 synchronization2>
--     feature is not enabled, and @image@ was created with a sharing mode
--     of 'Vulkan.Core10.Enums.SharingMode.SHARING_MODE_CONCURRENT', at
--     least one of @srcQueueFamilyIndex@ and @dstQueueFamilyIndex@ /must/
--     be 'Vulkan.Core10.APIConstants.QUEUE_FAMILY_IGNORED'
--
-- -   #VUID-VkImageMemoryBarrier-None-09053# If the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-synchronization2 synchronization2>
--     feature is not enabled, and @image@ was created with a sharing mode
--     of 'Vulkan.Core10.Enums.SharingMode.SHARING_MODE_CONCURRENT',
--     @srcQueueFamilyIndex@ /must/ be
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_IGNORED' or
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_EXTERNAL'
--
-- -   #VUID-VkImageMemoryBarrier-None-09054# If the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-synchronization2 synchronization2>
--     feature is not enabled, and @image@ was created with a sharing mode
--     of 'Vulkan.Core10.Enums.SharingMode.SHARING_MODE_CONCURRENT',
--     @dstQueueFamilyIndex@ /must/ be
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_IGNORED' or
--     'Vulkan.Core10.APIConstants.QUEUE_FAMILY_EXTERNAL'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkImageMemoryBarrier-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_IMAGE_MEMORY_BARRIER'
--
-- -   #VUID-VkImageMemoryBarrier-pNext-pNext# Each @pNext@ member of any
--     structure (including this one) in the @pNext@ chain /must/ be either
--     @NULL@ or a pointer to a valid instance of
--     'Vulkan.Extensions.VK_EXT_external_memory_acquire_unmodified.ExternalMemoryAcquireUnmodifiedEXT'
--     or
--     'Vulkan.Extensions.VK_EXT_sample_locations.SampleLocationsInfoEXT'
--
-- -   #VUID-VkImageMemoryBarrier-sType-unique# The @sType@ value of each
--     struct in the @pNext@ chain /must/ be unique
--
-- -   #VUID-VkImageMemoryBarrier-oldLayout-parameter# @oldLayout@ /must/
--     be a valid 'Vulkan.Core10.Enums.ImageLayout.ImageLayout' value
--
-- -   #VUID-VkImageMemoryBarrier-newLayout-parameter# @newLayout@ /must/
--     be a valid 'Vulkan.Core10.Enums.ImageLayout.ImageLayout' value
--
-- -   #VUID-VkImageMemoryBarrier-image-parameter# @image@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Image' handle
--
-- -   #VUID-VkImageMemoryBarrier-subresourceRange-parameter#
--     @subresourceRange@ /must/ be a valid
--     'Vulkan.Core10.ImageView.ImageSubresourceRange' structure
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'Vulkan.Core10.Enums.AccessFlagBits.AccessFlags',
-- 'Vulkan.Core10.Handles.Image',
-- 'Vulkan.Core10.Enums.ImageLayout.ImageLayout',
-- 'Vulkan.Core10.ImageView.ImageSubresourceRange',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'Vulkan.Core10.CommandBufferBuilding.cmdPipelineBarrier',
-- 'Vulkan.Core10.CommandBufferBuilding.cmdWaitEvents'
data ImageMemoryBarrier (es :: [Type]) = ImageMemoryBarrier
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    forall (es :: [*]). ImageMemoryBarrier es -> Chain es
next :: Chain es
  , -- | @srcAccessMask@ is a bitmask of
    -- 'Vulkan.Core10.Enums.AccessFlagBits.AccessFlagBits' specifying a
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-access-masks source access mask>.
    forall (es :: [*]). ImageMemoryBarrier es -> AccessFlags
srcAccessMask :: AccessFlags
  , -- | @dstAccessMask@ is a bitmask of
    -- 'Vulkan.Core10.Enums.AccessFlagBits.AccessFlagBits' specifying a
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-access-masks destination access mask>.
    forall (es :: [*]). ImageMemoryBarrier es -> AccessFlags
dstAccessMask :: AccessFlags
  , -- | @oldLayout@ is the old layout in an
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>.
    forall (es :: [*]). ImageMemoryBarrier es -> ImageLayout
oldLayout :: ImageLayout
  , -- | @newLayout@ is the new layout in an
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-image-layout-transitions image layout transition>.
    forall (es :: [*]). ImageMemoryBarrier es -> ImageLayout
newLayout :: ImageLayout
  , -- | @srcQueueFamilyIndex@ is the source queue family for a
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>.
    forall (es :: [*]). ImageMemoryBarrier es -> Word32
srcQueueFamilyIndex :: Word32
  , -- | @dstQueueFamilyIndex@ is the destination queue family for a
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-queue-transfers queue family ownership transfer>.
    forall (es :: [*]). ImageMemoryBarrier es -> Word32
dstQueueFamilyIndex :: Word32
  , -- | @image@ is a handle to the image affected by this barrier.
    forall (es :: [*]). ImageMemoryBarrier es -> Image
image :: Image
  , -- | @subresourceRange@ describes the
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#resources-image-views image subresource range>
    -- within @image@ that is affected by this barrier.
    forall (es :: [*]). ImageMemoryBarrier es -> ImageSubresourceRange
subresourceRange :: ImageSubresourceRange
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ImageMemoryBarrier (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (ImageMemoryBarrier es)

instance Extensible ImageMemoryBarrier where
  extensibleTypeName :: String
extensibleTypeName = String
"ImageMemoryBarrier"
  setNext :: forall (ds :: [*]) (es :: [*]).
ImageMemoryBarrier ds -> Chain es -> ImageMemoryBarrier es
setNext ImageMemoryBarrier{Word32
Chain ds
ImageLayout
Image
ImageSubresourceRange
AccessFlags
subresourceRange :: ImageSubresourceRange
image :: Image
dstQueueFamilyIndex :: Word32
srcQueueFamilyIndex :: Word32
newLayout :: ImageLayout
oldLayout :: ImageLayout
dstAccessMask :: AccessFlags
srcAccessMask :: AccessFlags
next :: Chain ds
$sel:subresourceRange:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> ImageSubresourceRange
$sel:image:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> Image
$sel:dstQueueFamilyIndex:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> Word32
$sel:srcQueueFamilyIndex:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> Word32
$sel:newLayout:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> ImageLayout
$sel:oldLayout:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> ImageLayout
$sel:dstAccessMask:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> AccessFlags
$sel:srcAccessMask:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> AccessFlags
$sel:next:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> Chain es
..} Chain es
next' = ImageMemoryBarrier{$sel:next:ImageMemoryBarrier :: Chain es
next = Chain es
next', Word32
ImageLayout
Image
ImageSubresourceRange
AccessFlags
subresourceRange :: ImageSubresourceRange
image :: Image
dstQueueFamilyIndex :: Word32
srcQueueFamilyIndex :: Word32
newLayout :: ImageLayout
oldLayout :: ImageLayout
dstAccessMask :: AccessFlags
srcAccessMask :: AccessFlags
$sel:subresourceRange:ImageMemoryBarrier :: ImageSubresourceRange
$sel:image:ImageMemoryBarrier :: Image
$sel:dstQueueFamilyIndex:ImageMemoryBarrier :: Word32
$sel:srcQueueFamilyIndex:ImageMemoryBarrier :: Word32
$sel:newLayout:ImageMemoryBarrier :: ImageLayout
$sel:oldLayout:ImageMemoryBarrier :: ImageLayout
$sel:dstAccessMask:ImageMemoryBarrier :: AccessFlags
$sel:srcAccessMask:ImageMemoryBarrier :: AccessFlags
..}
  getNext :: forall (es :: [*]). ImageMemoryBarrier es -> Chain es
getNext ImageMemoryBarrier{Word32
Chain es
ImageLayout
Image
ImageSubresourceRange
AccessFlags
subresourceRange :: ImageSubresourceRange
image :: Image
dstQueueFamilyIndex :: Word32
srcQueueFamilyIndex :: Word32
newLayout :: ImageLayout
oldLayout :: ImageLayout
dstAccessMask :: AccessFlags
srcAccessMask :: AccessFlags
next :: Chain es
$sel:subresourceRange:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> ImageSubresourceRange
$sel:image:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> Image
$sel:dstQueueFamilyIndex:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> Word32
$sel:srcQueueFamilyIndex:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> Word32
$sel:newLayout:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> ImageLayout
$sel:oldLayout:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> ImageLayout
$sel:dstAccessMask:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> AccessFlags
$sel:srcAccessMask:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> AccessFlags
$sel:next:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> Chain es
..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends ImageMemoryBarrier e => b) -> Maybe b
  extends :: forall e b (proxy :: * -> *).
Typeable e =>
proxy e -> (Extends ImageMemoryBarrier e => b) -> Maybe b
extends proxy e
_ Extends ImageMemoryBarrier e => b
f
    | Just e :~: ExternalMemoryAcquireUnmodifiedEXT
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ExternalMemoryAcquireUnmodifiedEXT = forall a. a -> Maybe a
Just Extends ImageMemoryBarrier e => b
f
    | Just e :~: SampleLocationsInfoEXT
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @SampleLocationsInfoEXT = forall a. a -> Maybe a
Just Extends ImageMemoryBarrier e => b
f
    | Bool
otherwise = forall a. Maybe a
Nothing

instance ( Extendss ImageMemoryBarrier es
         , PokeChain es ) => ToCStruct (ImageMemoryBarrier es) where
  withCStruct :: forall b.
ImageMemoryBarrier es
-> (Ptr (ImageMemoryBarrier es) -> IO b) -> IO b
withCStruct ImageMemoryBarrier es
x Ptr (ImageMemoryBarrier es) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
72 forall a b. (a -> b) -> a -> b
$ \Ptr (ImageMemoryBarrier es)
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (ImageMemoryBarrier es)
p ImageMemoryBarrier es
x (Ptr (ImageMemoryBarrier es) -> IO b
f Ptr (ImageMemoryBarrier es)
p)
  pokeCStruct :: forall b.
Ptr (ImageMemoryBarrier es)
-> ImageMemoryBarrier es -> IO b -> IO b
pokeCStruct Ptr (ImageMemoryBarrier es)
p ImageMemoryBarrier{Word32
Chain es
ImageLayout
Image
ImageSubresourceRange
AccessFlags
subresourceRange :: ImageSubresourceRange
image :: Image
dstQueueFamilyIndex :: Word32
srcQueueFamilyIndex :: Word32
newLayout :: ImageLayout
oldLayout :: ImageLayout
dstAccessMask :: AccessFlags
srcAccessMask :: AccessFlags
next :: Chain es
$sel:subresourceRange:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> ImageSubresourceRange
$sel:image:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> Image
$sel:dstQueueFamilyIndex:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> Word32
$sel:srcQueueFamilyIndex:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> Word32
$sel:newLayout:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> ImageLayout
$sel:oldLayout:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> ImageLayout
$sel:dstAccessMask:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> AccessFlags
$sel:srcAccessMask:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> AccessFlags
$sel:next:ImageMemoryBarrier :: forall (es :: [*]). ImageMemoryBarrier es -> Chain es
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_MEMORY_BARRIER)
    Ptr ()
pNext'' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext''
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr AccessFlags)) (AccessFlags
srcAccessMask)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr AccessFlags)) (AccessFlags
dstAccessMask)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout)) (ImageLayout
oldLayout)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr ImageLayout)) (ImageLayout
newLayout)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) (Word32
srcQueueFamilyIndex)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32)) (Word32
dstQueueFamilyIndex)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Image)) (Image
image)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr ImageSubresourceRange)) (ImageSubresourceRange
subresourceRange)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = Int
72
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr (ImageMemoryBarrier es) -> IO b -> IO b
pokeZeroCStruct Ptr (ImageMemoryBarrier es)
p IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_MEMORY_BARRIER)
    Ptr ()
pNext' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext'
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr AccessFlags)) (forall a. Zero a => a
zero)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr AccessFlags)) (forall a. Zero a => a
zero)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout)) (forall a. Zero a => a
zero)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr ImageLayout)) (forall a. Zero a => a
zero)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Image)) (forall a. Zero a => a
zero)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr ImageSubresourceRange)) (forall a. Zero a => a
zero)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f

instance ( Extendss ImageMemoryBarrier es
         , PeekChain es ) => FromCStruct (ImageMemoryBarrier es) where
  peekCStruct :: Ptr (ImageMemoryBarrier es) -> IO (ImageMemoryBarrier es)
peekCStruct Ptr (ImageMemoryBarrier es)
p = do
    Ptr ()
pNext <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ())))
    Chain es
next <- forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
    AccessFlags
srcAccessMask <- forall a. Storable a => Ptr a -> IO a
peek @AccessFlags ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr AccessFlags))
    AccessFlags
dstAccessMask <- forall a. Storable a => Ptr a -> IO a
peek @AccessFlags ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr AccessFlags))
    ImageLayout
oldLayout <- forall a. Storable a => Ptr a -> IO a
peek @ImageLayout ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout))
    ImageLayout
newLayout <- forall a. Storable a => Ptr a -> IO a
peek @ImageLayout ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr ImageLayout))
    Word32
srcQueueFamilyIndex <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32))
    Word32
dstQueueFamilyIndex <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32))
    Image
image <- forall a. Storable a => Ptr a -> IO a
peek @Image ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Image))
    ImageSubresourceRange
subresourceRange <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ImageSubresourceRange ((Ptr (ImageMemoryBarrier es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr ImageSubresourceRange))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (es :: [*]).
Chain es
-> AccessFlags
-> AccessFlags
-> ImageLayout
-> ImageLayout
-> Word32
-> Word32
-> Image
-> ImageSubresourceRange
-> ImageMemoryBarrier es
ImageMemoryBarrier
             Chain es
next
             AccessFlags
srcAccessMask
             AccessFlags
dstAccessMask
             ImageLayout
oldLayout
             ImageLayout
newLayout
             Word32
srcQueueFamilyIndex
             Word32
dstQueueFamilyIndex
             Image
image
             ImageSubresourceRange
subresourceRange

instance es ~ '[] => Zero (ImageMemoryBarrier es) where
  zero :: ImageMemoryBarrier es
zero = forall (es :: [*]).
Chain es
-> AccessFlags
-> AccessFlags
-> ImageLayout
-> ImageLayout
-> Word32
-> Word32
-> Image
-> ImageSubresourceRange
-> ImageMemoryBarrier es
ImageMemoryBarrier
           ()
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkPipelineCacheHeaderVersionOne - Structure describing the layout of the
-- pipeline cache header
--
-- = Description
--
-- Unlike most structures declared by the Vulkan API, all fields of this
-- structure are written with the least significant byte first, regardless
-- of host byte-order.
--
-- The C language specification does not define the packing of structure
-- members. This layout assumes tight structure member packing, with
-- members laid out in the order listed in the structure, and the intended
-- size of the structure is 32 bytes. If a compiler produces code that
-- diverges from that pattern, applications /must/ employ another method to
-- set values at the correct offsets.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'Vulkan.Core10.Enums.PipelineCacheHeaderVersion.PipelineCacheHeaderVersion'
data PipelineCacheHeaderVersionOne = PipelineCacheHeaderVersionOne
  { -- | @headerSize@ is the length in bytes of the pipeline cache header.
    --
    -- #VUID-VkPipelineCacheHeaderVersionOne-headerSize-04967# @headerSize@
    -- /must/ be 32
    --
    -- #VUID-VkPipelineCacheHeaderVersionOne-headerSize-08990# @headerSize@
    -- /must/ not exceed the size of the pipeline cache
    PipelineCacheHeaderVersionOne -> Word32
headerSize :: Word32
  , -- | @headerVersion@ is a
    -- 'Vulkan.Core10.Enums.PipelineCacheHeaderVersion.PipelineCacheHeaderVersion'
    -- value specifying the version of the header. A consumer of the pipeline
    -- cache /should/ use the cache version to interpret the remainder of the
    -- cache header.
    --
    -- #VUID-VkPipelineCacheHeaderVersionOne-headerVersion-04968#
    -- @headerVersion@ /must/ be
    -- 'Vulkan.Core10.Enums.PipelineCacheHeaderVersion.PIPELINE_CACHE_HEADER_VERSION_ONE'
    --
    -- #VUID-VkPipelineCacheHeaderVersionOne-headerVersion-parameter#
    -- @headerVersion@ /must/ be a valid
    -- 'Vulkan.Core10.Enums.PipelineCacheHeaderVersion.PipelineCacheHeaderVersion'
    -- value
    PipelineCacheHeaderVersionOne -> PipelineCacheHeaderVersion
headerVersion :: PipelineCacheHeaderVersion
  , -- | @vendorID@ is the
    -- 'Vulkan.Core10.DeviceInitialization.PhysicalDeviceProperties'::@vendorID@
    -- of the implementation.
    PipelineCacheHeaderVersionOne -> Word32
vendorID :: Word32
  , -- | @deviceID@ is the
    -- 'Vulkan.Core10.DeviceInitialization.PhysicalDeviceProperties'::@deviceID@
    -- of the implementation.
    PipelineCacheHeaderVersionOne -> Word32
deviceID :: Word32
  , -- | @pipelineCacheUUID@ is the
    -- 'Vulkan.Core10.DeviceInitialization.PhysicalDeviceProperties'::@pipelineCacheUUID@
    -- of the implementation.
    PipelineCacheHeaderVersionOne -> ByteString
pipelineCacheUUID :: ByteString
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineCacheHeaderVersionOne)
#endif
deriving instance Show PipelineCacheHeaderVersionOne

instance ToCStruct PipelineCacheHeaderVersionOne where
  withCStruct :: forall b.
PipelineCacheHeaderVersionOne
-> (Ptr PipelineCacheHeaderVersionOne -> IO b) -> IO b
withCStruct PipelineCacheHeaderVersionOne
x Ptr PipelineCacheHeaderVersionOne -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \Ptr PipelineCacheHeaderVersionOne
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PipelineCacheHeaderVersionOne
p PipelineCacheHeaderVersionOne
x (Ptr PipelineCacheHeaderVersionOne -> IO b
f Ptr PipelineCacheHeaderVersionOne
p)
  pokeCStruct :: forall b.
Ptr PipelineCacheHeaderVersionOne
-> PipelineCacheHeaderVersionOne -> IO b -> IO b
pokeCStruct Ptr PipelineCacheHeaderVersionOne
p PipelineCacheHeaderVersionOne{Word32
ByteString
PipelineCacheHeaderVersion
pipelineCacheUUID :: ByteString
deviceID :: Word32
vendorID :: Word32
headerVersion :: PipelineCacheHeaderVersion
headerSize :: Word32
$sel:pipelineCacheUUID:PipelineCacheHeaderVersionOne :: PipelineCacheHeaderVersionOne -> ByteString
$sel:deviceID:PipelineCacheHeaderVersionOne :: PipelineCacheHeaderVersionOne -> Word32
$sel:vendorID:PipelineCacheHeaderVersionOne :: PipelineCacheHeaderVersionOne -> Word32
$sel:headerVersion:PipelineCacheHeaderVersionOne :: PipelineCacheHeaderVersionOne -> PipelineCacheHeaderVersion
$sel:headerSize:PipelineCacheHeaderVersionOne :: PipelineCacheHeaderVersionOne -> Word32
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineCacheHeaderVersionOne
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) (Word32
headerSize)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineCacheHeaderVersionOne
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr PipelineCacheHeaderVersion)) (PipelineCacheHeaderVersion
headerVersion)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineCacheHeaderVersionOne
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32)) (Word32
vendorID)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineCacheHeaderVersionOne
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Word32)) (Word32
deviceID)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> ByteString -> IO ()
pokeFixedLengthByteString ((Ptr PipelineCacheHeaderVersionOne
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (FixedArray UUID_SIZE Word8))) (ByteString
pipelineCacheUUID)
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
4
  pokeZeroCStruct :: forall b. Ptr PipelineCacheHeaderVersionOne -> IO b -> IO b
pokeZeroCStruct Ptr PipelineCacheHeaderVersionOne
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineCacheHeaderVersionOne
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineCacheHeaderVersionOne
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr PipelineCacheHeaderVersion)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineCacheHeaderVersionOne
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineCacheHeaderVersionOne
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> ByteString -> IO ()
pokeFixedLengthByteString ((Ptr PipelineCacheHeaderVersionOne
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (FixedArray UUID_SIZE Word8))) (forall a. Monoid a => a
mempty)
    IO b
f

instance FromCStruct PipelineCacheHeaderVersionOne where
  peekCStruct :: Ptr PipelineCacheHeaderVersionOne
-> IO PipelineCacheHeaderVersionOne
peekCStruct Ptr PipelineCacheHeaderVersionOne
p = do
    Word32
headerSize <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PipelineCacheHeaderVersionOne
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32))
    PipelineCacheHeaderVersion
headerVersion <- forall a. Storable a => Ptr a -> IO a
peek @PipelineCacheHeaderVersion ((Ptr PipelineCacheHeaderVersionOne
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr PipelineCacheHeaderVersion))
    Word32
vendorID <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PipelineCacheHeaderVersionOne
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32))
    Word32
deviceID <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PipelineCacheHeaderVersionOne
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Word32))
    ByteString
pipelineCacheUUID <- forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> IO ByteString
peekByteStringFromSizedVectorPtr ((Ptr PipelineCacheHeaderVersionOne
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (FixedArray UUID_SIZE Word8)))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word32
-> PipelineCacheHeaderVersion
-> Word32
-> Word32
-> ByteString
-> PipelineCacheHeaderVersionOne
PipelineCacheHeaderVersionOne
             Word32
headerSize PipelineCacheHeaderVersion
headerVersion Word32
vendorID Word32
deviceID ByteString
pipelineCacheUUID

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

instance Zero PipelineCacheHeaderVersionOne where
  zero :: PipelineCacheHeaderVersionOne
zero = Word32
-> PipelineCacheHeaderVersion
-> Word32
-> Word32
-> ByteString
-> PipelineCacheHeaderVersionOne
PipelineCacheHeaderVersionOne
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Monoid a => a
mempty


-- | VkDrawIndirectCommand - Structure specifying a indirect drawing command
--
-- = Description
--
-- The members of 'DrawIndirectCommand' have the same meaning as the
-- similarly named parameters of
-- 'Vulkan.Core10.CommandBufferBuilding.cmdDraw'.
--
-- == Valid Usage
--
-- -   #VUID-VkDrawIndirectCommand-None-00500# For a given vertex buffer
--     binding, any attribute data fetched /must/ be entirely contained
--     within the corresponding vertex buffer binding, as described in
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#fxvertex-input>
--
-- -   #VUID-VkDrawIndirectCommand-firstInstance-00501# If the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-drawIndirectFirstInstance drawIndirectFirstInstance>
--     feature is not enabled, @firstInstance@ /must/ be @0@
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'Vulkan.Core10.CommandBufferBuilding.cmdDrawIndirect'
data DrawIndirectCommand = DrawIndirectCommand
  { -- | @vertexCount@ is the number of vertices to draw.
    DrawIndirectCommand -> Word32
vertexCount :: Word32
  , -- | @instanceCount@ is the number of instances to draw.
    DrawIndirectCommand -> Word32
instanceCount :: Word32
  , -- | @firstVertex@ is the index of the first vertex to draw.
    DrawIndirectCommand -> Word32
firstVertex :: Word32
  , -- | @firstInstance@ is the instance ID of the first instance to draw.
    DrawIndirectCommand -> Word32
firstInstance :: Word32
  }
  deriving (Typeable, DrawIndirectCommand -> DrawIndirectCommand -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DrawIndirectCommand -> DrawIndirectCommand -> Bool
$c/= :: DrawIndirectCommand -> DrawIndirectCommand -> Bool
== :: DrawIndirectCommand -> DrawIndirectCommand -> Bool
$c== :: DrawIndirectCommand -> DrawIndirectCommand -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DrawIndirectCommand)
#endif
deriving instance Show DrawIndirectCommand

instance ToCStruct DrawIndirectCommand where
  withCStruct :: forall b.
DrawIndirectCommand -> (Ptr DrawIndirectCommand -> IO b) -> IO b
withCStruct DrawIndirectCommand
x Ptr DrawIndirectCommand -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
16 forall a b. (a -> b) -> a -> b
$ \Ptr DrawIndirectCommand
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr DrawIndirectCommand
p DrawIndirectCommand
x (Ptr DrawIndirectCommand -> IO b
f Ptr DrawIndirectCommand
p)
  pokeCStruct :: forall b.
Ptr DrawIndirectCommand -> DrawIndirectCommand -> IO b -> IO b
pokeCStruct Ptr DrawIndirectCommand
p DrawIndirectCommand{Word32
firstInstance :: Word32
firstVertex :: Word32
instanceCount :: Word32
vertexCount :: Word32
$sel:firstInstance:DrawIndirectCommand :: DrawIndirectCommand -> Word32
$sel:firstVertex:DrawIndirectCommand :: DrawIndirectCommand -> Word32
$sel:instanceCount:DrawIndirectCommand :: DrawIndirectCommand -> Word32
$sel:vertexCount:DrawIndirectCommand :: DrawIndirectCommand -> Word32
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrawIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) (Word32
vertexCount)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrawIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32)) (Word32
instanceCount)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrawIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32)) (Word32
firstVertex)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrawIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Word32)) (Word32
firstInstance)
    IO b
f
  cStructSize :: Int
cStructSize = Int
16
  cStructAlignment :: Int
cStructAlignment = Int
4
  pokeZeroCStruct :: forall b. Ptr DrawIndirectCommand -> IO b -> IO b
pokeZeroCStruct Ptr DrawIndirectCommand
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrawIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrawIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrawIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrawIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Word32)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct DrawIndirectCommand where
  peekCStruct :: Ptr DrawIndirectCommand -> IO DrawIndirectCommand
peekCStruct Ptr DrawIndirectCommand
p = do
    Word32
vertexCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr DrawIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32))
    Word32
instanceCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr DrawIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32))
    Word32
firstVertex <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr DrawIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32))
    Word32
firstInstance <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr DrawIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Word32))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> Word32 -> Word32 -> DrawIndirectCommand
DrawIndirectCommand
             Word32
vertexCount Word32
instanceCount Word32
firstVertex Word32
firstInstance

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

instance Zero DrawIndirectCommand where
  zero :: DrawIndirectCommand
zero = Word32 -> Word32 -> Word32 -> Word32 -> DrawIndirectCommand
DrawIndirectCommand
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkDrawIndexedIndirectCommand - Structure specifying a indexed indirect
-- drawing command
--
-- = Description
--
-- The members of 'DrawIndexedIndirectCommand' have the same meaning as the
-- similarly named parameters of
-- 'Vulkan.Core10.CommandBufferBuilding.cmdDrawIndexed'.
--
-- == Valid Usage
--
-- -   #VUID-VkDrawIndexedIndirectCommand-robustBufferAccess2-08798# If
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-robustBufferAccess2 robustBufferAccess2>
--     is not enabled, (@indexSize@ × (@firstIndex@ + @indexCount@) +
--     @offset@) /must/ be less than or equal to the size of the bound
--     index buffer, with @indexSize@ being based on the type specified by
--     @indexType@, where the index buffer, @indexType@, and @offset@ are
--     specified via
--     'Vulkan.Core10.CommandBufferBuilding.cmdBindIndexBuffer' or
--     'Vulkan.Extensions.VK_KHR_maintenance5.cmdBindIndexBuffer2KHR'. If
--     'Vulkan.Extensions.VK_KHR_maintenance5.cmdBindIndexBuffer2KHR' is
--     used to bind the index buffer, the size of the bound index buffer is
--     'Vulkan.Extensions.VK_KHR_maintenance5.cmdBindIndexBuffer2KHR'::@size@
--
-- -   #VUID-VkDrawIndexedIndirectCommand-None-00552# For a given vertex
--     buffer binding, any attribute data fetched /must/ be entirely
--     contained within the corresponding vertex buffer binding, as
--     described in
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#fxvertex-input>
--
-- -   #VUID-VkDrawIndexedIndirectCommand-firstInstance-00554# If the
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-drawIndirectFirstInstance drawIndirectFirstInstance>
--     feature is not enabled, @firstInstance@ /must/ be @0@
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'Vulkan.Core10.CommandBufferBuilding.cmdDrawIndexedIndirect'
data DrawIndexedIndirectCommand = DrawIndexedIndirectCommand
  { -- | @indexCount@ is the number of vertices to draw.
    DrawIndexedIndirectCommand -> Word32
indexCount :: Word32
  , -- | @instanceCount@ is the number of instances to draw.
    DrawIndexedIndirectCommand -> Word32
instanceCount :: Word32
  , -- | @firstIndex@ is the base index within the index buffer.
    DrawIndexedIndirectCommand -> Word32
firstIndex :: Word32
  , -- | @vertexOffset@ is the value added to the vertex index before indexing
    -- into the vertex buffer.
    DrawIndexedIndirectCommand -> Int32
vertexOffset :: Int32
  , -- | @firstInstance@ is the instance ID of the first instance to draw.
    DrawIndexedIndirectCommand -> Word32
firstInstance :: Word32
  }
  deriving (Typeable, DrawIndexedIndirectCommand -> DrawIndexedIndirectCommand -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DrawIndexedIndirectCommand -> DrawIndexedIndirectCommand -> Bool
$c/= :: DrawIndexedIndirectCommand -> DrawIndexedIndirectCommand -> Bool
== :: DrawIndexedIndirectCommand -> DrawIndexedIndirectCommand -> Bool
$c== :: DrawIndexedIndirectCommand -> DrawIndexedIndirectCommand -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DrawIndexedIndirectCommand)
#endif
deriving instance Show DrawIndexedIndirectCommand

instance ToCStruct DrawIndexedIndirectCommand where
  withCStruct :: forall b.
DrawIndexedIndirectCommand
-> (Ptr DrawIndexedIndirectCommand -> IO b) -> IO b
withCStruct DrawIndexedIndirectCommand
x Ptr DrawIndexedIndirectCommand -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
20 forall a b. (a -> b) -> a -> b
$ \Ptr DrawIndexedIndirectCommand
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr DrawIndexedIndirectCommand
p DrawIndexedIndirectCommand
x (Ptr DrawIndexedIndirectCommand -> IO b
f Ptr DrawIndexedIndirectCommand
p)
  pokeCStruct :: forall b.
Ptr DrawIndexedIndirectCommand
-> DrawIndexedIndirectCommand -> IO b -> IO b
pokeCStruct Ptr DrawIndexedIndirectCommand
p DrawIndexedIndirectCommand{Int32
Word32
firstInstance :: Word32
vertexOffset :: Int32
firstIndex :: Word32
instanceCount :: Word32
indexCount :: Word32
$sel:firstInstance:DrawIndexedIndirectCommand :: DrawIndexedIndirectCommand -> Word32
$sel:vertexOffset:DrawIndexedIndirectCommand :: DrawIndexedIndirectCommand -> Int32
$sel:firstIndex:DrawIndexedIndirectCommand :: DrawIndexedIndirectCommand -> Word32
$sel:instanceCount:DrawIndexedIndirectCommand :: DrawIndexedIndirectCommand -> Word32
$sel:indexCount:DrawIndexedIndirectCommand :: DrawIndexedIndirectCommand -> Word32
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrawIndexedIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) (Word32
indexCount)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrawIndexedIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32)) (Word32
instanceCount)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrawIndexedIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32)) (Word32
firstIndex)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrawIndexedIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Int32)) (Int32
vertexOffset)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrawIndexedIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
firstInstance)
    IO b
f
  cStructSize :: Int
cStructSize = Int
20
  cStructAlignment :: Int
cStructAlignment = Int
4
  pokeZeroCStruct :: forall b. Ptr DrawIndexedIndirectCommand -> IO b -> IO b
pokeZeroCStruct Ptr DrawIndexedIndirectCommand
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrawIndexedIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrawIndexedIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrawIndexedIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrawIndexedIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Int32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DrawIndexedIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct DrawIndexedIndirectCommand where
  peekCStruct :: Ptr DrawIndexedIndirectCommand -> IO DrawIndexedIndirectCommand
peekCStruct Ptr DrawIndexedIndirectCommand
p = do
    Word32
indexCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr DrawIndexedIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32))
    Word32
instanceCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr DrawIndexedIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32))
    Word32
firstIndex <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr DrawIndexedIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32))
    Int32
vertexOffset <- forall a. Storable a => Ptr a -> IO a
peek @Int32 ((Ptr DrawIndexedIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Int32))
    Word32
firstInstance <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr DrawIndexedIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word32
-> Word32
-> Word32
-> Int32
-> Word32
-> DrawIndexedIndirectCommand
DrawIndexedIndirectCommand
             Word32
indexCount Word32
instanceCount Word32
firstIndex Int32
vertexOffset Word32
firstInstance

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

instance Zero DrawIndexedIndirectCommand where
  zero :: DrawIndexedIndirectCommand
zero = Word32
-> Word32
-> Word32
-> Int32
-> Word32
-> DrawIndexedIndirectCommand
DrawIndexedIndirectCommand
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkDispatchIndirectCommand - Structure specifying a indirect dispatching
-- command
--
-- = Description
--
-- The members of 'DispatchIndirectCommand' have the same meaning as the
-- corresponding parameters of
-- 'Vulkan.Core10.CommandBufferBuilding.cmdDispatch'.
--
-- == Valid Usage
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_0 VK_VERSION_1_0>,
-- 'Vulkan.Core10.CommandBufferBuilding.cmdDispatchIndirect'
data DispatchIndirectCommand = DispatchIndirectCommand
  { -- | @x@ is the number of local workgroups to dispatch in the X dimension.
    --
    -- #VUID-VkDispatchIndirectCommand-x-00417# @x@ /must/ be less than or
    -- equal to
    -- 'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxComputeWorkGroupCount@[0]
    DispatchIndirectCommand -> Word32
x :: Word32
  , -- | @y@ is the number of local workgroups to dispatch in the Y dimension.
    --
    -- #VUID-VkDispatchIndirectCommand-y-00418# @y@ /must/ be less than or
    -- equal to
    -- 'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxComputeWorkGroupCount@[1]
    DispatchIndirectCommand -> Word32
y :: Word32
  , -- | @z@ is the number of local workgroups to dispatch in the Z dimension.
    --
    -- #VUID-VkDispatchIndirectCommand-z-00419# @z@ /must/ be less than or
    -- equal to
    -- 'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxComputeWorkGroupCount@[2]
    DispatchIndirectCommand -> Word32
z :: Word32
  }
  deriving (Typeable, DispatchIndirectCommand -> DispatchIndirectCommand -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DispatchIndirectCommand -> DispatchIndirectCommand -> Bool
$c/= :: DispatchIndirectCommand -> DispatchIndirectCommand -> Bool
== :: DispatchIndirectCommand -> DispatchIndirectCommand -> Bool
$c== :: DispatchIndirectCommand -> DispatchIndirectCommand -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (DispatchIndirectCommand)
#endif
deriving instance Show DispatchIndirectCommand

instance ToCStruct DispatchIndirectCommand where
  withCStruct :: forall b.
DispatchIndirectCommand
-> (Ptr DispatchIndirectCommand -> IO b) -> IO b
withCStruct DispatchIndirectCommand
x Ptr DispatchIndirectCommand -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
12 forall a b. (a -> b) -> a -> b
$ \Ptr DispatchIndirectCommand
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr DispatchIndirectCommand
p DispatchIndirectCommand
x (Ptr DispatchIndirectCommand -> IO b
f Ptr DispatchIndirectCommand
p)
  pokeCStruct :: forall b.
Ptr DispatchIndirectCommand
-> DispatchIndirectCommand -> IO b -> IO b
pokeCStruct Ptr DispatchIndirectCommand
p DispatchIndirectCommand{Word32
z :: Word32
y :: Word32
x :: Word32
$sel:z:DispatchIndirectCommand :: DispatchIndirectCommand -> Word32
$sel:y:DispatchIndirectCommand :: DispatchIndirectCommand -> Word32
$sel:x:DispatchIndirectCommand :: DispatchIndirectCommand -> Word32
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DispatchIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) (Word32
x)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DispatchIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32)) (Word32
y)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DispatchIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32)) (Word32
z)
    IO b
f
  cStructSize :: Int
cStructSize = Int
12
  cStructAlignment :: Int
cStructAlignment = Int
4
  pokeZeroCStruct :: forall b. Ptr DispatchIndirectCommand -> IO b -> IO b
pokeZeroCStruct Ptr DispatchIndirectCommand
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DispatchIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DispatchIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr DispatchIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct DispatchIndirectCommand where
  peekCStruct :: Ptr DispatchIndirectCommand -> IO DispatchIndirectCommand
peekCStruct Ptr DispatchIndirectCommand
p = do
    Word32
x <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr DispatchIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32))
    Word32
y <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr DispatchIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32))
    Word32
z <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr DispatchIndirectCommand
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> Word32 -> DispatchIndirectCommand
DispatchIndirectCommand
             Word32
x Word32
y Word32
z

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

instance Zero DispatchIndirectCommand where
  zero :: DispatchIndirectCommand
zero = Word32 -> Word32 -> Word32 -> DispatchIndirectCommand
DispatchIndirectCommand
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero