{-# language CPP #-}
-- | = Name
--
-- VK_EXT_host_image_copy - device extension
--
-- == VK_EXT_host_image_copy
--
-- [__Name String__]
--     @VK_EXT_host_image_copy@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     271
--
-- [__Revision__]
--     1
--
-- [__Ratification Status__]
--     Ratified
--
-- [__Extension and Version Dependencies__]
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_get_physical_device_properties2 VK_KHR_get_physical_device_properties2>
--     and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_copy_commands2 VK_KHR_copy_commands2>
--     and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_format_feature_flags2 VK_KHR_format_feature_flags2>
--
-- [__Contact__]
--
--     -   Shahbaz Youssefi
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_EXT_host_image_copy] @syoussefi%0A*Here describe the issue or question you have about the VK_EXT_host_image_copy extension* >
--
-- [__Extension Proposal__]
--     <https://github.com/KhronosGroup/Vulkan-Docs/tree/main/proposals/VK_EXT_host_image_copy.adoc VK_EXT_host_image_copy>
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2023-04-26
--
-- [__Contributors__]
--
--     -   Shahbaz Youssefi, Google
--
--     -   Faith Ekstrand, Collabora
--
--     -   Hans-Kristian Arntzen, Valve
--
--     -   Piers Daniell, NVIDIA
--
--     -   Jan-Harald Fredriksen, Arm
--
--     -   James Fitzpatrick, Imagination
--
--     -   Daniel Story, Nintendo
--
-- == Description
--
-- This extension allows applications to copy data between host memory and
-- images on the host processor, without staging the data through a
-- GPU-accessible buffer. This removes the need to allocate and manage the
-- buffer and its associated memory. On some architectures it may also
-- eliminate an extra copy operation. This extension additionally allows
-- applications to copy data between images on the host.
--
-- To support initializing a new image in preparation for a host copy, it
-- is now possible to transition a new image to
-- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_GENERAL' or other
-- host-copyable layouts via 'transitionImageLayoutEXT'. Additionally, it
-- is possible to perform copies that preserve the swizzling layout of the
-- image by using the 'HOST_IMAGE_COPY_MEMCPY_EXT' flag. In that case, the
-- memory size needed for copies to or from a buffer can be retrieved by
-- chaining 'SubresourceHostMemcpySizeEXT' to @pLayout@ in
-- 'getImageSubresourceLayout2EXT'.
--
-- == New Commands
--
-- -   'copyImageToImageEXT'
--
-- -   'copyImageToMemoryEXT'
--
-- -   'copyMemoryToImageEXT'
--
-- -   'getImageSubresourceLayout2EXT'
--
-- -   'transitionImageLayoutEXT'
--
-- == New Structures
--
-- -   'CopyImageToImageInfoEXT'
--
-- -   'CopyImageToMemoryInfoEXT'
--
-- -   'CopyMemoryToImageInfoEXT'
--
-- -   'HostImageLayoutTransitionInfoEXT'
--
-- -   'ImageSubresource2EXT'
--
-- -   'ImageToMemoryCopyEXT'
--
-- -   'MemoryToImageCopyEXT'
--
-- -   'SubresourceLayout2EXT'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.ImageFormatProperties2':
--
--     -   'HostImageCopyDevicePerformanceQueryEXT'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDeviceHostImageCopyFeaturesEXT'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2':
--
--     -   'PhysicalDeviceHostImageCopyPropertiesEXT'
--
-- -   Extending
--     'Vulkan.Extensions.VK_KHR_maintenance5.SubresourceLayout2KHR':
--
--     -   'SubresourceHostMemcpySizeEXT'
--
-- == New Enums
--
-- -   'HostImageCopyFlagBitsEXT'
--
-- == New Bitmasks
--
-- -   'HostImageCopyFlagsEXT'
--
-- == New Enum Constants
--
-- -   'EXT_HOST_IMAGE_COPY_EXTENSION_NAME'
--
-- -   'EXT_HOST_IMAGE_COPY_SPEC_VERSION'
--
-- -   Extending
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FormatFeatureFlagBits2':
--
--     -   'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_HOST_IMAGE_TRANSFER_BIT_EXT'
--
-- -   Extending
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.ImageUsageFlagBits':
--
--     -   'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_HOST_TRANSFER_BIT_EXT'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_COPY_IMAGE_TO_IMAGE_INFO_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_COPY_IMAGE_TO_MEMORY_INFO_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_COPY_MEMORY_TO_IMAGE_INFO_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_HOST_IMAGE_COPY_DEVICE_PERFORMANCE_QUERY_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_HOST_IMAGE_LAYOUT_TRANSITION_INFO_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_IMAGE_TO_MEMORY_COPY_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_MEMORY_TO_IMAGE_COPY_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_HOST_IMAGE_COPY_FEATURES_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_HOST_IMAGE_COPY_PROPERTIES_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SUBRESOURCE_HOST_MEMCPY_SIZE_EXT'
--
-- == Issues
--
-- 1) When uploading data to an image, the data is usually loaded from
-- disk. Why not have the application load the data directly into a
-- 'Vulkan.Core10.Handles.DeviceMemory' bound to a buffer (instead of host
-- memory), and use
-- 'Vulkan.Core10.CommandBufferBuilding.cmdCopyBufferToImage'? The same
-- could be done when downloading data from an image.
--
-- __RESOLVED__: This may not always be possible. Complicated Vulkan
-- applications such as game engines often have decoupled subsystems for
-- streaming data and rendering. It may be unreasonable to require the
-- streaming subsystem to coordinate with the rendering subsystem to
-- allocate memory on its behalf, especially as Vulkan may not be the only
-- API supported by the engine. In emulation layers, the image data is
-- necessarily provided by the application in host memory, so an
-- optimization as suggested is not possible. Most importantly, the device
-- memory may not be mappable by an application, but still accessible to
-- the driver.
--
-- 2) Are @optimalBufferCopyOffsetAlignment@ and
-- @optimalBufferCopyRowPitchAlignment@ applicable to host memory as well
-- with the functions introduced by this extension? Or should there be new
-- limits?
--
-- __RESOLVED__: No alignment requirements for the host memory pointer.
--
-- 3) Should there be granularity requirements for image offsets and
-- extents?
--
-- __RESOLVED__: No granularity requirements, i.e. a granularity of 1 pixel
-- (for non-compressed formats) and 1 texel block (for compressed formats)
-- is assumed.
--
-- 4) How should the application deal with layout transitions before or
-- after copying to or from images?
--
-- __RESOLVED__: An existing issue with linear images is that when
-- emulating other APIs, it is impossible to know when to transition them
-- as they are written to by the host and then used bindlessly. The copy
-- operations in this extension are affected by the same limitation. A new
-- command is thus introduced by this extension to address this problem by
-- allowing the host to perform an image layout transition between a
-- handful of layouts.
--
-- == Version History
--
-- -   Revision 0, 2021-01-20 (Faith Ekstrand)
--
--     -   Initial idea and xml
--
-- -   Revision 1, 2023-04-26 (Shahbaz Youssefi)
--
--     -   Initial revision
--
-- == See Also
--
-- 'CopyImageToImageInfoEXT', 'CopyImageToMemoryInfoEXT',
-- 'CopyMemoryToImageInfoEXT', 'HostImageCopyDevicePerformanceQueryEXT',
-- 'HostImageCopyFlagBitsEXT', 'HostImageCopyFlagsEXT',
-- 'HostImageLayoutTransitionInfoEXT', 'ImageSubresource2EXT',
-- 'ImageToMemoryCopyEXT', 'MemoryToImageCopyEXT',
-- 'PhysicalDeviceHostImageCopyFeaturesEXT',
-- 'PhysicalDeviceHostImageCopyPropertiesEXT',
-- 'SubresourceHostMemcpySizeEXT', 'SubresourceLayout2EXT',
-- 'copyImageToImageEXT', 'copyImageToMemoryEXT', 'copyMemoryToImageEXT',
-- 'getImageSubresourceLayout2EXT', 'transitionImageLayoutEXT'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_EXT_host_image_copy Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_EXT_host_image_copy  ( copyMemoryToImageEXT
                                                 , copyImageToMemoryEXT
                                                 , copyImageToImageEXT
                                                 , transitionImageLayoutEXT
                                                 , getImageSubresourceLayout2EXT
                                                 , PhysicalDeviceHostImageCopyFeaturesEXT(..)
                                                 , PhysicalDeviceHostImageCopyPropertiesEXT(..)
                                                 , MemoryToImageCopyEXT(..)
                                                 , ImageToMemoryCopyEXT(..)
                                                 , CopyMemoryToImageInfoEXT(..)
                                                 , CopyImageToMemoryInfoEXT(..)
                                                 , CopyImageToImageInfoEXT(..)
                                                 , HostImageLayoutTransitionInfoEXT(..)
                                                 , SubresourceHostMemcpySizeEXT(..)
                                                 , HostImageCopyDevicePerformanceQueryEXT(..)
                                                 , HostImageCopyFlagsEXT
                                                 , HostImageCopyFlagBitsEXT( HOST_IMAGE_COPY_MEMCPY_EXT
                                                                           , ..
                                                                           )
                                                 , ImageSubresource2EXT
                                                 , SubresourceLayout2EXT
                                                 , EXT_HOST_IMAGE_COPY_SPEC_VERSION
                                                 , pattern EXT_HOST_IMAGE_COPY_SPEC_VERSION
                                                 , EXT_HOST_IMAGE_COPY_EXTENSION_NAME
                                                 , pattern EXT_HOST_IMAGE_COPY_EXTENSION_NAME
                                                 , ImageSubresource2KHR(..)
                                                 , SubresourceLayout2KHR(..)
                                                 , getImageSubresourceLayout2KHR
                                                 ) where

import Data.Bits (Bits)
import Data.Bits (FiniteBits)
import Vulkan.CStruct.Utils (FixedArray)
import Vulkan.Internal.Utils (enumReadPrec)
import Vulkan.Internal.Utils (enumShowsPrec)
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytes)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import GHC.Show (showString)
import Numeric (showHex)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero)
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import GHC.Read (Read(readPrec))
import GHC.Show (Show(showsPrec))
import Data.Word (Word32)
import Data.Word (Word8)
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.CStruct.Utils (advancePtrBytes)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.Extensions.VK_KHR_maintenance5 (getImageSubresourceLayout2KHR)
import Vulkan.CStruct.Utils (peekByteStringFromSizedVectorPtr)
import Vulkan.CStruct.Utils (pokeFixedLengthByteString)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkCopyImageToImageEXT))
import Vulkan.Dynamic (DeviceCmds(pVkCopyImageToMemoryEXT))
import Vulkan.Dynamic (DeviceCmds(pVkCopyMemoryToImageEXT))
import Vulkan.Dynamic (DeviceCmds(pVkTransitionImageLayoutEXT))
import Vulkan.Core10.FundamentalTypes (DeviceSize)
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core10.FundamentalTypes (Extent3D)
import Vulkan.Core10.FundamentalTypes (Flags)
import Vulkan.Core10.Handles (Image)
import Vulkan.Core13.Promoted_From_VK_KHR_copy_commands2 (ImageCopy2)
import Vulkan.Core10.Enums.ImageLayout (ImageLayout)
import Vulkan.Extensions.VK_KHR_maintenance5 (ImageSubresource2KHR)
import Vulkan.Core10.CommandBufferBuilding (ImageSubresourceLayers)
import Vulkan.Core10.ImageView (ImageSubresourceRange)
import Vulkan.Core10.FundamentalTypes (Offset3D)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Extensions.VK_KHR_maintenance5 (SubresourceLayout2KHR)
import Vulkan.Core10.APIConstants (UUID_SIZE)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_COPY_IMAGE_TO_IMAGE_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_COPY_IMAGE_TO_MEMORY_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_COPY_MEMORY_TO_IMAGE_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_HOST_IMAGE_COPY_DEVICE_PERFORMANCE_QUERY_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_HOST_IMAGE_LAYOUT_TRANSITION_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_IMAGE_TO_MEMORY_COPY_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_MEMORY_TO_IMAGE_COPY_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_HOST_IMAGE_COPY_FEATURES_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_HOST_IMAGE_COPY_PROPERTIES_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SUBRESOURCE_HOST_MEMCPY_SIZE_EXT))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Extensions.VK_KHR_maintenance5 (getImageSubresourceLayout2KHR)
import Vulkan.Extensions.VK_KHR_maintenance5 (ImageSubresource2KHR(..))
import Vulkan.Extensions.VK_KHR_maintenance5 (SubresourceLayout2KHR(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCopyMemoryToImageEXT
  :: FunPtr (Ptr Device_T -> Ptr CopyMemoryToImageInfoEXT -> IO Result) -> Ptr Device_T -> Ptr CopyMemoryToImageInfoEXT -> IO Result

-- | vkCopyMemoryToImageEXT - Copy data from host memory into an image
--
-- = Description
--
-- This command is functionally similar to
-- 'Vulkan.Core13.Promoted_From_VK_KHR_copy_commands2.cmdCopyBufferToImage2',
-- except it is executed on the host and reads from host memory instead of
-- a buffer.
--
-- == Valid Usage
--
-- -   #VUID-vkCopyMemoryToImageEXT-hostImageCopy-09058# The
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-hostImageCopy hostImageCopy>
--     feature /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCopyMemoryToImageEXT-device-parameter# @device@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkCopyMemoryToImageEXT-pCopyMemoryToImageInfo-parameter#
--     @pCopyMemoryToImageInfo@ /must/ be a valid pointer to a valid
--     'CopyMemoryToImageInfoEXT' structure
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_INITIALIZATION_FAILED'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_MEMORY_MAP_FAILED'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_host_image_copy VK_EXT_host_image_copy>,
-- 'CopyMemoryToImageInfoEXT', 'Vulkan.Core10.Handles.Device'
copyMemoryToImageEXT :: forall io
                      . (MonadIO io)
                     => -- | @device@ is the device which owns @pCopyMemoryToImageInfo->dstImage@.
                        Device
                     -> -- | @pCopyMemoryToImageInfo@ is a pointer to a 'CopyMemoryToImageInfoEXT'
                        -- structure describing the copy parameters.
                        CopyMemoryToImageInfoEXT
                     -> io ()
copyMemoryToImageEXT :: forall (io :: * -> *).
MonadIO io =>
Device -> CopyMemoryToImageInfoEXT -> io ()
copyMemoryToImageEXT Device
device CopyMemoryToImageInfoEXT
copyMemoryToImageInfo = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
  let vkCopyMemoryToImageEXTPtr :: FunPtr
  (Ptr Device_T
   -> ("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT)
   -> IO Result)
vkCopyMemoryToImageEXTPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT)
      -> IO Result)
pVkCopyMemoryToImageEXT (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT)
   -> IO Result)
vkCopyMemoryToImageEXTPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCopyMemoryToImageEXT is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkCopyMemoryToImageEXT' :: Ptr Device_T
-> ("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT)
-> IO Result
vkCopyMemoryToImageEXT' = FunPtr
  (Ptr Device_T
   -> ("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT)
   -> IO Result)
-> Ptr Device_T
-> ("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT)
-> IO Result
mkVkCopyMemoryToImageEXT FunPtr
  (Ptr Device_T
   -> ("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT)
   -> IO Result)
vkCopyMemoryToImageEXTPtr
  "pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
pCopyMemoryToImageInfo <- 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 a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (CopyMemoryToImageInfoEXT
copyMemoryToImageInfo)
  Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCopyMemoryToImageEXT" (Ptr Device_T
-> ("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT)
-> IO Result
vkCopyMemoryToImageEXT'
                                                           (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                           "pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
pCopyMemoryToImageInfo)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCopyImageToMemoryEXT
  :: FunPtr (Ptr Device_T -> Ptr CopyImageToMemoryInfoEXT -> IO Result) -> Ptr Device_T -> Ptr CopyImageToMemoryInfoEXT -> IO Result

-- | vkCopyImageToMemoryEXT - Copy image data into host memory
--
-- = Description
--
-- This command is functionally similar to
-- 'Vulkan.Core13.Promoted_From_VK_KHR_copy_commands2.cmdCopyImageToBuffer2',
-- except it is executed on the host and writes to host memory instead of a
-- buffer.
--
-- == Valid Usage
--
-- -   #VUID-vkCopyImageToMemoryEXT-hostImageCopy-09063# The
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-hostImageCopy hostImageCopy>
--     feature /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCopyImageToMemoryEXT-device-parameter# @device@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkCopyImageToMemoryEXT-pCopyImageToMemoryInfo-parameter#
--     @pCopyImageToMemoryInfo@ /must/ be a valid pointer to a valid
--     'CopyImageToMemoryInfoEXT' structure
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_INITIALIZATION_FAILED'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_MEMORY_MAP_FAILED'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_host_image_copy VK_EXT_host_image_copy>,
-- 'CopyImageToMemoryInfoEXT', 'Vulkan.Core10.Handles.Device'
copyImageToMemoryEXT :: forall io
                      . (MonadIO io)
                     => -- | @device@ is the device which owns @pCopyImageToMemoryInfo->srcImage@.
                        Device
                     -> -- | @pCopyImageToMemoryInfo@ is a pointer to a 'CopyImageToMemoryInfoEXT'
                        -- structure describing the copy parameters.
                        CopyImageToMemoryInfoEXT
                     -> io ()
copyImageToMemoryEXT :: forall (io :: * -> *).
MonadIO io =>
Device -> CopyImageToMemoryInfoEXT -> io ()
copyImageToMemoryEXT Device
device CopyImageToMemoryInfoEXT
copyImageToMemoryInfo = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
  let vkCopyImageToMemoryEXTPtr :: FunPtr
  (Ptr Device_T
   -> ("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT)
   -> IO Result)
vkCopyImageToMemoryEXTPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT)
      -> IO Result)
pVkCopyImageToMemoryEXT (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT)
   -> IO Result)
vkCopyImageToMemoryEXTPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCopyImageToMemoryEXT is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkCopyImageToMemoryEXT' :: Ptr Device_T
-> ("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT)
-> IO Result
vkCopyImageToMemoryEXT' = FunPtr
  (Ptr Device_T
   -> ("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT)
   -> IO Result)
-> Ptr Device_T
-> ("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT)
-> IO Result
mkVkCopyImageToMemoryEXT FunPtr
  (Ptr Device_T
   -> ("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT)
   -> IO Result)
vkCopyImageToMemoryEXTPtr
  "pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
pCopyImageToMemoryInfo <- 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 a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (CopyImageToMemoryInfoEXT
copyImageToMemoryInfo)
  Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCopyImageToMemoryEXT" (Ptr Device_T
-> ("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT)
-> IO Result
vkCopyImageToMemoryEXT'
                                                           (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                           "pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
pCopyImageToMemoryInfo)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCopyImageToImageEXT
  :: FunPtr (Ptr Device_T -> Ptr CopyImageToImageInfoEXT -> IO Result) -> Ptr Device_T -> Ptr CopyImageToImageInfoEXT -> IO Result

-- | vkCopyImageToImageEXT - Copy image data using the host
--
-- = Description
--
-- This command is functionally similar to
-- 'Vulkan.Core13.Promoted_From_VK_KHR_copy_commands2.cmdCopyImage2',
-- except it is executed on the host.
--
-- == Valid Usage
--
-- -   #VUID-vkCopyImageToImageEXT-hostImageCopy-09068# The
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-hostImageCopy hostImageCopy>
--     feature /must/ be enabled
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCopyImageToImageEXT-device-parameter# @device@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkCopyImageToImageEXT-pCopyImageToImageInfo-parameter#
--     @pCopyImageToImageInfo@ /must/ be a valid pointer to a valid
--     'CopyImageToImageInfoEXT' structure
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_INITIALIZATION_FAILED'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_MEMORY_MAP_FAILED'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_host_image_copy VK_EXT_host_image_copy>,
-- 'CopyImageToImageInfoEXT', 'Vulkan.Core10.Handles.Device'
copyImageToImageEXT :: forall io
                     . (MonadIO io)
                    => -- | @device@ is the device which owns @pCopyImageToMemoryInfo->srcImage@.
                       Device
                    -> -- | @pCopyImageToImageInfo@ is a pointer to a 'CopyImageToImageInfoEXT'
                       -- structure describing the copy parameters.
                       CopyImageToImageInfoEXT
                    -> io ()
copyImageToImageEXT :: forall (io :: * -> *).
MonadIO io =>
Device -> CopyImageToImageInfoEXT -> io ()
copyImageToImageEXT Device
device CopyImageToImageInfoEXT
copyImageToImageInfo = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
  let vkCopyImageToImageEXTPtr :: FunPtr
  (Ptr Device_T
   -> ("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT)
   -> IO Result)
vkCopyImageToImageEXTPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT)
      -> IO Result)
pVkCopyImageToImageEXT (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT)
   -> IO Result)
vkCopyImageToImageEXTPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCopyImageToImageEXT is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkCopyImageToImageEXT' :: Ptr Device_T
-> ("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT)
-> IO Result
vkCopyImageToImageEXT' = FunPtr
  (Ptr Device_T
   -> ("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT)
   -> IO Result)
-> Ptr Device_T
-> ("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT)
-> IO Result
mkVkCopyImageToImageEXT FunPtr
  (Ptr Device_T
   -> ("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT)
   -> IO Result)
vkCopyImageToImageEXTPtr
  "pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
pCopyImageToImageInfo <- 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 a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (CopyImageToImageInfoEXT
copyImageToImageInfo)
  Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCopyImageToImageEXT" (Ptr Device_T
-> ("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT)
-> IO Result
vkCopyImageToImageEXT'
                                                          (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                          "pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
pCopyImageToImageInfo)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkTransitionImageLayoutEXT
  :: FunPtr (Ptr Device_T -> Word32 -> Ptr HostImageLayoutTransitionInfoEXT -> IO Result) -> Ptr Device_T -> Word32 -> Ptr HostImageLayoutTransitionInfoEXT -> IO Result

-- | vkTransitionImageLayoutEXT - Perform an image layout transition on the
-- host
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_INITIALIZATION_FAILED'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_MEMORY_MAP_FAILED'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_host_image_copy VK_EXT_host_image_copy>,
-- 'Vulkan.Core10.Handles.Device', 'HostImageLayoutTransitionInfoEXT'
transitionImageLayoutEXT :: forall io
                          . (MonadIO io)
                         => -- | @device@ is the device which owns @pTransitions@[i].@image@.
                            --
                            -- #VUID-vkTransitionImageLayoutEXT-device-parameter# @device@ /must/ be a
                            -- valid 'Vulkan.Core10.Handles.Device' handle
                            Device
                         -> -- | @pTransitions@ is a pointer to an array of
                            -- 'HostImageLayoutTransitionInfoEXT' structures specifying the image and
                            -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#resources-image-views subresource ranges>
                            -- within them to transition.
                            --
                            -- #VUID-vkTransitionImageLayoutEXT-pTransitions-parameter# @pTransitions@
                            -- /must/ be a valid pointer to an array of @transitionCount@ valid
                            -- 'HostImageLayoutTransitionInfoEXT' structures
                            ("transitions" ::: Vector HostImageLayoutTransitionInfoEXT)
                         -> io ()
transitionImageLayoutEXT :: forall (io :: * -> *).
MonadIO io =>
Device
-> ("transitions" ::: Vector HostImageLayoutTransitionInfoEXT)
-> io ()
transitionImageLayoutEXT Device
device "transitions" ::: Vector HostImageLayoutTransitionInfoEXT
transitions = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
  let vkTransitionImageLayoutEXTPtr :: FunPtr
  (Ptr Device_T
   -> Flags
   -> ("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
   -> IO Result)
vkTransitionImageLayoutEXTPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> Flags
      -> ("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
      -> IO Result)
pVkTransitionImageLayoutEXT (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> Flags
   -> ("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
   -> IO Result)
vkTransitionImageLayoutEXTPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkTransitionImageLayoutEXT is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  let vkTransitionImageLayoutEXT' :: Ptr Device_T
-> Flags
-> ("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
-> IO Result
vkTransitionImageLayoutEXT' = FunPtr
  (Ptr Device_T
   -> Flags
   -> ("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
   -> IO Result)
-> Ptr Device_T
-> Flags
-> ("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
-> IO Result
mkVkTransitionImageLayoutEXT FunPtr
  (Ptr Device_T
   -> Flags
   -> ("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
   -> IO Result)
vkTransitionImageLayoutEXTPtr
  "pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
pPTransitions <- 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 a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @HostImageLayoutTransitionInfoEXT ((forall a. Vector a -> Int
Data.Vector.length ("transitions" ::: Vector HostImageLayoutTransitionInfoEXT
transitions)) forall a. Num a => a -> a -> a
* Int
56)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i HostImageLayoutTransitionInfoEXT
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke ("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
pPTransitions forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
56 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr HostImageLayoutTransitionInfoEXT) (HostImageLayoutTransitionInfoEXT
e)) ("transitions" ::: Vector HostImageLayoutTransitionInfoEXT
transitions)
  Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkTransitionImageLayoutEXT" (Ptr Device_T
-> Flags
-> ("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
-> IO Result
vkTransitionImageLayoutEXT'
                                                               (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                               ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ ("transitions" ::: Vector HostImageLayoutTransitionInfoEXT
transitions)) :: Word32))
                                                               ("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
pPTransitions))
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))


-- No documentation found for TopLevel "vkGetImageSubresourceLayout2EXT"
getImageSubresourceLayout2EXT :: Device
-> Image -> ImageSubresource2KHR -> io (SubresourceLayout2KHR a)
getImageSubresourceLayout2EXT = forall (a :: [*]) (io :: * -> *).
(Extendss SubresourceLayout2KHR a, PokeChain a, PeekChain a,
 MonadIO io) =>
Device
-> Image -> ImageSubresource2KHR -> io (SubresourceLayout2KHR a)
getImageSubresourceLayout2KHR


-- | VkPhysicalDeviceHostImageCopyFeaturesEXT - Structure indicating support
-- for copies to or from images from host memory
--
-- = Members
--
-- This structure describes the following feature:
--
-- = Description
--
-- If the 'PhysicalDeviceHostImageCopyFeaturesEXT' structure is included in
-- the @pNext@ chain of the
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2'
-- structure passed to
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceFeatures2',
-- it is filled in to indicate whether each corresponding feature is
-- supported. 'PhysicalDeviceHostImageCopyFeaturesEXT' /can/ also be used
-- in the @pNext@ chain of 'Vulkan.Core10.Device.DeviceCreateInfo' to
-- selectively enable these features.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_host_image_copy VK_EXT_host_image_copy>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceHostImageCopyFeaturesEXT = PhysicalDeviceHostImageCopyFeaturesEXT
  { -- | #features-hostImageCopy# @hostImageCopy@ indicates that the
    -- implementation supports copying from host memory to images using the
    -- 'copyMemoryToImageEXT' command, copying from images to host memory using
    -- the 'copyImageToMemoryEXT' command, and copying between images using the
    -- 'copyImageToImageEXT' command.
    PhysicalDeviceHostImageCopyFeaturesEXT -> Bool
hostImageCopy :: Bool }
  deriving (Typeable, PhysicalDeviceHostImageCopyFeaturesEXT
-> PhysicalDeviceHostImageCopyFeaturesEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceHostImageCopyFeaturesEXT
-> PhysicalDeviceHostImageCopyFeaturesEXT -> Bool
$c/= :: PhysicalDeviceHostImageCopyFeaturesEXT
-> PhysicalDeviceHostImageCopyFeaturesEXT -> Bool
== :: PhysicalDeviceHostImageCopyFeaturesEXT
-> PhysicalDeviceHostImageCopyFeaturesEXT -> Bool
$c== :: PhysicalDeviceHostImageCopyFeaturesEXT
-> PhysicalDeviceHostImageCopyFeaturesEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceHostImageCopyFeaturesEXT)
#endif
deriving instance Show PhysicalDeviceHostImageCopyFeaturesEXT

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

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

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

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


-- | VkPhysicalDeviceHostImageCopyPropertiesEXT - Structure enumerating image
-- layouts supported by an implementation for host memory copies
--
-- = Description
--
-- If the 'PhysicalDeviceHostImageCopyPropertiesEXT' structure is included
-- in the @pNext@ chain of the
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2'
-- structure passed to
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceProperties2',
-- it is filled in with each corresponding implementation-dependent
-- property.
--
-- If @pCopyDstLayouts@ is @NULL@, then the number of image layouts that
-- are supported in 'CopyMemoryToImageInfoEXT'::@dstImageLayout@ and
-- 'CopyImageToImageInfoEXT'::@dstImageLayout@ is returned in
-- @copyDstLayoutCount@. Otherwise, @copyDstLayoutCount@ /must/ be set by
-- the user to the number of elements in the @pCopyDstLayouts@ array, and
-- on return the variable is overwritten with the number of values actually
-- written to @pCopyDstLayouts@. If the value of @copyDstLayoutCount@ is
-- less than the number of image layouts that are supported, at most
-- @copyDstLayoutCount@ values will be written to @pCopyDstLayouts@. The
-- implementation /must/ include the
-- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_GENERAL' image layout in
-- @pCopyDstLayouts@.
--
-- If @pCopySrcLayouts@ is @NULL@, then the number of image layouts that
-- are supported in 'CopyImageToMemoryInfoEXT'::@srcImageLayout@ and
-- 'CopyImageToImageInfoEXT'::@srcImageLayout@ is returned in
-- @copySrcLayoutCount@. Otherwise, @copySrcLayoutCount@ /must/ be set by
-- the user to the number of elements in the @pCopySrcLayouts@ array, and
-- on return the variable is overwritten with the number of values actually
-- written to @pCopySrcLayouts@. If the value of @copySrcLayoutCount@ is
-- less than the number of image layouts that are supported, at most
-- @copySrcLayoutCount@ values will be written to @pCopySrcLayouts@. The
-- implementation /must/ include the
-- 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_GENERAL' image layout in
-- @pCopySrcLayouts@.
--
-- The @optimalTilingLayoutUUID@ value can be used to ensure compatible
-- data layouts when using the 'HOST_IMAGE_COPY_MEMCPY_EXT' flag in
-- 'copyMemoryToImageEXT' and 'copyImageToMemoryEXT'.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkPhysicalDeviceHostImageCopyPropertiesEXT-sType-sType#
--     @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_HOST_IMAGE_COPY_PROPERTIES_EXT'
--
-- -   #VUID-VkPhysicalDeviceHostImageCopyPropertiesEXT-pCopySrcLayouts-parameter#
--     If @copySrcLayoutCount@ is not @0@, and @pCopySrcLayouts@ is not
--     @NULL@, @pCopySrcLayouts@ /must/ be a valid pointer to an array of
--     @copySrcLayoutCount@ 'Vulkan.Core10.Enums.ImageLayout.ImageLayout'
--     values
--
-- -   #VUID-VkPhysicalDeviceHostImageCopyPropertiesEXT-pCopyDstLayouts-parameter#
--     If @copyDstLayoutCount@ is not @0@, and @pCopyDstLayouts@ is not
--     @NULL@, @pCopyDstLayouts@ /must/ be a valid pointer to an array of
--     @copyDstLayoutCount@ 'Vulkan.Core10.Enums.ImageLayout.ImageLayout'
--     values
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_host_image_copy VK_EXT_host_image_copy>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.ImageLayout.ImageLayout',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceHostImageCopyPropertiesEXT = PhysicalDeviceHostImageCopyPropertiesEXT
  { -- | @copySrcLayoutCount@ is an integer related to the number of image
    -- layouts for host copies from images available or queried, as described
    -- below.
    PhysicalDeviceHostImageCopyPropertiesEXT -> Flags
copySrcLayoutCount :: Word32
  , -- | @pCopySrcLayouts@ is a pointer to an array of
    -- 'Vulkan.Core10.Enums.ImageLayout.ImageLayout' in which supported image
    -- layouts for use with host copy operations from images are returned.
    PhysicalDeviceHostImageCopyPropertiesEXT -> Ptr ImageLayout
copySrcLayouts :: Ptr ImageLayout
  , -- | @copyDstLayoutCount@ is an integer related to the number of image
    -- layouts for host copies to images available or queried, as described
    -- below.
    PhysicalDeviceHostImageCopyPropertiesEXT -> Flags
copyDstLayoutCount :: Word32
  , -- | @pCopyDstLayouts@ is a pointer to an array of
    -- 'Vulkan.Core10.Enums.ImageLayout.ImageLayout' in which supported image
    -- layouts for use with host copy operations to images are returned.
    PhysicalDeviceHostImageCopyPropertiesEXT -> Ptr ImageLayout
copyDstLayouts :: Ptr ImageLayout
  , -- | @optimalTilingLayoutUUID@ is an array of
    -- 'Vulkan.Core10.APIConstants.UUID_SIZE' @uint8_t@ values representing a
    -- universally unique identifier for the implementation’s swizzling layout
    -- of images created with
    -- 'Vulkan.Core10.Enums.ImageTiling.IMAGE_TILING_OPTIMAL'.
    PhysicalDeviceHostImageCopyPropertiesEXT -> ByteString
optimalTilingLayoutUUID :: ByteString
  , -- | @identicalMemoryTypeRequirements@ indicates that specifying the
    -- 'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_HOST_TRANSFER_BIT_EXT'
    -- flag in 'Vulkan.Core10.Image.ImageCreateInfo'::@usage@ does not affect
    -- the memory type requirements of the image.
    PhysicalDeviceHostImageCopyPropertiesEXT -> Bool
identicalMemoryTypeRequirements :: Bool
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceHostImageCopyPropertiesEXT)
#endif
deriving instance Show PhysicalDeviceHostImageCopyPropertiesEXT

instance ToCStruct PhysicalDeviceHostImageCopyPropertiesEXT where
  withCStruct :: forall b.
PhysicalDeviceHostImageCopyPropertiesEXT
-> (Ptr PhysicalDeviceHostImageCopyPropertiesEXT -> IO b) -> IO b
withCStruct PhysicalDeviceHostImageCopyPropertiesEXT
x Ptr PhysicalDeviceHostImageCopyPropertiesEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
72 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p PhysicalDeviceHostImageCopyPropertiesEXT
x (Ptr PhysicalDeviceHostImageCopyPropertiesEXT -> IO b
f Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p)
  pokeCStruct :: forall b.
Ptr PhysicalDeviceHostImageCopyPropertiesEXT
-> PhysicalDeviceHostImageCopyPropertiesEXT -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p PhysicalDeviceHostImageCopyPropertiesEXT{Bool
Flags
Ptr ImageLayout
ByteString
identicalMemoryTypeRequirements :: Bool
optimalTilingLayoutUUID :: ByteString
copyDstLayouts :: Ptr ImageLayout
copyDstLayoutCount :: Flags
copySrcLayouts :: Ptr ImageLayout
copySrcLayoutCount :: Flags
$sel:identicalMemoryTypeRequirements:PhysicalDeviceHostImageCopyPropertiesEXT :: PhysicalDeviceHostImageCopyPropertiesEXT -> Bool
$sel:optimalTilingLayoutUUID:PhysicalDeviceHostImageCopyPropertiesEXT :: PhysicalDeviceHostImageCopyPropertiesEXT -> ByteString
$sel:copyDstLayouts:PhysicalDeviceHostImageCopyPropertiesEXT :: PhysicalDeviceHostImageCopyPropertiesEXT -> Ptr ImageLayout
$sel:copyDstLayoutCount:PhysicalDeviceHostImageCopyPropertiesEXT :: PhysicalDeviceHostImageCopyPropertiesEXT -> Flags
$sel:copySrcLayouts:PhysicalDeviceHostImageCopyPropertiesEXT :: PhysicalDeviceHostImageCopyPropertiesEXT -> Ptr ImageLayout
$sel:copySrcLayoutCount:PhysicalDeviceHostImageCopyPropertiesEXT :: PhysicalDeviceHostImageCopyPropertiesEXT -> Flags
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_HOST_IMAGE_COPY_PROPERTIES_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
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 PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Flags
copySrcLayoutCount)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr ImageLayout))) (Ptr ImageLayout
copySrcLayouts)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) (Flags
copyDstLayoutCount)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr ImageLayout))) (Ptr ImageLayout
copyDstLayouts)
    forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> ByteString -> IO ()
pokeFixedLengthByteString ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr (FixedArray UUID_SIZE Word8))) (ByteString
optimalTilingLayoutUUID)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
identicalMemoryTypeRequirements))
    IO b
f
  cStructSize :: Int
cStructSize = Int
72
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceHostImageCopyPropertiesEXT -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_HOST_IMAGE_COPY_PROPERTIES_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
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 PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct PhysicalDeviceHostImageCopyPropertiesEXT where
  peekCStruct :: Ptr PhysicalDeviceHostImageCopyPropertiesEXT
-> IO PhysicalDeviceHostImageCopyPropertiesEXT
peekCStruct Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p = do
    Flags
copySrcLayoutCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    Ptr ImageLayout
pCopySrcLayouts <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ImageLayout) ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr ImageLayout)))
    Flags
copyDstLayoutCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32))
    Ptr ImageLayout
pCopyDstLayouts <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ImageLayout) ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr ImageLayout)))
    ByteString
optimalTilingLayoutUUID <- forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> IO ByteString
peekByteStringFromSizedVectorPtr ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr (FixedArray UUID_SIZE Word8)))
    Bool32
identicalMemoryTypeRequirements <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr Bool32))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Flags
-> Ptr ImageLayout
-> Flags
-> Ptr ImageLayout
-> ByteString
-> Bool
-> PhysicalDeviceHostImageCopyPropertiesEXT
PhysicalDeviceHostImageCopyPropertiesEXT
             Flags
copySrcLayoutCount
             Ptr ImageLayout
pCopySrcLayouts
             Flags
copyDstLayoutCount
             Ptr ImageLayout
pCopyDstLayouts
             ByteString
optimalTilingLayoutUUID
             (Bool32 -> Bool
bool32ToBool Bool32
identicalMemoryTypeRequirements)

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

instance Zero PhysicalDeviceHostImageCopyPropertiesEXT where
  zero :: PhysicalDeviceHostImageCopyPropertiesEXT
zero = Flags
-> Ptr ImageLayout
-> Flags
-> Ptr ImageLayout
-> ByteString
-> Bool
-> PhysicalDeviceHostImageCopyPropertiesEXT
PhysicalDeviceHostImageCopyPropertiesEXT
           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
           forall a. Zero a => a
zero


-- | VkMemoryToImageCopyEXT - Structure specifying a host memory to image
-- copy operation
--
-- = Description
--
-- This structure is functionally similar to
-- 'Vulkan.Core13.Promoted_From_VK_KHR_copy_commands2.BufferImageCopy2',
-- except it defines host memory as the source of copy instead of a buffer.
-- In particular, the same data packing rules and restrictions as that
-- structure apply here as well.
--
-- == Valid Usage
--
-- -   #VUID-VkMemoryToImageCopyEXT-pHostPointer-09061# @pHostPointer@
--     /must/ point to memory that is large enough to contain all memory
--     locations that are accessed according to
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#copies-buffers-images-addressing Buffer and Image Addressing>,
--     for each element of @pRegions@
--
-- -   #VUID-VkMemoryToImageCopyEXT-pRegions-09062# The union of all source
--     regions, and the union of all destination regions, specified by the
--     elements of @pRegions@, /must/ not overlap in memory
--
-- -   #VUID-VkMemoryToImageCopyEXT-memoryRowLength-09101#
--     @memoryRowLength@ /must/ be @0@, or greater than or equal to the
--     @width@ member of @imageExtent@
--
-- -   #VUID-VkMemoryToImageCopyEXT-memoryImageHeight-09102#
--     @memoryImageHeight@ /must/ be @0@, or greater than or equal to the
--     @height@ member of @imageExtent@
--
-- -   #VUID-VkMemoryToImageCopyEXT-aspectMask-09103# The @aspectMask@
--     member of @imageSubresource@ /must/ only have a single bit set
--
-- -   #VUID-VkMemoryToImageCopyEXT-imageExtent-06659# @imageExtent.width@
--     /must/ not be 0
--
-- -   #VUID-VkMemoryToImageCopyEXT-imageExtent-06660# @imageExtent.height@
--     /must/ not be 0
--
-- -   #VUID-VkMemoryToImageCopyEXT-imageExtent-06661# @imageExtent.depth@
--     /must/ not be 0
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkMemoryToImageCopyEXT-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_MEMORY_TO_IMAGE_COPY_EXT'
--
-- -   #VUID-VkMemoryToImageCopyEXT-pNext-pNext# @pNext@ /must/ be @NULL@
--
-- -   #VUID-VkMemoryToImageCopyEXT-pHostPointer-parameter# @pHostPointer@
--     /must/ be a pointer value
--
-- -   #VUID-VkMemoryToImageCopyEXT-imageSubresource-parameter#
--     @imageSubresource@ /must/ be a valid
--     'Vulkan.Core10.CommandBufferBuilding.ImageSubresourceLayers'
--     structure
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_host_image_copy VK_EXT_host_image_copy>,
-- 'CopyMemoryToImageInfoEXT', 'Vulkan.Core10.FundamentalTypes.Extent3D',
-- 'Vulkan.Core10.CommandBufferBuilding.ImageSubresourceLayers',
-- 'Vulkan.Core10.FundamentalTypes.Offset3D',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data MemoryToImageCopyEXT = MemoryToImageCopyEXT
  { -- | @pHostPointer@ is the host memory address which is the source of the
    -- copy.
    MemoryToImageCopyEXT -> Ptr ()
hostPointer :: Ptr ()
  , -- | @memoryRowLength@ and @memoryImageHeight@ specify in texels a subregion
    -- of a larger two- or three-dimensional image in host memory, and control
    -- the addressing calculations. If either of these values is zero, that
    -- aspect of the host memory is considered to be tightly packed according
    -- to the @imageExtent@.
    MemoryToImageCopyEXT -> Flags
memoryRowLength :: Word32
  , -- No documentation found for Nested "VkMemoryToImageCopyEXT" "memoryImageHeight"
    MemoryToImageCopyEXT -> Flags
memoryImageHeight :: Word32
  , -- | @imageSubresource@ is a
    -- 'Vulkan.Core10.CommandBufferBuilding.ImageSubresourceLayers' used to
    -- specify the specific image subresources of the image used for the source
    -- or destination image data.
    MemoryToImageCopyEXT -> ImageSubresourceLayers
imageSubresource :: ImageSubresourceLayers
  , -- | @imageOffset@ selects the initial @x@, @y@, @z@ offsets in texels of the
    -- sub-region of the destination image data.
    MemoryToImageCopyEXT -> Offset3D
imageOffset :: Offset3D
  , -- | @imageExtent@ is the size in texels of the image to copy in @width@,
    -- @height@ and @depth@.
    MemoryToImageCopyEXT -> Extent3D
imageExtent :: Extent3D
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MemoryToImageCopyEXT)
#endif
deriving instance Show MemoryToImageCopyEXT

instance ToCStruct MemoryToImageCopyEXT where
  withCStruct :: forall b.
MemoryToImageCopyEXT -> (Ptr MemoryToImageCopyEXT -> IO b) -> IO b
withCStruct MemoryToImageCopyEXT
x Ptr MemoryToImageCopyEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
72 forall a b. (a -> b) -> a -> b
$ \Ptr MemoryToImageCopyEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr MemoryToImageCopyEXT
p MemoryToImageCopyEXT
x (Ptr MemoryToImageCopyEXT -> IO b
f Ptr MemoryToImageCopyEXT
p)
  pokeCStruct :: forall b.
Ptr MemoryToImageCopyEXT -> MemoryToImageCopyEXT -> IO b -> IO b
pokeCStruct Ptr MemoryToImageCopyEXT
p MemoryToImageCopyEXT{Flags
Ptr ()
ImageSubresourceLayers
Offset3D
Extent3D
imageExtent :: Extent3D
imageOffset :: Offset3D
imageSubresource :: ImageSubresourceLayers
memoryImageHeight :: Flags
memoryRowLength :: Flags
hostPointer :: Ptr ()
$sel:imageExtent:MemoryToImageCopyEXT :: MemoryToImageCopyEXT -> Extent3D
$sel:imageOffset:MemoryToImageCopyEXT :: MemoryToImageCopyEXT -> Offset3D
$sel:imageSubresource:MemoryToImageCopyEXT :: MemoryToImageCopyEXT -> ImageSubresourceLayers
$sel:memoryImageHeight:MemoryToImageCopyEXT :: MemoryToImageCopyEXT -> Flags
$sel:memoryRowLength:MemoryToImageCopyEXT :: MemoryToImageCopyEXT -> Flags
$sel:hostPointer:MemoryToImageCopyEXT :: MemoryToImageCopyEXT -> Ptr ()
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_TO_IMAGE_COPY_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
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 MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr ()))) (Ptr ()
hostPointer)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Flags
memoryRowLength)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (Flags
memoryImageHeight)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageSubresourceLayers)) (ImageSubresourceLayers
imageSubresource)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Offset3D)) (Offset3D
imageOffset)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Extent3D)) (Extent3D
imageExtent)
    IO b
f
  cStructSize :: Int
cStructSize = Int
72
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr MemoryToImageCopyEXT -> IO b -> IO b
pokeZeroCStruct Ptr MemoryToImageCopyEXT
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_TO_IMAGE_COPY_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
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 MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr ()))) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageSubresourceLayers)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Offset3D)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Extent3D)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct MemoryToImageCopyEXT where
  peekCStruct :: Ptr MemoryToImageCopyEXT -> IO MemoryToImageCopyEXT
peekCStruct Ptr MemoryToImageCopyEXT
p = do
    Ptr ()
pHostPointer <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr ())))
    Flags
memoryRowLength <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32))
    Flags
memoryImageHeight <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32))
    ImageSubresourceLayers
imageSubresource <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ImageSubresourceLayers ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageSubresourceLayers))
    Offset3D
imageOffset <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Offset3D ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Offset3D))
    Extent3D
imageExtent <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent3D ((Ptr MemoryToImageCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Extent3D))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Ptr ()
-> Flags
-> Flags
-> ImageSubresourceLayers
-> Offset3D
-> Extent3D
-> MemoryToImageCopyEXT
MemoryToImageCopyEXT
             Ptr ()
pHostPointer
             Flags
memoryRowLength
             Flags
memoryImageHeight
             ImageSubresourceLayers
imageSubresource
             Offset3D
imageOffset
             Extent3D
imageExtent

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

instance Zero MemoryToImageCopyEXT where
  zero :: MemoryToImageCopyEXT
zero = Ptr ()
-> Flags
-> Flags
-> ImageSubresourceLayers
-> Offset3D
-> Extent3D
-> MemoryToImageCopyEXT
MemoryToImageCopyEXT
           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


-- | VkImageToMemoryCopyEXT - Structure specifying an image to host memory
-- copy operation
--
-- = Description
--
-- This structure is functionally similar to
-- 'Vulkan.Core13.Promoted_From_VK_KHR_copy_commands2.BufferImageCopy2',
-- except it defines host memory as the target of copy instead of a buffer.
-- In particular, the same data packing rules and restrictions as that
-- structure apply here as well.
--
-- == Valid Usage
--
-- -   #VUID-VkImageToMemoryCopyEXT-pHostPointer-09066# @pHostPointer@
--     /must/ point to memory that is large enough to contain all memory
--     locations that are accessed according to
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#copies-buffers-images-addressing Buffer and Image Addressing>,
--     for each element of @pRegions@
--
-- -   #VUID-VkImageToMemoryCopyEXT-pRegions-09067# The union of all source
--     regions, and the union of all destination regions, specified by the
--     elements of @pRegions@, /must/ not overlap in memory
--
-- -   #VUID-VkImageToMemoryCopyEXT-memoryRowLength-09101#
--     @memoryRowLength@ /must/ be @0@, or greater than or equal to the
--     @width@ member of @imageExtent@
--
-- -   #VUID-VkImageToMemoryCopyEXT-memoryImageHeight-09102#
--     @memoryImageHeight@ /must/ be @0@, or greater than or equal to the
--     @height@ member of @imageExtent@
--
-- -   #VUID-VkImageToMemoryCopyEXT-aspectMask-09103# The @aspectMask@
--     member of @imageSubresource@ /must/ only have a single bit set
--
-- -   #VUID-VkImageToMemoryCopyEXT-imageExtent-06659# @imageExtent.width@
--     /must/ not be 0
--
-- -   #VUID-VkImageToMemoryCopyEXT-imageExtent-06660# @imageExtent.height@
--     /must/ not be 0
--
-- -   #VUID-VkImageToMemoryCopyEXT-imageExtent-06661# @imageExtent.depth@
--     /must/ not be 0
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkImageToMemoryCopyEXT-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_IMAGE_TO_MEMORY_COPY_EXT'
--
-- -   #VUID-VkImageToMemoryCopyEXT-pNext-pNext# @pNext@ /must/ be @NULL@
--
-- -   #VUID-VkImageToMemoryCopyEXT-pHostPointer-parameter# @pHostPointer@
--     /must/ be a pointer value
--
-- -   #VUID-VkImageToMemoryCopyEXT-imageSubresource-parameter#
--     @imageSubresource@ /must/ be a valid
--     'Vulkan.Core10.CommandBufferBuilding.ImageSubresourceLayers'
--     structure
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_host_image_copy VK_EXT_host_image_copy>,
-- 'CopyImageToMemoryInfoEXT', 'Vulkan.Core10.FundamentalTypes.Extent3D',
-- 'Vulkan.Core10.CommandBufferBuilding.ImageSubresourceLayers',
-- 'Vulkan.Core10.FundamentalTypes.Offset3D',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data ImageToMemoryCopyEXT = ImageToMemoryCopyEXT
  { -- | @pHostPointer@ is the host memory address which is the destination of
    -- the copy.
    ImageToMemoryCopyEXT -> Ptr ()
hostPointer :: Ptr ()
  , -- | @memoryRowLength@ and @memoryImageHeight@ specify in texels a subregion
    -- of a larger two- or three-dimensional image in host memory, and control
    -- the addressing calculations. If either of these values is zero, that
    -- aspect of the host memory is considered to be tightly packed according
    -- to the @imageExtent@.
    ImageToMemoryCopyEXT -> Flags
memoryRowLength :: Word32
  , -- No documentation found for Nested "VkImageToMemoryCopyEXT" "memoryImageHeight"
    ImageToMemoryCopyEXT -> Flags
memoryImageHeight :: Word32
  , -- | @imageSubresource@ is a
    -- 'Vulkan.Core10.CommandBufferBuilding.ImageSubresourceLayers' used to
    -- specify the specific image subresources of the image used for the source
    -- or destination image data.
    ImageToMemoryCopyEXT -> ImageSubresourceLayers
imageSubresource :: ImageSubresourceLayers
  , -- | @imageOffset@ selects the initial @x@, @y@, @z@ offsets in texels of the
    -- sub-region of the source image data.
    ImageToMemoryCopyEXT -> Offset3D
imageOffset :: Offset3D
  , -- | @imageExtent@ is the size in texels of the image to copy in @width@,
    -- @height@ and @depth@.
    ImageToMemoryCopyEXT -> Extent3D
imageExtent :: Extent3D
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ImageToMemoryCopyEXT)
#endif
deriving instance Show ImageToMemoryCopyEXT

instance ToCStruct ImageToMemoryCopyEXT where
  withCStruct :: forall b.
ImageToMemoryCopyEXT -> (Ptr ImageToMemoryCopyEXT -> IO b) -> IO b
withCStruct ImageToMemoryCopyEXT
x Ptr ImageToMemoryCopyEXT -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
72 forall a b. (a -> b) -> a -> b
$ \Ptr ImageToMemoryCopyEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ImageToMemoryCopyEXT
p ImageToMemoryCopyEXT
x (Ptr ImageToMemoryCopyEXT -> IO b
f Ptr ImageToMemoryCopyEXT
p)
  pokeCStruct :: forall b.
Ptr ImageToMemoryCopyEXT -> ImageToMemoryCopyEXT -> IO b -> IO b
pokeCStruct Ptr ImageToMemoryCopyEXT
p ImageToMemoryCopyEXT{Flags
Ptr ()
ImageSubresourceLayers
Offset3D
Extent3D
imageExtent :: Extent3D
imageOffset :: Offset3D
imageSubresource :: ImageSubresourceLayers
memoryImageHeight :: Flags
memoryRowLength :: Flags
hostPointer :: Ptr ()
$sel:imageExtent:ImageToMemoryCopyEXT :: ImageToMemoryCopyEXT -> Extent3D
$sel:imageOffset:ImageToMemoryCopyEXT :: ImageToMemoryCopyEXT -> Offset3D
$sel:imageSubresource:ImageToMemoryCopyEXT :: ImageToMemoryCopyEXT -> ImageSubresourceLayers
$sel:memoryImageHeight:ImageToMemoryCopyEXT :: ImageToMemoryCopyEXT -> Flags
$sel:memoryRowLength:ImageToMemoryCopyEXT :: ImageToMemoryCopyEXT -> Flags
$sel:hostPointer:ImageToMemoryCopyEXT :: ImageToMemoryCopyEXT -> Ptr ()
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_TO_MEMORY_COPY_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
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 ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr ()))) (Ptr ()
hostPointer)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Flags
memoryRowLength)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (Flags
memoryImageHeight)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageSubresourceLayers)) (ImageSubresourceLayers
imageSubresource)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Offset3D)) (Offset3D
imageOffset)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Extent3D)) (Extent3D
imageExtent)
    IO b
f
  cStructSize :: Int
cStructSize = Int
72
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr ImageToMemoryCopyEXT -> IO b -> IO b
pokeZeroCStruct Ptr ImageToMemoryCopyEXT
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_TO_MEMORY_COPY_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
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 ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr ()))) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageSubresourceLayers)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Offset3D)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Extent3D)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct ImageToMemoryCopyEXT where
  peekCStruct :: Ptr ImageToMemoryCopyEXT -> IO ImageToMemoryCopyEXT
peekCStruct Ptr ImageToMemoryCopyEXT
p = do
    Ptr ()
pHostPointer <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr ())))
    Flags
memoryRowLength <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32))
    Flags
memoryImageHeight <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32))
    ImageSubresourceLayers
imageSubresource <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ImageSubresourceLayers ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageSubresourceLayers))
    Offset3D
imageOffset <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Offset3D ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Offset3D))
    Extent3D
imageExtent <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent3D ((Ptr ImageToMemoryCopyEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Extent3D))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Ptr ()
-> Flags
-> Flags
-> ImageSubresourceLayers
-> Offset3D
-> Extent3D
-> ImageToMemoryCopyEXT
ImageToMemoryCopyEXT
             Ptr ()
pHostPointer
             Flags
memoryRowLength
             Flags
memoryImageHeight
             ImageSubresourceLayers
imageSubresource
             Offset3D
imageOffset
             Extent3D
imageExtent

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

instance Zero ImageToMemoryCopyEXT where
  zero :: ImageToMemoryCopyEXT
zero = Ptr ()
-> Flags
-> Flags
-> ImageSubresourceLayers
-> Offset3D
-> Extent3D
-> ImageToMemoryCopyEXT
ImageToMemoryCopyEXT
           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


-- | VkCopyMemoryToImageInfoEXT - Structure specifying parameters of host
-- memory to image copy command
--
-- = Description
--
-- 'copyMemoryToImageEXT' does not check whether the device memory
-- associated with @dstImage@ is currently in use before performing the
-- copy. The application /must/ guarantee that any previously submitted
-- command that reads from or writes to the copy regions has completed
-- before the host performs the copy.
--
-- Copy regions for the image /must/ be aligned to a multiple of the texel
-- block extent in each dimension, except at the edges of the image, where
-- region extents /must/ match the edge of the image.
--
-- == Valid Usage
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-dstImage-09109# If @dstImage@ is
--     sparse then all memory ranges accessed by the copy command /must/ be
--     bound as described in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#sparsememory-resource-binding Binding Resource Memory>
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-dstImage-09111# If the stencil
--     aspect of @dstImage@ is accessed, and @dstImage@ was not created
--     with
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkImageStencilUsageCreateInfo separate stencil usage>,
--     @dstImage@ /must/ have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_HOST_TRANSFER_BIT_EXT'
--     set in 'Vulkan.Core10.Image.ImageCreateInfo'::@usage@
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-dstImage-09112# If the stencil
--     aspect of @dstImage@ is accessed, and @dstImage@ was created with
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkImageStencilUsageCreateInfo separate stencil usage>,
--     @dstImage@ /must/ have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_HOST_TRANSFER_BIT_EXT'
--     set in
--     'Vulkan.Core12.Promoted_From_VK_EXT_separate_stencil_usage.ImageStencilUsageCreateInfo'::@stencilUsage@
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-dstImage-09113# If non-stencil
--     aspects of @dstImage@ are accessed, @dstImage@ /must/ have been
--     created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_HOST_TRANSFER_BIT_EXT'
--     set in 'Vulkan.Core10.Image.ImageCreateInfo'::@usage@
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-imageOffset-09114# If @flags@
--     contains 'HOST_IMAGE_COPY_MEMCPY_EXT', the @x@, @y@, and @z@ members
--     of the @imageOffset@ member of each element of @pRegions@ /must/ be
--     @0@
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-dstImage-09115# If @flags@ contains
--     'HOST_IMAGE_COPY_MEMCPY_EXT', the @imageExtent@ member of each
--     element of @pRegions@ /must/ equal the extents of @dstImage@
--     identified by @imageSubresource@
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-dstImage-07966# If @dstImage@ is
--     non-sparse then the image or the specified /disjoint/ plane /must/
--     be bound completely and contiguously to a single
--     'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-imageSubresource-07967# The
--     @imageSubresource.mipLevel@ member of each element of @pRegions@
--     /must/ be less than the @mipLevels@ specified in
--     'Vulkan.Core10.Image.ImageCreateInfo' when @dstImage@ was created
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-imageSubresource-07968# If
--     @imageSubresource.layerCount@ is not
--     'Vulkan.Core10.APIConstants.REMAINING_ARRAY_LAYERS',
--     @imageSubresource.baseArrayLayer@ + @imageSubresource.layerCount@ of
--     each element of @pRegions@ /must/ be less than or equal to the
--     @arrayLayers@ specified in 'Vulkan.Core10.Image.ImageCreateInfo'
--     when @dstImage@ was created
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-dstImage-07969# @dstImage@ /must/
--     not have been created with @flags@ containing
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SUBSAMPLED_BIT_EXT'
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-imageSubresource-07970# The image
--     region specified by each element of @pRegions@ /must/ be contained
--     within the specified @imageSubresource@ of @dstImage@
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-imageSubresource-07971# For each
--     element of @pRegions@, @imageOffset.x@ and (@imageExtent.width@ +
--     @imageOffset.x@) /must/ both be greater than or equal to @0@ and
--     less than or equal to the width of the specified @imageSubresource@
--     of @dstImage@
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-imageSubresource-07972# For each
--     element of @pRegions@, @imageOffset.y@ and (@imageExtent.height@ +
--     @imageOffset.y@) /must/ both be greater than or equal to @0@ and
--     less than or equal to the height of the specified @imageSubresource@
--     of @dstImage@
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-dstImage-07973# @dstImage@ /must/
--     have a sample count equal to
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SAMPLE_COUNT_1_BIT'
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-dstImage-07979# If @dstImage@ is of
--     type 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_1D', then for each
--     element of @pRegions@, @imageOffset.y@ /must/ be @0@ and
--     @imageExtent.height@ /must/ be @1@
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-imageOffset-09104# For each element
--     of @pRegions@, @imageOffset.z@ and (@imageExtent.depth@ +
--     @imageOffset.z@) /must/ both be greater than or equal to @0@ and
--     less than or equal to the depth of the specified @imageSubresource@
--     of @dstImage@
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-dstImage-07980# If @dstImage@ is of
--     type 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_1D' or
--     'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_2D', then for each element
--     of @pRegions@, @imageOffset.z@ /must/ be @0@ and @imageExtent.depth@
--     /must/ be @1@
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-dstImage-07274# For each element of
--     @pRegions@, @imageOffset.x@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent width>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @dstImage@
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-dstImage-07275# For each element of
--     @pRegions@, @imageOffset.y@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent height>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @dstImage@
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-dstImage-07276# For each element of
--     @pRegions@, @imageOffset.z@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent depth>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @dstImage@
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-dstImage-00207# For each element of
--     @pRegions@, if the sum of @imageOffset.x@ and @extent.width@ does
--     not equal the width of the subresource specified by
--     @srcSubresource@, @extent.width@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent width>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @dstImage@
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-dstImage-00208# For each element of
--     @pRegions@, if the sum of @imageOffset.y@ and @extent.height@ does
--     not equal the height of the subresource specified by
--     @srcSubresource@, @extent.height@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent height>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @dstImage@
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-dstImage-00209# For each element of
--     @pRegions@, if the sum of @imageOffset.z@ and @extent.depth@ does
--     not equal the depth of the subresource specified by
--     @srcSubresource@, @extent.depth@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent depth>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @dstImage@
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-imageSubresource-09105# For each
--     element of @pRegions@, @imageSubresource.aspectMask@ /must/ specify
--     aspects present in @dstImage@
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-dstImage-07981# If @dstImage@ has a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion multi-planar image format>,
--     then for each element of @pRegions@, @imageSubresource.aspectMask@
--     /must/ be a single valid
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-planes-image-aspect multi-planar aspect mask>
--     bit
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-dstImage-07983# If @dstImage@ is of
--     type 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_3D', for each element
--     of @pRegions@, @imageSubresource.baseArrayLayer@ /must/ be @0@ and
--     @imageSubresource.layerCount@ /must/ be @1@
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-memoryRowLength-09106# For each
--     element of @pRegions@, @memoryRowLength@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent width>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @dstImage@
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-memoryImageHeight-09107# For each
--     element of @pRegions@, @memoryImageHeight@ /must/ be a multiple of
--     the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent height>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @dstImage@
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-memoryRowLength-09108# For each
--     element of @pRegions@, @memoryRowLength@ divided by the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent width>
--     and then multiplied by the texel block size of @dstImage@ /must/ be
--     less than or equal to 231-1
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-dstImageLayout-09059#
--     @dstImageLayout@ /must/ specify the current layout of the image
--     subresources of @dstImage@ specified in @pRegions@
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-dstImageLayout-09060#
--     @dstImageLayout@ /must/ be one of the image layouts returned in
--     'PhysicalDeviceHostImageCopyPropertiesEXT'::@pCopyDstLayouts@
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-flags-09393# If @flags@ includes
--     'HOST_IMAGE_COPY_MEMCPY_EXT', for each region in @pRegions@,
--     @memoryRowLength@ and @memoryImageHeight@ /must/ both be 0
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_COPY_MEMORY_TO_IMAGE_INFO_EXT'
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-pNext-pNext# @pNext@ /must/ be
--     @NULL@
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-flags-parameter# @flags@ /must/ be
--     a valid combination of 'HostImageCopyFlagBitsEXT' values
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-dstImage-parameter# @dstImage@
--     /must/ be a valid 'Vulkan.Core10.Handles.Image' handle
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-dstImageLayout-parameter#
--     @dstImageLayout@ /must/ be a valid
--     'Vulkan.Core10.Enums.ImageLayout.ImageLayout' value
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-pRegions-parameter# @pRegions@
--     /must/ be a valid pointer to an array of @regionCount@ valid
--     'MemoryToImageCopyEXT' structures
--
-- -   #VUID-VkCopyMemoryToImageInfoEXT-regionCount-arraylength#
--     @regionCount@ /must/ be greater than @0@
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_host_image_copy VK_EXT_host_image_copy>,
-- 'HostImageCopyFlagsEXT', 'Vulkan.Core10.Handles.Image',
-- 'Vulkan.Core10.Enums.ImageLayout.ImageLayout', 'MemoryToImageCopyEXT',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'copyMemoryToImageEXT'
data CopyMemoryToImageInfoEXT = CopyMemoryToImageInfoEXT
  { -- | @flags@ is a bitmask of 'HostImageCopyFlagBitsEXT' values describing
    -- additional copy parameters.
    CopyMemoryToImageInfoEXT -> HostImageCopyFlagBitsEXT
flags :: HostImageCopyFlagsEXT
  , -- | @dstImage@ is the destination image.
    CopyMemoryToImageInfoEXT -> Image
dstImage :: Image
  , -- | @dstImageLayout@ is the layout of the destination image subresources for
    -- the copy.
    CopyMemoryToImageInfoEXT -> ImageLayout
dstImageLayout :: ImageLayout
  , -- | @pRegions@ is a pointer to an array of 'MemoryToImageCopyEXT' structures
    -- specifying the regions to copy.
    CopyMemoryToImageInfoEXT -> Vector MemoryToImageCopyEXT
regions :: Vector MemoryToImageCopyEXT
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CopyMemoryToImageInfoEXT)
#endif
deriving instance Show CopyMemoryToImageInfoEXT

instance ToCStruct CopyMemoryToImageInfoEXT where
  withCStruct :: forall b.
CopyMemoryToImageInfoEXT
-> (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT)
    -> IO b)
-> IO b
withCStruct CopyMemoryToImageInfoEXT
x ("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
48 forall a b. (a -> b) -> a -> b
$ \"pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p CopyMemoryToImageInfoEXT
x (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT) -> IO b
f "pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p)
  pokeCStruct :: forall b.
("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT)
-> CopyMemoryToImageInfoEXT -> IO b -> IO b
pokeCStruct "pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p CopyMemoryToImageInfoEXT{Vector MemoryToImageCopyEXT
ImageLayout
Image
HostImageCopyFlagBitsEXT
regions :: Vector MemoryToImageCopyEXT
dstImageLayout :: ImageLayout
dstImage :: Image
flags :: HostImageCopyFlagBitsEXT
$sel:regions:CopyMemoryToImageInfoEXT :: CopyMemoryToImageInfoEXT -> Vector MemoryToImageCopyEXT
$sel:dstImageLayout:CopyMemoryToImageInfoEXT :: CopyMemoryToImageInfoEXT -> ImageLayout
$sel:dstImage:CopyMemoryToImageInfoEXT :: CopyMemoryToImageInfoEXT -> Image
$sel:flags:CopyMemoryToImageInfoEXT :: CopyMemoryToImageInfoEXT -> HostImageCopyFlagBitsEXT
..} 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 (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COPY_MEMORY_TO_IMAGE_INFO_EXT)
    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 (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    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 (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr HostImageCopyFlagsEXT)) (HostImageCopyFlagBitsEXT
flags)
    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 (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Image)) (Image
dstImage)
    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 (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageLayout)) (ImageLayout
dstImageLayout)
    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 (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32)) ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector MemoryToImageCopyEXT
regions)) :: Word32))
    Ptr MemoryToImageCopyEXT
pPRegions' <- 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 a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @MemoryToImageCopyEXT ((forall a. Vector a -> Int
Data.Vector.length (Vector MemoryToImageCopyEXT
regions)) forall a. Num a => a -> a -> a
* Int
72)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i MemoryToImageCopyEXT
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr MemoryToImageCopyEXT
pPRegions' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
72 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MemoryToImageCopyEXT) (MemoryToImageCopyEXT
e)) (Vector MemoryToImageCopyEXT
regions)
    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 (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr MemoryToImageCopyEXT))) (Ptr MemoryToImageCopyEXT
pPRegions')
    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
48
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT)
-> IO b -> IO b
pokeZeroCStruct "pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COPY_MEMORY_TO_IMAGE_INFO_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
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 (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Image)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageLayout)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct CopyMemoryToImageInfoEXT where
  peekCStruct :: ("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT)
-> IO CopyMemoryToImageInfoEXT
peekCStruct "pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p = do
    HostImageCopyFlagBitsEXT
flags <- forall a. Storable a => Ptr a -> IO a
peek @HostImageCopyFlagsEXT (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr HostImageCopyFlagsEXT))
    Image
dstImage <- forall a. Storable a => Ptr a -> IO a
peek @Image (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Image))
    ImageLayout
dstImageLayout <- forall a. Storable a => Ptr a -> IO a
peek @ImageLayout (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageLayout))
    Flags
regionCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32))
    Ptr MemoryToImageCopyEXT
pRegions <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr MemoryToImageCopyEXT) (("pCopyMemoryToImageInfo" ::: Ptr CopyMemoryToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr MemoryToImageCopyEXT)))
    Vector MemoryToImageCopyEXT
pRegions' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Flags
regionCount) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @MemoryToImageCopyEXT ((Ptr MemoryToImageCopyEXT
pRegions forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
72 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MemoryToImageCopyEXT)))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ HostImageCopyFlagBitsEXT
-> Image
-> ImageLayout
-> Vector MemoryToImageCopyEXT
-> CopyMemoryToImageInfoEXT
CopyMemoryToImageInfoEXT
             HostImageCopyFlagBitsEXT
flags Image
dstImage ImageLayout
dstImageLayout Vector MemoryToImageCopyEXT
pRegions'

instance Zero CopyMemoryToImageInfoEXT where
  zero :: CopyMemoryToImageInfoEXT
zero = HostImageCopyFlagBitsEXT
-> Image
-> ImageLayout
-> Vector MemoryToImageCopyEXT
-> CopyMemoryToImageInfoEXT
CopyMemoryToImageInfoEXT
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Monoid a => a
mempty


-- | VkCopyImageToMemoryInfoEXT - Structure specifying parameters of an image
-- to host memory copy command
--
-- = Description
--
-- 'copyImageToMemoryEXT' does not check whether the device memory
-- associated with @srcImage@ is currently in use before performing the
-- copy. The application /must/ guarantee that any previously submitted
-- command that writes to the copy regions has completed before the host
-- performs the copy.
--
-- Copy regions for the image /must/ be aligned to a multiple of the texel
-- block extent in each dimension, except at the edges of the image, where
-- region extents /must/ match the edge of the image.
--
-- == Valid Usage
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-srcImage-09109# If @srcImage@ is
--     sparse then all memory ranges accessed by the copy command /must/ be
--     bound as described in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#sparsememory-resource-binding Binding Resource Memory>
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-srcImage-09111# If the stencil
--     aspect of @srcImage@ is accessed, and @srcImage@ was not created
--     with
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkImageStencilUsageCreateInfo separate stencil usage>,
--     @srcImage@ /must/ have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_HOST_TRANSFER_BIT_EXT'
--     set in 'Vulkan.Core10.Image.ImageCreateInfo'::@usage@
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-srcImage-09112# If the stencil
--     aspect of @srcImage@ is accessed, and @srcImage@ was created with
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkImageStencilUsageCreateInfo separate stencil usage>,
--     @srcImage@ /must/ have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_HOST_TRANSFER_BIT_EXT'
--     set in
--     'Vulkan.Core12.Promoted_From_VK_EXT_separate_stencil_usage.ImageStencilUsageCreateInfo'::@stencilUsage@
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-srcImage-09113# If non-stencil
--     aspects of @srcImage@ are accessed, @srcImage@ /must/ have been
--     created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_HOST_TRANSFER_BIT_EXT'
--     set in 'Vulkan.Core10.Image.ImageCreateInfo'::@usage@
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-imageOffset-09114# If @flags@
--     contains 'HOST_IMAGE_COPY_MEMCPY_EXT', the @x@, @y@, and @z@ members
--     of the @imageOffset@ member of each element of @pRegions@ /must/ be
--     @0@
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-srcImage-09115# If @flags@ contains
--     'HOST_IMAGE_COPY_MEMCPY_EXT', the @imageExtent@ member of each
--     element of @pRegions@ /must/ equal the extents of @srcImage@
--     identified by @imageSubresource@
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-srcImage-07966# If @srcImage@ is
--     non-sparse then the image or the specified /disjoint/ plane /must/
--     be bound completely and contiguously to a single
--     'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-imageSubresource-07967# The
--     @imageSubresource.mipLevel@ member of each element of @pRegions@
--     /must/ be less than the @mipLevels@ specified in
--     'Vulkan.Core10.Image.ImageCreateInfo' when @srcImage@ was created
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-imageSubresource-07968# If
--     @imageSubresource.layerCount@ is not
--     'Vulkan.Core10.APIConstants.REMAINING_ARRAY_LAYERS',
--     @imageSubresource.baseArrayLayer@ + @imageSubresource.layerCount@ of
--     each element of @pRegions@ /must/ be less than or equal to the
--     @arrayLayers@ specified in 'Vulkan.Core10.Image.ImageCreateInfo'
--     when @srcImage@ was created
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-srcImage-07969# @srcImage@ /must/
--     not have been created with @flags@ containing
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SUBSAMPLED_BIT_EXT'
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-imageSubresource-07970# The image
--     region specified by each element of @pRegions@ /must/ be contained
--     within the specified @imageSubresource@ of @srcImage@
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-imageSubresource-07971# For each
--     element of @pRegions@, @imageOffset.x@ and (@imageExtent.width@ +
--     @imageOffset.x@) /must/ both be greater than or equal to @0@ and
--     less than or equal to the width of the specified @imageSubresource@
--     of @srcImage@
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-imageSubresource-07972# For each
--     element of @pRegions@, @imageOffset.y@ and (@imageExtent.height@ +
--     @imageOffset.y@) /must/ both be greater than or equal to @0@ and
--     less than or equal to the height of the specified @imageSubresource@
--     of @srcImage@
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-srcImage-07973# @srcImage@ /must/
--     have a sample count equal to
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SAMPLE_COUNT_1_BIT'
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-srcImage-07979# If @srcImage@ is of
--     type 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_1D', then for each
--     element of @pRegions@, @imageOffset.y@ /must/ be @0@ and
--     @imageExtent.height@ /must/ be @1@
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-imageOffset-09104# For each element
--     of @pRegions@, @imageOffset.z@ and (@imageExtent.depth@ +
--     @imageOffset.z@) /must/ both be greater than or equal to @0@ and
--     less than or equal to the depth of the specified @imageSubresource@
--     of @srcImage@
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-srcImage-07980# If @srcImage@ is of
--     type 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_1D' or
--     'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_2D', then for each element
--     of @pRegions@, @imageOffset.z@ /must/ be @0@ and @imageExtent.depth@
--     /must/ be @1@
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-srcImage-07274# For each element of
--     @pRegions@, @imageOffset.x@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent width>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @srcImage@
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-srcImage-07275# For each element of
--     @pRegions@, @imageOffset.y@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent height>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @srcImage@
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-srcImage-07276# For each element of
--     @pRegions@, @imageOffset.z@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent depth>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @srcImage@
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-srcImage-00207# For each element of
--     @pRegions@, if the sum of @imageOffset.x@ and @extent.width@ does
--     not equal the width of the subresource specified by
--     @srcSubresource@, @extent.width@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent width>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @srcImage@
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-srcImage-00208# For each element of
--     @pRegions@, if the sum of @imageOffset.y@ and @extent.height@ does
--     not equal the height of the subresource specified by
--     @srcSubresource@, @extent.height@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent height>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @srcImage@
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-srcImage-00209# For each element of
--     @pRegions@, if the sum of @imageOffset.z@ and @extent.depth@ does
--     not equal the depth of the subresource specified by
--     @srcSubresource@, @extent.depth@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent depth>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @srcImage@
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-imageSubresource-09105# For each
--     element of @pRegions@, @imageSubresource.aspectMask@ /must/ specify
--     aspects present in @srcImage@
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-srcImage-07981# If @srcImage@ has a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion multi-planar image format>,
--     then for each element of @pRegions@, @imageSubresource.aspectMask@
--     /must/ be a single valid
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-planes-image-aspect multi-planar aspect mask>
--     bit
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-srcImage-07983# If @srcImage@ is of
--     type 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_3D', for each element
--     of @pRegions@, @imageSubresource.baseArrayLayer@ /must/ be @0@ and
--     @imageSubresource.layerCount@ /must/ be @1@
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-memoryRowLength-09106# For each
--     element of @pRegions@, @memoryRowLength@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent width>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @srcImage@
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-memoryImageHeight-09107# For each
--     element of @pRegions@, @memoryImageHeight@ /must/ be a multiple of
--     the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent height>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @srcImage@
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-memoryRowLength-09108# For each
--     element of @pRegions@, @memoryRowLength@ divided by the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent width>
--     and then multiplied by the texel block size of @srcImage@ /must/ be
--     less than or equal to 231-1
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-srcImageLayout-09064#
--     @srcImageLayout@ /must/ specify the current layout of the image
--     subresources of @srcImage@ specified in @pRegions@
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-srcImageLayout-09065#
--     @srcImageLayout@ /must/ be one of the image layouts returned in
--     'PhysicalDeviceHostImageCopyPropertiesEXT'::@pCopySrcLayouts@
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-flags-09394# If @flags@ includes
--     'HOST_IMAGE_COPY_MEMCPY_EXT', for each region in @pRegions@,
--     @memoryRowLength@ and @memoryImageHeight@ /must/ both be 0
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_COPY_IMAGE_TO_MEMORY_INFO_EXT'
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-pNext-pNext# @pNext@ /must/ be
--     @NULL@
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-flags-parameter# @flags@ /must/ be
--     a valid combination of 'HostImageCopyFlagBitsEXT' values
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-srcImage-parameter# @srcImage@
--     /must/ be a valid 'Vulkan.Core10.Handles.Image' handle
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-srcImageLayout-parameter#
--     @srcImageLayout@ /must/ be a valid
--     'Vulkan.Core10.Enums.ImageLayout.ImageLayout' value
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-pRegions-parameter# @pRegions@
--     /must/ be a valid pointer to an array of @regionCount@ valid
--     'ImageToMemoryCopyEXT' structures
--
-- -   #VUID-VkCopyImageToMemoryInfoEXT-regionCount-arraylength#
--     @regionCount@ /must/ be greater than @0@
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_host_image_copy VK_EXT_host_image_copy>,
-- 'HostImageCopyFlagsEXT', 'Vulkan.Core10.Handles.Image',
-- 'Vulkan.Core10.Enums.ImageLayout.ImageLayout', 'ImageToMemoryCopyEXT',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'copyImageToMemoryEXT'
data CopyImageToMemoryInfoEXT = CopyImageToMemoryInfoEXT
  { -- | @flags@ is a bitmask of 'HostImageCopyFlagBitsEXT' values describing
    -- additional copy parameters.
    CopyImageToMemoryInfoEXT -> HostImageCopyFlagBitsEXT
flags :: HostImageCopyFlagsEXT
  , -- | @srcImage@ is the source image.
    CopyImageToMemoryInfoEXT -> Image
srcImage :: Image
  , -- | @srcImageLayout@ is the layout of the source image subresources for the
    -- copy.
    CopyImageToMemoryInfoEXT -> ImageLayout
srcImageLayout :: ImageLayout
  , -- | @pRegions@ is a pointer to an array of 'ImageToMemoryCopyEXT' structures
    -- specifying the regions to copy.
    CopyImageToMemoryInfoEXT -> Vector ImageToMemoryCopyEXT
regions :: Vector ImageToMemoryCopyEXT
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CopyImageToMemoryInfoEXT)
#endif
deriving instance Show CopyImageToMemoryInfoEXT

instance ToCStruct CopyImageToMemoryInfoEXT where
  withCStruct :: forall b.
CopyImageToMemoryInfoEXT
-> (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT)
    -> IO b)
-> IO b
withCStruct CopyImageToMemoryInfoEXT
x ("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
48 forall a b. (a -> b) -> a -> b
$ \"pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p CopyImageToMemoryInfoEXT
x (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT) -> IO b
f "pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p)
  pokeCStruct :: forall b.
("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT)
-> CopyImageToMemoryInfoEXT -> IO b -> IO b
pokeCStruct "pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p CopyImageToMemoryInfoEXT{Vector ImageToMemoryCopyEXT
ImageLayout
Image
HostImageCopyFlagBitsEXT
regions :: Vector ImageToMemoryCopyEXT
srcImageLayout :: ImageLayout
srcImage :: Image
flags :: HostImageCopyFlagBitsEXT
$sel:regions:CopyImageToMemoryInfoEXT :: CopyImageToMemoryInfoEXT -> Vector ImageToMemoryCopyEXT
$sel:srcImageLayout:CopyImageToMemoryInfoEXT :: CopyImageToMemoryInfoEXT -> ImageLayout
$sel:srcImage:CopyImageToMemoryInfoEXT :: CopyImageToMemoryInfoEXT -> Image
$sel:flags:CopyImageToMemoryInfoEXT :: CopyImageToMemoryInfoEXT -> HostImageCopyFlagBitsEXT
..} 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 (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COPY_IMAGE_TO_MEMORY_INFO_EXT)
    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 (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    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 (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr HostImageCopyFlagsEXT)) (HostImageCopyFlagBitsEXT
flags)
    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 (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Image)) (Image
srcImage)
    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 (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageLayout)) (ImageLayout
srcImageLayout)
    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 (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32)) ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector ImageToMemoryCopyEXT
regions)) :: Word32))
    Ptr ImageToMemoryCopyEXT
pPRegions' <- 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 a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @ImageToMemoryCopyEXT ((forall a. Vector a -> Int
Data.Vector.length (Vector ImageToMemoryCopyEXT
regions)) forall a. Num a => a -> a -> a
* Int
72)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i ImageToMemoryCopyEXT
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ImageToMemoryCopyEXT
pPRegions' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
72 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr ImageToMemoryCopyEXT) (ImageToMemoryCopyEXT
e)) (Vector ImageToMemoryCopyEXT
regions)
    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 (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr ImageToMemoryCopyEXT))) (Ptr ImageToMemoryCopyEXT
pPRegions')
    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
48
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT)
-> IO b -> IO b
pokeZeroCStruct "pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COPY_IMAGE_TO_MEMORY_INFO_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
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 (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Image)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageLayout)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct CopyImageToMemoryInfoEXT where
  peekCStruct :: ("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT)
-> IO CopyImageToMemoryInfoEXT
peekCStruct "pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p = do
    HostImageCopyFlagBitsEXT
flags <- forall a. Storable a => Ptr a -> IO a
peek @HostImageCopyFlagsEXT (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr HostImageCopyFlagsEXT))
    Image
srcImage <- forall a. Storable a => Ptr a -> IO a
peek @Image (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Image))
    ImageLayout
srcImageLayout <- forall a. Storable a => Ptr a -> IO a
peek @ImageLayout (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageLayout))
    Flags
regionCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32))
    Ptr ImageToMemoryCopyEXT
pRegions <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ImageToMemoryCopyEXT) (("pCopyImageToMemoryInfo" ::: Ptr CopyImageToMemoryInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr ImageToMemoryCopyEXT)))
    Vector ImageToMemoryCopyEXT
pRegions' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Flags
regionCount) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ImageToMemoryCopyEXT ((Ptr ImageToMemoryCopyEXT
pRegions forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
72 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr ImageToMemoryCopyEXT)))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ HostImageCopyFlagBitsEXT
-> Image
-> ImageLayout
-> Vector ImageToMemoryCopyEXT
-> CopyImageToMemoryInfoEXT
CopyImageToMemoryInfoEXT
             HostImageCopyFlagBitsEXT
flags Image
srcImage ImageLayout
srcImageLayout Vector ImageToMemoryCopyEXT
pRegions'

instance Zero CopyImageToMemoryInfoEXT where
  zero :: CopyImageToMemoryInfoEXT
zero = HostImageCopyFlagBitsEXT
-> Image
-> ImageLayout
-> Vector ImageToMemoryCopyEXT
-> CopyImageToMemoryInfoEXT
CopyImageToMemoryInfoEXT
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Monoid a => a
mempty


-- | VkCopyImageToImageInfoEXT - Structure specifying parameters of an image
-- to image host copy command
--
-- = Description
--
-- 'copyImageToImageEXT' does not check whether the device memory
-- associated with @srcImage@ or @dstImage@ is currently in use before
-- performing the copy. The application /must/ guarantee that any
-- previously submitted command that writes to the copy regions has
-- completed before the host performs the copy.
--
-- == Valid Usage
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcImage-09069# @srcImage@ and
--     @dstImage@ /must/ have been created with identical image creation
--     parameters
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcImage-09109# If @srcImage@ is
--     sparse then all memory ranges accessed by the copy command /must/ be
--     bound as described in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#sparsememory-resource-binding Binding Resource Memory>
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcImage-09111# If the stencil
--     aspect of @srcImage@ is accessed, and @srcImage@ was not created
--     with
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkImageStencilUsageCreateInfo separate stencil usage>,
--     @srcImage@ /must/ have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_HOST_TRANSFER_BIT_EXT'
--     set in 'Vulkan.Core10.Image.ImageCreateInfo'::@usage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcImage-09112# If the stencil
--     aspect of @srcImage@ is accessed, and @srcImage@ was created with
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkImageStencilUsageCreateInfo separate stencil usage>,
--     @srcImage@ /must/ have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_HOST_TRANSFER_BIT_EXT'
--     set in
--     'Vulkan.Core12.Promoted_From_VK_EXT_separate_stencil_usage.ImageStencilUsageCreateInfo'::@stencilUsage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcImage-09113# If non-stencil
--     aspects of @srcImage@ are accessed, @srcImage@ /must/ have been
--     created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_HOST_TRANSFER_BIT_EXT'
--     set in 'Vulkan.Core10.Image.ImageCreateInfo'::@usage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcOffset-09114# If @flags@ contains
--     'HOST_IMAGE_COPY_MEMCPY_EXT', the @x@, @y@, and @z@ members of the
--     @srcOffset@ member of each element of @pRegions@ /must/ be @0@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcImage-09115# If @flags@ contains
--     'HOST_IMAGE_COPY_MEMCPY_EXT', the @extent@ member of each element of
--     @pRegions@ /must/ equal the extents of @srcImage@ identified by
--     @srcSubresource@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcImage-07966# If @srcImage@ is
--     non-sparse then the image or the specified /disjoint/ plane /must/
--     be bound completely and contiguously to a single
--     'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcSubresource-07967# The
--     @srcSubresource.mipLevel@ member of each element of @pRegions@
--     /must/ be less than the @mipLevels@ specified in
--     'Vulkan.Core10.Image.ImageCreateInfo' when @srcImage@ was created
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcSubresource-07968# If
--     @srcSubresource.layerCount@ is not
--     'Vulkan.Core10.APIConstants.REMAINING_ARRAY_LAYERS',
--     @srcSubresource.baseArrayLayer@ + @srcSubresource.layerCount@ of
--     each element of @pRegions@ /must/ be less than or equal to the
--     @arrayLayers@ specified in 'Vulkan.Core10.Image.ImageCreateInfo'
--     when @srcImage@ was created
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcImage-07969# @srcImage@ /must/
--     not have been created with @flags@ containing
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SUBSAMPLED_BIT_EXT'
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcSubresource-07970# The image
--     region specified by each element of @pRegions@ /must/ be contained
--     within the specified @srcSubresource@ of @srcImage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcSubresource-07971# For each
--     element of @pRegions@, @srcOffset.x@ and (@extent.width@ +
--     @srcOffset.x@) /must/ both be greater than or equal to @0@ and less
--     than or equal to the width of the specified @srcSubresource@ of
--     @srcImage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcSubresource-07972# For each
--     element of @pRegions@, @srcOffset.y@ and (@extent.height@ +
--     @srcOffset.y@) /must/ both be greater than or equal to @0@ and less
--     than or equal to the height of the specified @srcSubresource@ of
--     @srcImage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcImage-07979# If @srcImage@ is of
--     type 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_1D', then for each
--     element of @pRegions@, @srcOffset.y@ /must/ be @0@ and
--     @extent.height@ /must/ be @1@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcOffset-09104# For each element of
--     @pRegions@, @srcOffset.z@ and (@extent.depth@ + @srcOffset.z@)
--     /must/ both be greater than or equal to @0@ and less than or equal
--     to the depth of the specified @srcSubresource@ of @srcImage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcImage-07980# If @srcImage@ is of
--     type 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_1D' or
--     'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_2D', then for each element
--     of @pRegions@, @srcOffset.z@ /must/ be @0@ and @extent.depth@ /must/
--     be @1@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcImage-07274# For each element of
--     @pRegions@, @srcOffset.x@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent width>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @srcImage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcImage-07275# For each element of
--     @pRegions@, @srcOffset.y@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent height>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @srcImage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcImage-07276# For each element of
--     @pRegions@, @srcOffset.z@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent depth>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @srcImage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcImage-00207# For each element of
--     @pRegions@, if the sum of @srcOffset.x@ and @extent.width@ does not
--     equal the width of the subresource specified by @srcSubresource@,
--     @extent.width@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent width>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @srcImage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcImage-00208# For each element of
--     @pRegions@, if the sum of @srcOffset.y@ and @extent.height@ does not
--     equal the height of the subresource specified by @srcSubresource@,
--     @extent.height@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent height>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @srcImage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcImage-00209# For each element of
--     @pRegions@, if the sum of @srcOffset.z@ and @extent.depth@ does not
--     equal the depth of the subresource specified by @srcSubresource@,
--     @extent.depth@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent depth>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @srcImage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcSubresource-09105# For each
--     element of @pRegions@, @srcSubresource.aspectMask@ /must/ specify
--     aspects present in @srcImage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcImage-07981# If @srcImage@ has a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion multi-planar image format>,
--     then for each element of @pRegions@, @srcSubresource.aspectMask@
--     /must/ be a single valid
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-planes-image-aspect multi-planar aspect mask>
--     bit
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcImage-07983# If @srcImage@ is of
--     type 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_3D', for each element
--     of @pRegions@, @srcSubresource.baseArrayLayer@ /must/ be @0@ and
--     @srcSubresource.layerCount@ /must/ be @1@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstImage-09109# If @dstImage@ is
--     sparse then all memory ranges accessed by the copy command /must/ be
--     bound as described in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#sparsememory-resource-binding Binding Resource Memory>
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstImage-09111# If the stencil
--     aspect of @dstImage@ is accessed, and @dstImage@ was not created
--     with
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkImageStencilUsageCreateInfo separate stencil usage>,
--     @dstImage@ /must/ have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_HOST_TRANSFER_BIT_EXT'
--     set in 'Vulkan.Core10.Image.ImageCreateInfo'::@usage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstImage-09112# If the stencil
--     aspect of @dstImage@ is accessed, and @dstImage@ was created with
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkImageStencilUsageCreateInfo separate stencil usage>,
--     @dstImage@ /must/ have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_HOST_TRANSFER_BIT_EXT'
--     set in
--     'Vulkan.Core12.Promoted_From_VK_EXT_separate_stencil_usage.ImageStencilUsageCreateInfo'::@stencilUsage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstImage-09113# If non-stencil
--     aspects of @dstImage@ are accessed, @dstImage@ /must/ have been
--     created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_HOST_TRANSFER_BIT_EXT'
--     set in 'Vulkan.Core10.Image.ImageCreateInfo'::@usage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstOffset-09114# If @flags@ contains
--     'HOST_IMAGE_COPY_MEMCPY_EXT', the @x@, @y@, and @z@ members of the
--     @dstOffset@ member of each element of @pRegions@ /must/ be @0@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstImage-09115# If @flags@ contains
--     'HOST_IMAGE_COPY_MEMCPY_EXT', the @extent@ member of each element of
--     @pRegions@ /must/ equal the extents of @dstImage@ identified by
--     @dstSubresource@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstImage-07966# If @dstImage@ is
--     non-sparse then the image or the specified /disjoint/ plane /must/
--     be bound completely and contiguously to a single
--     'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstSubresource-07967# The
--     @dstSubresource.mipLevel@ member of each element of @pRegions@
--     /must/ be less than the @mipLevels@ specified in
--     'Vulkan.Core10.Image.ImageCreateInfo' when @dstImage@ was created
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstSubresource-07968# If
--     @dstSubresource.layerCount@ is not
--     'Vulkan.Core10.APIConstants.REMAINING_ARRAY_LAYERS',
--     @dstSubresource.baseArrayLayer@ + @dstSubresource.layerCount@ of
--     each element of @pRegions@ /must/ be less than or equal to the
--     @arrayLayers@ specified in 'Vulkan.Core10.Image.ImageCreateInfo'
--     when @dstImage@ was created
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstImage-07969# @dstImage@ /must/
--     not have been created with @flags@ containing
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SUBSAMPLED_BIT_EXT'
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstSubresource-07970# The image
--     region specified by each element of @pRegions@ /must/ be contained
--     within the specified @dstSubresource@ of @dstImage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstSubresource-07971# For each
--     element of @pRegions@, @dstOffset.x@ and (@extent.width@ +
--     @dstOffset.x@) /must/ both be greater than or equal to @0@ and less
--     than or equal to the width of the specified @dstSubresource@ of
--     @dstImage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstSubresource-07972# For each
--     element of @pRegions@, @dstOffset.y@ and (@extent.height@ +
--     @dstOffset.y@) /must/ both be greater than or equal to @0@ and less
--     than or equal to the height of the specified @dstSubresource@ of
--     @dstImage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstImage-07979# If @dstImage@ is of
--     type 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_1D', then for each
--     element of @pRegions@, @dstOffset.y@ /must/ be @0@ and
--     @extent.height@ /must/ be @1@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstOffset-09104# For each element of
--     @pRegions@, @dstOffset.z@ and (@extent.depth@ + @dstOffset.z@)
--     /must/ both be greater than or equal to @0@ and less than or equal
--     to the depth of the specified @dstSubresource@ of @dstImage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstImage-07980# If @dstImage@ is of
--     type 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_1D' or
--     'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_2D', then for each element
--     of @pRegions@, @dstOffset.z@ /must/ be @0@ and @extent.depth@ /must/
--     be @1@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstImage-07274# For each element of
--     @pRegions@, @dstOffset.x@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent width>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @dstImage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstImage-07275# For each element of
--     @pRegions@, @dstOffset.y@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent height>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @dstImage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstImage-07276# For each element of
--     @pRegions@, @dstOffset.z@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent depth>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @dstImage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstImage-00207# For each element of
--     @pRegions@, if the sum of @dstOffset.x@ and @extent.width@ does not
--     equal the width of the subresource specified by @srcSubresource@,
--     @extent.width@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent width>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @dstImage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstImage-00208# For each element of
--     @pRegions@, if the sum of @dstOffset.y@ and @extent.height@ does not
--     equal the height of the subresource specified by @srcSubresource@,
--     @extent.height@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent height>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @dstImage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstImage-00209# For each element of
--     @pRegions@, if the sum of @dstOffset.z@ and @extent.depth@ does not
--     equal the depth of the subresource specified by @srcSubresource@,
--     @extent.depth@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block extent depth>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @dstImage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstSubresource-09105# For each
--     element of @pRegions@, @dstSubresource.aspectMask@ /must/ specify
--     aspects present in @dstImage@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstImage-07981# If @dstImage@ has a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion multi-planar image format>,
--     then for each element of @pRegions@, @dstSubresource.aspectMask@
--     /must/ be a single valid
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-planes-image-aspect multi-planar aspect mask>
--     bit
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstImage-07983# If @dstImage@ is of
--     type 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_3D', for each element
--     of @pRegions@, @dstSubresource.baseArrayLayer@ /must/ be @0@ and
--     @dstSubresource.layerCount@ /must/ be @1@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcImageLayout-09070#
--     @srcImageLayout@ /must/ specify the current layout of the image
--     subresources of @srcImage@ specified in @pRegions@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstImageLayout-09071#
--     @dstImageLayout@ /must/ specify the current layout of the image
--     subresources of @dstImage@ specified in @pRegions@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcImageLayout-09072#
--     @srcImageLayout@ /must/ be one of the image layouts returned in
--     'PhysicalDeviceHostImageCopyPropertiesEXT'::@pCopySrcLayouts@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstImageLayout-09073#
--     @dstImageLayout@ /must/ be one of the image layouts returned in
--     'PhysicalDeviceHostImageCopyPropertiesEXT'::@pCopyDstLayouts@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkCopyImageToImageInfoEXT-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_COPY_IMAGE_TO_IMAGE_INFO_EXT'
--
-- -   #VUID-VkCopyImageToImageInfoEXT-pNext-pNext# @pNext@ /must/ be
--     @NULL@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-flags-parameter# @flags@ /must/ be a
--     valid combination of 'HostImageCopyFlagBitsEXT' values
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcImage-parameter# @srcImage@
--     /must/ be a valid 'Vulkan.Core10.Handles.Image' handle
--
-- -   #VUID-VkCopyImageToImageInfoEXT-srcImageLayout-parameter#
--     @srcImageLayout@ /must/ be a valid
--     'Vulkan.Core10.Enums.ImageLayout.ImageLayout' value
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstImage-parameter# @dstImage@
--     /must/ be a valid 'Vulkan.Core10.Handles.Image' handle
--
-- -   #VUID-VkCopyImageToImageInfoEXT-dstImageLayout-parameter#
--     @dstImageLayout@ /must/ be a valid
--     'Vulkan.Core10.Enums.ImageLayout.ImageLayout' value
--
-- -   #VUID-VkCopyImageToImageInfoEXT-pRegions-parameter# @pRegions@
--     /must/ be a valid pointer to an array of @regionCount@ valid
--     'Vulkan.Core13.Promoted_From_VK_KHR_copy_commands2.ImageCopy2'
--     structures
--
-- -   #VUID-VkCopyImageToImageInfoEXT-regionCount-arraylength#
--     @regionCount@ /must/ be greater than @0@
--
-- -   #VUID-VkCopyImageToImageInfoEXT-commonparent# Both of @dstImage@,
--     and @srcImage@ /must/ have been created, allocated, or retrieved
--     from the same 'Vulkan.Core10.Handles.Device'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_host_image_copy VK_EXT_host_image_copy>,
-- 'HostImageCopyFlagsEXT', 'Vulkan.Core10.Handles.Image',
-- 'Vulkan.Core13.Promoted_From_VK_KHR_copy_commands2.ImageCopy2',
-- 'Vulkan.Core10.Enums.ImageLayout.ImageLayout',
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'copyImageToImageEXT'
data CopyImageToImageInfoEXT = CopyImageToImageInfoEXT
  { -- | @flags@ is a bitmask of 'HostImageCopyFlagBitsEXT' values describing
    -- additional copy parameters.
    CopyImageToImageInfoEXT -> HostImageCopyFlagBitsEXT
flags :: HostImageCopyFlagsEXT
  , -- | @srcImage@ is the source image.
    CopyImageToImageInfoEXT -> Image
srcImage :: Image
  , -- | @srcImageLayout@ is the layout of the source image subresources for the
    -- copy.
    CopyImageToImageInfoEXT -> ImageLayout
srcImageLayout :: ImageLayout
  , -- | @dstImage@ is the destination image.
    CopyImageToImageInfoEXT -> Image
dstImage :: Image
  , -- | @dstImageLayout@ is the layout of the destination image subresources for
    -- the copy.
    CopyImageToImageInfoEXT -> ImageLayout
dstImageLayout :: ImageLayout
  , -- | @pRegions@ is a pointer to an array of
    -- 'Vulkan.Core13.Promoted_From_VK_KHR_copy_commands2.ImageCopy2'
    -- structures specifying the regions to copy.
    CopyImageToImageInfoEXT -> Vector ImageCopy2
regions :: Vector ImageCopy2
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CopyImageToImageInfoEXT)
#endif
deriving instance Show CopyImageToImageInfoEXT

instance ToCStruct CopyImageToImageInfoEXT where
  withCStruct :: forall b.
CopyImageToImageInfoEXT
-> (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT)
    -> IO b)
-> IO b
withCStruct CopyImageToImageInfoEXT
x ("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
64 forall a b. (a -> b) -> a -> b
$ \"pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p CopyImageToImageInfoEXT
x (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT) -> IO b
f "pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p)
  pokeCStruct :: forall b.
("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT)
-> CopyImageToImageInfoEXT -> IO b -> IO b
pokeCStruct "pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p CopyImageToImageInfoEXT{Vector ImageCopy2
ImageLayout
Image
HostImageCopyFlagBitsEXT
regions :: Vector ImageCopy2
dstImageLayout :: ImageLayout
dstImage :: Image
srcImageLayout :: ImageLayout
srcImage :: Image
flags :: HostImageCopyFlagBitsEXT
$sel:regions:CopyImageToImageInfoEXT :: CopyImageToImageInfoEXT -> Vector ImageCopy2
$sel:dstImageLayout:CopyImageToImageInfoEXT :: CopyImageToImageInfoEXT -> ImageLayout
$sel:dstImage:CopyImageToImageInfoEXT :: CopyImageToImageInfoEXT -> Image
$sel:srcImageLayout:CopyImageToImageInfoEXT :: CopyImageToImageInfoEXT -> ImageLayout
$sel:srcImage:CopyImageToImageInfoEXT :: CopyImageToImageInfoEXT -> Image
$sel:flags:CopyImageToImageInfoEXT :: CopyImageToImageInfoEXT -> HostImageCopyFlagBitsEXT
..} 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 (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COPY_IMAGE_TO_IMAGE_INFO_EXT)
    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 (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
    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 (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr HostImageCopyFlagsEXT)) (HostImageCopyFlagBitsEXT
flags)
    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 (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Image)) (Image
srcImage)
    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 (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageLayout)) (ImageLayout
srcImageLayout)
    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 (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Image)) (Image
dstImage)
    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 (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr ImageLayout)) (ImageLayout
dstImageLayout)
    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 (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
52 :: Ptr Word32)) ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector ImageCopy2
regions)) :: Word32))
    Ptr ImageCopy2
pPRegions' <- 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 a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @ImageCopy2 ((forall a. Vector a -> Int
Data.Vector.length (Vector ImageCopy2
regions)) forall a. Num a => a -> a -> a
* Int
88)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i ImageCopy2
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ImageCopy2
pPRegions' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
88 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr ImageCopy2) (ImageCopy2
e)) (Vector ImageCopy2
regions)
    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 (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr (Ptr ImageCopy2))) (Ptr ImageCopy2
pPRegions')
    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
64
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT)
-> IO b -> IO b
pokeZeroCStruct "pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COPY_IMAGE_TO_IMAGE_INFO_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
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 (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Image)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageLayout)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Image)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr ImageLayout)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct CopyImageToImageInfoEXT where
  peekCStruct :: ("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT)
-> IO CopyImageToImageInfoEXT
peekCStruct "pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p = do
    HostImageCopyFlagBitsEXT
flags <- forall a. Storable a => Ptr a -> IO a
peek @HostImageCopyFlagsEXT (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr HostImageCopyFlagsEXT))
    Image
srcImage <- forall a. Storable a => Ptr a -> IO a
peek @Image (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Image))
    ImageLayout
srcImageLayout <- forall a. Storable a => Ptr a -> IO a
peek @ImageLayout (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageLayout))
    Image
dstImage <- forall a. Storable a => Ptr a -> IO a
peek @Image (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Image))
    ImageLayout
dstImageLayout <- forall a. Storable a => Ptr a -> IO a
peek @ImageLayout (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr ImageLayout))
    Flags
regionCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
52 :: Ptr Word32))
    Ptr ImageCopy2
pRegions <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ImageCopy2) (("pCopyImageToImageInfo" ::: Ptr CopyImageToImageInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr (Ptr ImageCopy2)))
    Vector ImageCopy2
pRegions' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Flags
regionCount) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ImageCopy2 ((Ptr ImageCopy2
pRegions forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
88 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr ImageCopy2)))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ HostImageCopyFlagBitsEXT
-> Image
-> ImageLayout
-> Image
-> ImageLayout
-> Vector ImageCopy2
-> CopyImageToImageInfoEXT
CopyImageToImageInfoEXT
             HostImageCopyFlagBitsEXT
flags Image
srcImage ImageLayout
srcImageLayout Image
dstImage ImageLayout
dstImageLayout Vector ImageCopy2
pRegions'

instance Zero CopyImageToImageInfoEXT where
  zero :: CopyImageToImageInfoEXT
zero = HostImageCopyFlagBitsEXT
-> Image
-> ImageLayout
-> Image
-> ImageLayout
-> Vector ImageCopy2
-> CopyImageToImageInfoEXT
CopyImageToImageInfoEXT
           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. Monoid a => a
mempty


-- | VkHostImageLayoutTransitionInfoEXT - Structure specifying the parameters
-- of a host-side image layout transition
--
-- = Description
--
-- 'transitionImageLayoutEXT' does not check whether the device memory
-- associated with an image is currently in use before performing the
-- layout transition. The application /must/ guarantee that any previously
-- submitted command that reads from or writes to this subresource has
-- completed before the host performs the layout transition.
--
-- Note
--
-- Image layout transitions performed on the host do not require queue
-- family ownership transfers as the physical layout of the image will not
-- vary between queue families for the layouts supported by this function.
--
-- == Valid Usage
--
-- -   #VUID-VkHostImageLayoutTransitionInfoEXT-image-09055# @image@ /must/
--     have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_HOST_TRANSFER_BIT_EXT'
--
-- -   #VUID-VkHostImageLayoutTransitionInfoEXT-subresourceRange-01486#
--     @subresourceRange.baseMipLevel@ /must/ be less than the @mipLevels@
--     specified in 'Vulkan.Core10.Image.ImageCreateInfo' when @image@ was
--     created
--
-- -   #VUID-VkHostImageLayoutTransitionInfoEXT-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-VkHostImageLayoutTransitionInfoEXT-subresourceRange-01488#
--     @subresourceRange.baseArrayLayer@ /must/ be less than the
--     @arrayLayers@ specified in 'Vulkan.Core10.Image.ImageCreateInfo'
--     when @image@ was created
--
-- -   #VUID-VkHostImageLayoutTransitionInfoEXT-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-VkHostImageLayoutTransitionInfoEXT-image-01932# If @image@ is
--     non-sparse then it /must/ be bound completely and contiguously to a
--     single 'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   #VUID-VkHostImageLayoutTransitionInfoEXT-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-VkHostImageLayoutTransitionInfoEXT-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-VkHostImageLayoutTransitionInfoEXT-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-VkHostImageLayoutTransitionInfoEXT-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-VkHostImageLayoutTransitionInfoEXT-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-VkHostImageLayoutTransitionInfoEXT-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-VkHostImageLayoutTransitionInfoEXT-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-VkHostImageLayoutTransitionInfoEXT-oldLayout-09229#
--     @oldLayout@ /must/ be either
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_UNDEFINED' or the
--     current layout of the image subresources as specified in
--     @subresourceRange@
--
-- -   #VUID-VkHostImageLayoutTransitionInfoEXT-oldLayout-09230# If
--     @oldLayout@ is not
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_UNDEFINED' or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_PREINITIALIZED', it
--     /must/ be one of the layouts in
--     'PhysicalDeviceHostImageCopyPropertiesEXT'::@pCopySrcLayouts@
--
-- -   #VUID-VkHostImageLayoutTransitionInfoEXT-newLayout-09057#
--     @newLayout@ /must/ be one of the layouts in
--     'PhysicalDeviceHostImageCopyPropertiesEXT'::@pCopyDstLayouts@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkHostImageLayoutTransitionInfoEXT-sType-sType# @sType@ /must/
--     be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_HOST_IMAGE_LAYOUT_TRANSITION_INFO_EXT'
--
-- -   #VUID-VkHostImageLayoutTransitionInfoEXT-pNext-pNext# @pNext@ /must/
--     be @NULL@
--
-- -   #VUID-VkHostImageLayoutTransitionInfoEXT-image-parameter# @image@
--     /must/ be a valid 'Vulkan.Core10.Handles.Image' handle
--
-- -   #VUID-VkHostImageLayoutTransitionInfoEXT-oldLayout-parameter#
--     @oldLayout@ /must/ be a valid
--     'Vulkan.Core10.Enums.ImageLayout.ImageLayout' value
--
-- -   #VUID-VkHostImageLayoutTransitionInfoEXT-newLayout-parameter#
--     @newLayout@ /must/ be a valid
--     'Vulkan.Core10.Enums.ImageLayout.ImageLayout' value
--
-- -   #VUID-VkHostImageLayoutTransitionInfoEXT-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_EXT_host_image_copy VK_EXT_host_image_copy>,
-- 'Vulkan.Core10.Handles.Image',
-- 'Vulkan.Core10.Enums.ImageLayout.ImageLayout',
-- 'Vulkan.Core10.ImageView.ImageSubresourceRange',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'transitionImageLayoutEXT'
data HostImageLayoutTransitionInfoEXT = HostImageLayoutTransitionInfoEXT
  { -- | @image@ is a handle to the image affected by this layout transition.
    HostImageLayoutTransitionInfoEXT -> Image
image :: Image
  , -- | @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>.
    HostImageLayoutTransitionInfoEXT -> 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>.
    HostImageLayoutTransitionInfoEXT -> ImageLayout
newLayout :: ImageLayout
  , -- | @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 layout transition.
    HostImageLayoutTransitionInfoEXT -> ImageSubresourceRange
subresourceRange :: ImageSubresourceRange
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (HostImageLayoutTransitionInfoEXT)
#endif
deriving instance Show HostImageLayoutTransitionInfoEXT

instance ToCStruct HostImageLayoutTransitionInfoEXT where
  withCStruct :: forall b.
HostImageLayoutTransitionInfoEXT
-> (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
    -> IO b)
-> IO b
withCStruct HostImageLayoutTransitionInfoEXT
x ("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
56 forall a b. (a -> b) -> a -> b
$ \"pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p HostImageLayoutTransitionInfoEXT
x (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT) -> IO b
f "pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p)
  pokeCStruct :: forall b.
("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
-> HostImageLayoutTransitionInfoEXT -> IO b -> IO b
pokeCStruct "pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p HostImageLayoutTransitionInfoEXT{ImageLayout
Image
ImageSubresourceRange
subresourceRange :: ImageSubresourceRange
newLayout :: ImageLayout
oldLayout :: ImageLayout
image :: Image
$sel:subresourceRange:HostImageLayoutTransitionInfoEXT :: HostImageLayoutTransitionInfoEXT -> ImageSubresourceRange
$sel:newLayout:HostImageLayoutTransitionInfoEXT :: HostImageLayoutTransitionInfoEXT -> ImageLayout
$sel:oldLayout:HostImageLayoutTransitionInfoEXT :: HostImageLayoutTransitionInfoEXT -> ImageLayout
$sel:image:HostImageLayoutTransitionInfoEXT :: HostImageLayoutTransitionInfoEXT -> Image
..} IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_HOST_IMAGE_LAYOUT_TRANSITION_INFO_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
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 (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Image)) (Image
image)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout)) (ImageLayout
oldLayout)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr ImageLayout)) (ImageLayout
newLayout)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageSubresourceRange)) (ImageSubresourceRange
subresourceRange)
    IO b
f
  cStructSize :: Int
cStructSize = Int
56
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
-> IO b -> IO b
pokeZeroCStruct "pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p IO b
f = do
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_HOST_IMAGE_LAYOUT_TRANSITION_INFO_EXT)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
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 (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Image)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr ImageLayout)) (forall a. Zero a => a
zero)
    forall a. Storable a => Ptr a -> a -> IO ()
poke (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageSubresourceRange)) (forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct HostImageLayoutTransitionInfoEXT where
  peekCStruct :: ("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT)
-> IO HostImageLayoutTransitionInfoEXT
peekCStruct "pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p = do
    Image
image <- forall a. Storable a => Ptr a -> IO a
peek @Image (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Image))
    ImageLayout
oldLayout <- forall a. Storable a => Ptr a -> IO a
peek @ImageLayout (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
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 (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr ImageLayout))
    ImageSubresourceRange
subresourceRange <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ImageSubresourceRange (("pTransitions" ::: Ptr HostImageLayoutTransitionInfoEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageSubresourceRange))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Image
-> ImageLayout
-> ImageLayout
-> ImageSubresourceRange
-> HostImageLayoutTransitionInfoEXT
HostImageLayoutTransitionInfoEXT
             Image
image ImageLayout
oldLayout ImageLayout
newLayout ImageSubresourceRange
subresourceRange

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

instance Zero HostImageLayoutTransitionInfoEXT where
  zero :: HostImageLayoutTransitionInfoEXT
zero = Image
-> ImageLayout
-> ImageLayout
-> ImageSubresourceRange
-> HostImageLayoutTransitionInfoEXT
HostImageLayoutTransitionInfoEXT
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero
           forall a. Zero a => a
zero


-- | VkSubresourceHostMemcpySizeEXT - Memory size needed to copy to or from
-- an image on the host with VK_HOST_IMAGE_COPY_MEMCPY_EXT
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_host_image_copy VK_EXT_host_image_copy>,
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data SubresourceHostMemcpySizeEXT = SubresourceHostMemcpySizeEXT
  { -- | @size@ is the size in bytes of the image subresource.
    SubresourceHostMemcpySizeEXT -> DeviceSize
size :: DeviceSize }
  deriving (Typeable, SubresourceHostMemcpySizeEXT
-> SubresourceHostMemcpySizeEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubresourceHostMemcpySizeEXT
-> SubresourceHostMemcpySizeEXT -> Bool
$c/= :: SubresourceHostMemcpySizeEXT
-> SubresourceHostMemcpySizeEXT -> Bool
== :: SubresourceHostMemcpySizeEXT
-> SubresourceHostMemcpySizeEXT -> Bool
$c== :: SubresourceHostMemcpySizeEXT
-> SubresourceHostMemcpySizeEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SubresourceHostMemcpySizeEXT)
#endif
deriving instance Show SubresourceHostMemcpySizeEXT

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

instance FromCStruct SubresourceHostMemcpySizeEXT where
  peekCStruct :: Ptr SubresourceHostMemcpySizeEXT -> IO SubresourceHostMemcpySizeEXT
peekCStruct Ptr SubresourceHostMemcpySizeEXT
p = do
    DeviceSize
size <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr SubresourceHostMemcpySizeEXT
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceSize))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DeviceSize -> SubresourceHostMemcpySizeEXT
SubresourceHostMemcpySizeEXT
             DeviceSize
size

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

instance Zero SubresourceHostMemcpySizeEXT where
  zero :: SubresourceHostMemcpySizeEXT
zero = DeviceSize -> SubresourceHostMemcpySizeEXT
SubresourceHostMemcpySizeEXT
           forall a. Zero a => a
zero


-- | VkHostImageCopyDevicePerformanceQueryEXT - Struct containing information
-- about optimality of device access
--
-- = Description
--
-- The implementation /may/ return 'Vulkan.Core10.FundamentalTypes.FALSE'
-- in @optimalDeviceAccess@ if @identicalMemoryLayout@ is
-- 'Vulkan.Core10.FundamentalTypes.FALSE'. If @identicalMemoryLayout@ is
-- 'Vulkan.Core10.FundamentalTypes.TRUE', @optimalDeviceAccess@ /must/ be
-- 'Vulkan.Core10.FundamentalTypes.TRUE'.
--
-- The implementation /may/ return 'Vulkan.Core10.FundamentalTypes.TRUE' in
-- @optimalDeviceAccess@ while @identicalMemoryLayout@ is
-- 'Vulkan.Core10.FundamentalTypes.FALSE'. In this situation, any device
-- performance impact /should/ not be measurable.
--
-- If
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceImageFormatInfo2'::@format@
-- is a block-compressed format and
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceImageFormatProperties2'
-- returns 'Vulkan.Core10.Enums.Result.SUCCESS', the implementation /must/
-- return 'Vulkan.Core10.FundamentalTypes.TRUE' in @optimalDeviceAccess@.
--
-- Note
--
-- Applications can make use of @optimalDeviceAccess@ to determine their
-- resource copying strategy. If a resource is expected to be accessed more
-- on device than on the host, and the implementation considers the
-- resource sub-optimally accessed, it is likely better to use device
-- copies instead.
--
-- Note
--
-- Layout not being identical yet still considered optimal for device
-- access could happen if the implementation has different memory layout
-- patterns, some of which are easier to access on the host.
--
-- Note
--
-- The most practical reason for @optimalDeviceAccess@ to be
-- 'Vulkan.Core10.FundamentalTypes.FALSE' is that host image access may
-- disable framebuffer compression where it would otherwise have been
-- enabled. This represents far more efficient host image access since no
-- compression algorithm is required to read or write to the image, but it
-- would impact device access performance. Some implementations may only
-- set @optimalDeviceAccess@ to 'Vulkan.Core10.FundamentalTypes.FALSE' if
-- certain conditions are met, such as specific image usage flags or
-- creation flags.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_host_image_copy VK_EXT_host_image_copy>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data HostImageCopyDevicePerformanceQueryEXT = HostImageCopyDevicePerformanceQueryEXT
  { -- | @optimalDeviceAccess@ returns 'Vulkan.Core10.FundamentalTypes.TRUE' if
    -- use of host image copy has no adverse effect on device access
    -- performance, compared to an image that is created with exact same
    -- creation parameters, and bound to the same
    -- 'Vulkan.Core10.Handles.DeviceMemory', except that
    -- 'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_HOST_TRANSFER_BIT_EXT'
    -- is replaced with
    -- 'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_TRANSFER_SRC_BIT'
    -- and
    -- 'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_TRANSFER_DST_BIT'.
    HostImageCopyDevicePerformanceQueryEXT -> Bool
optimalDeviceAccess :: Bool
  , -- | @identicalMemoryLayout@ returns 'Vulkan.Core10.FundamentalTypes.TRUE' if
    -- use of host image copy has no impact on memory layout compared to an
    -- image that is created with exact same creation parameters, and bound to
    -- the same 'Vulkan.Core10.Handles.DeviceMemory', except that
    -- 'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_HOST_TRANSFER_BIT_EXT'
    -- is replaced with
    -- 'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_TRANSFER_SRC_BIT'
    -- and
    -- 'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_TRANSFER_DST_BIT'.
    HostImageCopyDevicePerformanceQueryEXT -> Bool
identicalMemoryLayout :: Bool
  }
  deriving (Typeable, HostImageCopyDevicePerformanceQueryEXT
-> HostImageCopyDevicePerformanceQueryEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HostImageCopyDevicePerformanceQueryEXT
-> HostImageCopyDevicePerformanceQueryEXT -> Bool
$c/= :: HostImageCopyDevicePerformanceQueryEXT
-> HostImageCopyDevicePerformanceQueryEXT -> Bool
== :: HostImageCopyDevicePerformanceQueryEXT
-> HostImageCopyDevicePerformanceQueryEXT -> Bool
$c== :: HostImageCopyDevicePerformanceQueryEXT
-> HostImageCopyDevicePerformanceQueryEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (HostImageCopyDevicePerformanceQueryEXT)
#endif
deriving instance Show HostImageCopyDevicePerformanceQueryEXT

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

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

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

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


type HostImageCopyFlagsEXT = HostImageCopyFlagBitsEXT

-- | VkHostImageCopyFlagBitsEXT - Bitmask specifying additional copy
-- parameters
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_host_image_copy VK_EXT_host_image_copy>,
-- 'HostImageCopyFlagsEXT'
newtype HostImageCopyFlagBitsEXT = HostImageCopyFlagBitsEXT Flags
  deriving newtype (HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
$c/= :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
== :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
$c== :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
Eq, Eq HostImageCopyFlagBitsEXT
HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Ordering
HostImageCopyFlagBitsEXT
-> HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HostImageCopyFlagBitsEXT
-> HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
$cmin :: HostImageCopyFlagBitsEXT
-> HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
max :: HostImageCopyFlagBitsEXT
-> HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
$cmax :: HostImageCopyFlagBitsEXT
-> HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
>= :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
$c>= :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
> :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
$c> :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
<= :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
$c<= :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
< :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
$c< :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Bool
compare :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Ordering
$ccompare :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> Ordering
Ord, Ptr HostImageCopyFlagBitsEXT -> IO HostImageCopyFlagBitsEXT
Ptr HostImageCopyFlagBitsEXT -> Int -> IO HostImageCopyFlagBitsEXT
Ptr HostImageCopyFlagBitsEXT
-> Int -> HostImageCopyFlagBitsEXT -> IO ()
Ptr HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> IO ()
HostImageCopyFlagBitsEXT -> Int
forall b. Ptr b -> Int -> IO HostImageCopyFlagBitsEXT
forall b. Ptr b -> Int -> HostImageCopyFlagBitsEXT -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> IO ()
$cpoke :: Ptr HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT -> IO ()
peek :: Ptr HostImageCopyFlagBitsEXT -> IO HostImageCopyFlagBitsEXT
$cpeek :: Ptr HostImageCopyFlagBitsEXT -> IO HostImageCopyFlagBitsEXT
pokeByteOff :: forall b. Ptr b -> Int -> HostImageCopyFlagBitsEXT -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> HostImageCopyFlagBitsEXT -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO HostImageCopyFlagBitsEXT
$cpeekByteOff :: forall b. Ptr b -> Int -> IO HostImageCopyFlagBitsEXT
pokeElemOff :: Ptr HostImageCopyFlagBitsEXT
-> Int -> HostImageCopyFlagBitsEXT -> IO ()
$cpokeElemOff :: Ptr HostImageCopyFlagBitsEXT
-> Int -> HostImageCopyFlagBitsEXT -> IO ()
peekElemOff :: Ptr HostImageCopyFlagBitsEXT -> Int -> IO HostImageCopyFlagBitsEXT
$cpeekElemOff :: Ptr HostImageCopyFlagBitsEXT -> Int -> IO HostImageCopyFlagBitsEXT
alignment :: HostImageCopyFlagBitsEXT -> Int
$calignment :: HostImageCopyFlagBitsEXT -> Int
sizeOf :: HostImageCopyFlagBitsEXT -> Int
$csizeOf :: HostImageCopyFlagBitsEXT -> Int
Storable, HostImageCopyFlagBitsEXT
forall a. a -> Zero a
zero :: HostImageCopyFlagBitsEXT
$czero :: HostImageCopyFlagBitsEXT
Zero, Eq HostImageCopyFlagBitsEXT
HostImageCopyFlagBitsEXT
Int -> HostImageCopyFlagBitsEXT
HostImageCopyFlagBitsEXT -> Bool
HostImageCopyFlagBitsEXT -> Int
HostImageCopyFlagBitsEXT -> Maybe Int
HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
HostImageCopyFlagBitsEXT -> Int -> Bool
HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
HostImageCopyFlagBitsEXT
-> HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: HostImageCopyFlagBitsEXT -> Int
$cpopCount :: HostImageCopyFlagBitsEXT -> Int
rotateR :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
$crotateR :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
rotateL :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
$crotateL :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
unsafeShiftR :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
$cunsafeShiftR :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
shiftR :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
$cshiftR :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
unsafeShiftL :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
$cunsafeShiftL :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
shiftL :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
$cshiftL :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
isSigned :: HostImageCopyFlagBitsEXT -> Bool
$cisSigned :: HostImageCopyFlagBitsEXT -> Bool
bitSize :: HostImageCopyFlagBitsEXT -> Int
$cbitSize :: HostImageCopyFlagBitsEXT -> Int
bitSizeMaybe :: HostImageCopyFlagBitsEXT -> Maybe Int
$cbitSizeMaybe :: HostImageCopyFlagBitsEXT -> Maybe Int
testBit :: HostImageCopyFlagBitsEXT -> Int -> Bool
$ctestBit :: HostImageCopyFlagBitsEXT -> Int -> Bool
complementBit :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
$ccomplementBit :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
clearBit :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
$cclearBit :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
setBit :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
$csetBit :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
bit :: Int -> HostImageCopyFlagBitsEXT
$cbit :: Int -> HostImageCopyFlagBitsEXT
zeroBits :: HostImageCopyFlagBitsEXT
$czeroBits :: HostImageCopyFlagBitsEXT
rotate :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
$crotate :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
shift :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
$cshift :: HostImageCopyFlagBitsEXT -> Int -> HostImageCopyFlagBitsEXT
complement :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
$ccomplement :: HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
xor :: HostImageCopyFlagBitsEXT
-> HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
$cxor :: HostImageCopyFlagBitsEXT
-> HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
.|. :: HostImageCopyFlagBitsEXT
-> HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
$c.|. :: HostImageCopyFlagBitsEXT
-> HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
.&. :: HostImageCopyFlagBitsEXT
-> HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
$c.&. :: HostImageCopyFlagBitsEXT
-> HostImageCopyFlagBitsEXT -> HostImageCopyFlagBitsEXT
Bits, Bits HostImageCopyFlagBitsEXT
HostImageCopyFlagBitsEXT -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: HostImageCopyFlagBitsEXT -> Int
$ccountTrailingZeros :: HostImageCopyFlagBitsEXT -> Int
countLeadingZeros :: HostImageCopyFlagBitsEXT -> Int
$ccountLeadingZeros :: HostImageCopyFlagBitsEXT -> Int
finiteBitSize :: HostImageCopyFlagBitsEXT -> Int
$cfiniteBitSize :: HostImageCopyFlagBitsEXT -> Int
FiniteBits)

-- | 'HOST_IMAGE_COPY_MEMCPY_EXT' specifies that no memory layout swizzling
-- is to be applied during data copy. For copies between memory and images,
-- this flag indicates that image data in host memory is swizzled in
-- exactly the same way as the image data on the device. Using this flag
-- indicates that the implementations /may/ use a simple memory copy to
-- transfer the data between the host memory and the device memory. The
-- format of the swizzled data in host memory is platform dependent and is
-- not defined in this specification.
pattern $bHOST_IMAGE_COPY_MEMCPY_EXT :: HostImageCopyFlagBitsEXT
$mHOST_IMAGE_COPY_MEMCPY_EXT :: forall {r}.
HostImageCopyFlagBitsEXT -> ((# #) -> r) -> ((# #) -> r) -> r
HOST_IMAGE_COPY_MEMCPY_EXT = HostImageCopyFlagBitsEXT 0x00000001

conNameHostImageCopyFlagBitsEXT :: String
conNameHostImageCopyFlagBitsEXT :: String
conNameHostImageCopyFlagBitsEXT = String
"HostImageCopyFlagBitsEXT"

enumPrefixHostImageCopyFlagBitsEXT :: String
enumPrefixHostImageCopyFlagBitsEXT :: String
enumPrefixHostImageCopyFlagBitsEXT = String
"HOST_IMAGE_COPY_MEMCPY_EXT"

showTableHostImageCopyFlagBitsEXT :: [(HostImageCopyFlagBitsEXT, String)]
showTableHostImageCopyFlagBitsEXT :: [(HostImageCopyFlagBitsEXT, String)]
showTableHostImageCopyFlagBitsEXT = [(HostImageCopyFlagBitsEXT
HOST_IMAGE_COPY_MEMCPY_EXT, String
"")]

instance Show HostImageCopyFlagBitsEXT where
  showsPrec :: Int -> HostImageCopyFlagBitsEXT -> ShowS
showsPrec =
    forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec
      String
enumPrefixHostImageCopyFlagBitsEXT
      [(HostImageCopyFlagBitsEXT, String)]
showTableHostImageCopyFlagBitsEXT
      String
conNameHostImageCopyFlagBitsEXT
      (\(HostImageCopyFlagBitsEXT Flags
x) -> Flags
x)
      (\Flags
x -> String -> ShowS
showString String
"0x" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Integral a, Show a) => a -> ShowS
showHex Flags
x)

instance Read HostImageCopyFlagBitsEXT where
  readPrec :: ReadPrec HostImageCopyFlagBitsEXT
readPrec =
    forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
      String
enumPrefixHostImageCopyFlagBitsEXT
      [(HostImageCopyFlagBitsEXT, String)]
showTableHostImageCopyFlagBitsEXT
      String
conNameHostImageCopyFlagBitsEXT
      Flags -> HostImageCopyFlagBitsEXT
HostImageCopyFlagBitsEXT

-- No documentation found for TopLevel "VkImageSubresource2EXT"
type ImageSubresource2EXT = ImageSubresource2KHR


-- No documentation found for TopLevel "VkSubresourceLayout2EXT"
type SubresourceLayout2EXT = SubresourceLayout2KHR


type EXT_HOST_IMAGE_COPY_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_EXT_HOST_IMAGE_COPY_SPEC_VERSION"
pattern EXT_HOST_IMAGE_COPY_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_HOST_IMAGE_COPY_SPEC_VERSION :: forall a. Integral a => a
$mEXT_HOST_IMAGE_COPY_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_HOST_IMAGE_COPY_SPEC_VERSION = 1


type EXT_HOST_IMAGE_COPY_EXTENSION_NAME = "VK_EXT_host_image_copy"

-- No documentation found for TopLevel "VK_EXT_HOST_IMAGE_COPY_EXTENSION_NAME"
pattern EXT_HOST_IMAGE_COPY_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_HOST_IMAGE_COPY_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mEXT_HOST_IMAGE_COPY_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
EXT_HOST_IMAGE_COPY_EXTENSION_NAME = "VK_EXT_host_image_copy"