{-# 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 = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let vkCopyMemoryToImageEXTPtr :: FunPtr (Ptr Device_T -> Ptr CopyMemoryToImageInfoEXT -> IO Result)
vkCopyMemoryToImageEXTPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T -> Ptr CopyMemoryToImageInfoEXT -> IO Result)
pVkCopyMemoryToImageEXT (case Device
device of Device{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr (Ptr Device_T -> Ptr CopyMemoryToImageInfoEXT -> IO Result)
vkCopyMemoryToImageEXTPtr FunPtr (Ptr Device_T -> Ptr CopyMemoryToImageInfoEXT -> IO Result)
-> FunPtr
     (Ptr Device_T -> Ptr CopyMemoryToImageInfoEXT -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr (Ptr Device_T -> Ptr CopyMemoryToImageInfoEXT -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCopyMemoryToImageEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCopyMemoryToImageEXT' :: Ptr Device_T -> Ptr CopyMemoryToImageInfoEXT -> IO Result
vkCopyMemoryToImageEXT' = FunPtr (Ptr Device_T -> Ptr CopyMemoryToImageInfoEXT -> IO Result)
-> Ptr Device_T -> Ptr CopyMemoryToImageInfoEXT -> IO Result
mkVkCopyMemoryToImageEXT FunPtr (Ptr Device_T -> Ptr CopyMemoryToImageInfoEXT -> IO Result)
vkCopyMemoryToImageEXTPtr
  Ptr CopyMemoryToImageInfoEXT
pCopyMemoryToImageInfo <- ((Ptr CopyMemoryToImageInfoEXT -> IO ()) -> IO ())
-> ContT () IO (Ptr CopyMemoryToImageInfoEXT)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr CopyMemoryToImageInfoEXT -> IO ()) -> IO ())
 -> ContT () IO (Ptr CopyMemoryToImageInfoEXT))
-> ((Ptr CopyMemoryToImageInfoEXT -> IO ()) -> IO ())
-> ContT () IO (Ptr CopyMemoryToImageInfoEXT)
forall a b. (a -> b) -> a -> b
$ CopyMemoryToImageInfoEXT
-> (Ptr CopyMemoryToImageInfoEXT -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
forall b.
CopyMemoryToImageInfoEXT
-> (Ptr CopyMemoryToImageInfoEXT -> IO b) -> IO b
withCStruct (CopyMemoryToImageInfoEXT
copyMemoryToImageInfo)
  Result
r <- IO Result -> ContT () IO Result
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT () IO Result)
-> IO Result -> ContT () IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCopyMemoryToImageEXT" (Ptr Device_T -> Ptr CopyMemoryToImageInfoEXT -> IO Result
vkCopyMemoryToImageEXT'
                                                           (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                           Ptr CopyMemoryToImageInfoEXT
pCopyMemoryToImageInfo)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
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 = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let vkCopyImageToMemoryEXTPtr :: FunPtr (Ptr Device_T -> Ptr CopyImageToMemoryInfoEXT -> IO Result)
vkCopyImageToMemoryEXTPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T -> Ptr CopyImageToMemoryInfoEXT -> IO Result)
pVkCopyImageToMemoryEXT (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr (Ptr Device_T -> Ptr CopyImageToMemoryInfoEXT -> IO Result)
vkCopyImageToMemoryEXTPtr FunPtr (Ptr Device_T -> Ptr CopyImageToMemoryInfoEXT -> IO Result)
-> FunPtr
     (Ptr Device_T -> Ptr CopyImageToMemoryInfoEXT -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr (Ptr Device_T -> Ptr CopyImageToMemoryInfoEXT -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCopyImageToMemoryEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCopyImageToMemoryEXT' :: Ptr Device_T -> Ptr CopyImageToMemoryInfoEXT -> IO Result
vkCopyImageToMemoryEXT' = FunPtr (Ptr Device_T -> Ptr CopyImageToMemoryInfoEXT -> IO Result)
-> Ptr Device_T -> Ptr CopyImageToMemoryInfoEXT -> IO Result
mkVkCopyImageToMemoryEXT FunPtr (Ptr Device_T -> Ptr CopyImageToMemoryInfoEXT -> IO Result)
vkCopyImageToMemoryEXTPtr
  Ptr CopyImageToMemoryInfoEXT
pCopyImageToMemoryInfo <- ((Ptr CopyImageToMemoryInfoEXT -> IO ()) -> IO ())
-> ContT () IO (Ptr CopyImageToMemoryInfoEXT)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr CopyImageToMemoryInfoEXT -> IO ()) -> IO ())
 -> ContT () IO (Ptr CopyImageToMemoryInfoEXT))
-> ((Ptr CopyImageToMemoryInfoEXT -> IO ()) -> IO ())
-> ContT () IO (Ptr CopyImageToMemoryInfoEXT)
forall a b. (a -> b) -> a -> b
$ CopyImageToMemoryInfoEXT
-> (Ptr CopyImageToMemoryInfoEXT -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
forall b.
CopyImageToMemoryInfoEXT
-> (Ptr CopyImageToMemoryInfoEXT -> IO b) -> IO b
withCStruct (CopyImageToMemoryInfoEXT
copyImageToMemoryInfo)
  Result
r <- IO Result -> ContT () IO Result
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT () IO Result)
-> IO Result -> ContT () IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCopyImageToMemoryEXT" (Ptr Device_T -> Ptr CopyImageToMemoryInfoEXT -> IO Result
vkCopyImageToMemoryEXT'
                                                           (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                           Ptr CopyImageToMemoryInfoEXT
pCopyImageToMemoryInfo)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
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 = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let vkCopyImageToImageEXTPtr :: FunPtr (Ptr Device_T -> Ptr CopyImageToImageInfoEXT -> IO Result)
vkCopyImageToImageEXTPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T -> Ptr CopyImageToImageInfoEXT -> IO Result)
pVkCopyImageToImageEXT (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr (Ptr Device_T -> Ptr CopyImageToImageInfoEXT -> IO Result)
vkCopyImageToImageEXTPtr FunPtr (Ptr Device_T -> Ptr CopyImageToImageInfoEXT -> IO Result)
-> FunPtr
     (Ptr Device_T -> Ptr CopyImageToImageInfoEXT -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr (Ptr Device_T -> Ptr CopyImageToImageInfoEXT -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCopyImageToImageEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCopyImageToImageEXT' :: Ptr Device_T -> Ptr CopyImageToImageInfoEXT -> IO Result
vkCopyImageToImageEXT' = FunPtr (Ptr Device_T -> Ptr CopyImageToImageInfoEXT -> IO Result)
-> Ptr Device_T -> Ptr CopyImageToImageInfoEXT -> IO Result
mkVkCopyImageToImageEXT FunPtr (Ptr Device_T -> Ptr CopyImageToImageInfoEXT -> IO Result)
vkCopyImageToImageEXTPtr
  Ptr CopyImageToImageInfoEXT
pCopyImageToImageInfo <- ((Ptr CopyImageToImageInfoEXT -> IO ()) -> IO ())
-> ContT () IO (Ptr CopyImageToImageInfoEXT)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr CopyImageToImageInfoEXT -> IO ()) -> IO ())
 -> ContT () IO (Ptr CopyImageToImageInfoEXT))
-> ((Ptr CopyImageToImageInfoEXT -> IO ()) -> IO ())
-> ContT () IO (Ptr CopyImageToImageInfoEXT)
forall a b. (a -> b) -> a -> b
$ CopyImageToImageInfoEXT
-> (Ptr CopyImageToImageInfoEXT -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
forall b.
CopyImageToImageInfoEXT
-> (Ptr CopyImageToImageInfoEXT -> IO b) -> IO b
withCStruct (CopyImageToImageInfoEXT
copyImageToImageInfo)
  Result
r <- IO Result -> ContT () IO Result
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT () IO Result)
-> IO Result -> ContT () IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCopyImageToImageEXT" (Ptr Device_T -> Ptr CopyImageToImageInfoEXT -> IO Result
vkCopyImageToImageEXT'
                                                          (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                          Ptr CopyImageToImageInfoEXT
pCopyImageToImageInfo)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
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 = IO () -> io ()
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let vkTransitionImageLayoutEXTPtr :: FunPtr
  (Ptr Device_T
   -> Flags -> Ptr HostImageLayoutTransitionInfoEXT -> IO Result)
vkTransitionImageLayoutEXTPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> Flags -> Ptr HostImageLayoutTransitionInfoEXT -> IO Result)
pVkTransitionImageLayoutEXT (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> Flags -> Ptr HostImageLayoutTransitionInfoEXT -> IO Result)
vkTransitionImageLayoutEXTPtr FunPtr
  (Ptr Device_T
   -> Flags -> Ptr HostImageLayoutTransitionInfoEXT -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> Flags -> Ptr HostImageLayoutTransitionInfoEXT -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> Flags -> Ptr HostImageLayoutTransitionInfoEXT -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkTransitionImageLayoutEXT is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkTransitionImageLayoutEXT' :: Ptr Device_T
-> Flags -> Ptr HostImageLayoutTransitionInfoEXT -> IO Result
vkTransitionImageLayoutEXT' = FunPtr
  (Ptr Device_T
   -> Flags -> Ptr HostImageLayoutTransitionInfoEXT -> IO Result)
-> Ptr Device_T
-> Flags
-> Ptr HostImageLayoutTransitionInfoEXT
-> IO Result
mkVkTransitionImageLayoutEXT FunPtr
  (Ptr Device_T
   -> Flags -> Ptr HostImageLayoutTransitionInfoEXT -> IO Result)
vkTransitionImageLayoutEXTPtr
  Ptr HostImageLayoutTransitionInfoEXT
pPTransitions <- ((Ptr HostImageLayoutTransitionInfoEXT -> IO ()) -> IO ())
-> ContT () IO (Ptr HostImageLayoutTransitionInfoEXT)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr HostImageLayoutTransitionInfoEXT -> IO ()) -> IO ())
 -> ContT () IO (Ptr HostImageLayoutTransitionInfoEXT))
-> ((Ptr HostImageLayoutTransitionInfoEXT -> IO ()) -> IO ())
-> ContT () IO (Ptr HostImageLayoutTransitionInfoEXT)
forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @HostImageLayoutTransitionInfoEXT ((("transitions" ::: Vector HostImageLayoutTransitionInfoEXT) -> Int
forall a. Vector a -> Int
Data.Vector.length ("transitions" ::: Vector HostImageLayoutTransitionInfoEXT
transitions)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
56)
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> HostImageLayoutTransitionInfoEXT -> IO ())
-> ("transitions" ::: Vector HostImageLayoutTransitionInfoEXT)
-> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i HostImageLayoutTransitionInfoEXT
e -> Ptr HostImageLayoutTransitionInfoEXT
-> HostImageLayoutTransitionInfoEXT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr HostImageLayoutTransitionInfoEXT
pPTransitions Ptr HostImageLayoutTransitionInfoEXT
-> Int -> Ptr HostImageLayoutTransitionInfoEXT
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
56 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr HostImageLayoutTransitionInfoEXT) (HostImageLayoutTransitionInfoEXT
e)) ("transitions" ::: Vector HostImageLayoutTransitionInfoEXT
transitions)
  Result
r <- IO Result -> ContT () IO Result
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT () IO Result)
-> IO Result -> ContT () IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkTransitionImageLayoutEXT" (Ptr Device_T
-> Flags -> Ptr HostImageLayoutTransitionInfoEXT -> IO Result
vkTransitionImageLayoutEXT'
                                                               (Device -> Ptr Device_T
deviceHandle (Device
device))
                                                               ((Int -> Flags
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("transitions" ::: Vector HostImageLayoutTransitionInfoEXT) -> Int
forall a. Vector a -> Int
Data.Vector.length (("transitions" ::: Vector HostImageLayoutTransitionInfoEXT)
 -> Int)
-> ("transitions" ::: Vector HostImageLayoutTransitionInfoEXT)
-> Int
forall a b. (a -> b) -> a -> b
$ ("transitions" ::: Vector HostImageLayoutTransitionInfoEXT
transitions)) :: Word32))
                                                               (Ptr HostImageLayoutTransitionInfoEXT
pPTransitions))
  IO () -> ContT () IO ()
forall (m :: * -> *) a. Monad m => m a -> ContT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
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 = Device
-> Image -> ImageSubresource2KHR -> io (SubresourceLayout2KHR a)
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
(PhysicalDeviceHostImageCopyFeaturesEXT
 -> PhysicalDeviceHostImageCopyFeaturesEXT -> Bool)
-> (PhysicalDeviceHostImageCopyFeaturesEXT
    -> PhysicalDeviceHostImageCopyFeaturesEXT -> Bool)
-> Eq PhysicalDeviceHostImageCopyFeaturesEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PhysicalDeviceHostImageCopyFeaturesEXT
-> PhysicalDeviceHostImageCopyFeaturesEXT -> Bool
== :: PhysicalDeviceHostImageCopyFeaturesEXT
-> PhysicalDeviceHostImageCopyFeaturesEXT -> Bool
$c/= :: PhysicalDeviceHostImageCopyFeaturesEXT
-> PhysicalDeviceHostImageCopyFeaturesEXT -> Bool
/= :: 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 = Int -> (Ptr PhysicalDeviceHostImageCopyFeaturesEXT -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr PhysicalDeviceHostImageCopyFeaturesEXT -> IO b) -> IO b)
-> (Ptr PhysicalDeviceHostImageCopyFeaturesEXT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceHostImageCopyFeaturesEXT
p -> Ptr PhysicalDeviceHostImageCopyFeaturesEXT
-> PhysicalDeviceHostImageCopyFeaturesEXT -> IO b -> IO b
forall b.
Ptr PhysicalDeviceHostImageCopyFeaturesEXT
-> PhysicalDeviceHostImageCopyFeaturesEXT -> IO b -> IO b
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
$sel:hostImageCopy:PhysicalDeviceHostImageCopyFeaturesEXT :: PhysicalDeviceHostImageCopyFeaturesEXT -> Bool
hostImageCopy :: Bool
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyFeaturesEXT
p Ptr PhysicalDeviceHostImageCopyFeaturesEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_HOST_IMAGE_COPY_FEATURES_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyFeaturesEXT
p Ptr PhysicalDeviceHostImageCopyFeaturesEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyFeaturesEXT
p Ptr PhysicalDeviceHostImageCopyFeaturesEXT -> Int -> Ptr Bool32
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
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyFeaturesEXT
p Ptr PhysicalDeviceHostImageCopyFeaturesEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_HOST_IMAGE_COPY_FEATURES_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyFeaturesEXT
p Ptr PhysicalDeviceHostImageCopyFeaturesEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyFeaturesEXT
p Ptr PhysicalDeviceHostImageCopyFeaturesEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct 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 Ptr PhysicalDeviceHostImageCopyFeaturesEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
    PhysicalDeviceHostImageCopyFeaturesEXT
-> IO PhysicalDeviceHostImageCopyFeaturesEXT
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceHostImageCopyFeaturesEXT
 -> IO PhysicalDeviceHostImageCopyFeaturesEXT)
-> PhysicalDeviceHostImageCopyFeaturesEXT
-> IO PhysicalDeviceHostImageCopyFeaturesEXT
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 = Ptr PhysicalDeviceHostImageCopyFeaturesEXT
-> IO PhysicalDeviceHostImageCopyFeaturesEXT
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr PhysicalDeviceHostImageCopyFeaturesEXT
-> PhysicalDeviceHostImageCopyFeaturesEXT -> IO ()
poke Ptr PhysicalDeviceHostImageCopyFeaturesEXT
ptr PhysicalDeviceHostImageCopyFeaturesEXT
poked = Ptr PhysicalDeviceHostImageCopyFeaturesEXT
-> PhysicalDeviceHostImageCopyFeaturesEXT -> IO () -> IO ()
forall b.
Ptr PhysicalDeviceHostImageCopyFeaturesEXT
-> PhysicalDeviceHostImageCopyFeaturesEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceHostImageCopyFeaturesEXT
ptr PhysicalDeviceHostImageCopyFeaturesEXT
poked (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero PhysicalDeviceHostImageCopyFeaturesEXT where
  zero :: PhysicalDeviceHostImageCopyFeaturesEXT
zero = Bool -> PhysicalDeviceHostImageCopyFeaturesEXT
PhysicalDeviceHostImageCopyFeaturesEXT
           Bool
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 = Int
-> (Ptr PhysicalDeviceHostImageCopyPropertiesEXT -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
72 ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT -> IO b) -> IO b)
-> (Ptr PhysicalDeviceHostImageCopyPropertiesEXT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p -> Ptr PhysicalDeviceHostImageCopyPropertiesEXT
-> PhysicalDeviceHostImageCopyPropertiesEXT -> IO b -> IO b
forall b.
Ptr PhysicalDeviceHostImageCopyPropertiesEXT
-> PhysicalDeviceHostImageCopyPropertiesEXT -> IO b -> IO b
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
$sel:copySrcLayoutCount:PhysicalDeviceHostImageCopyPropertiesEXT :: PhysicalDeviceHostImageCopyPropertiesEXT -> Flags
$sel:copySrcLayouts:PhysicalDeviceHostImageCopyPropertiesEXT :: PhysicalDeviceHostImageCopyPropertiesEXT -> Ptr ImageLayout
$sel:copyDstLayoutCount:PhysicalDeviceHostImageCopyPropertiesEXT :: PhysicalDeviceHostImageCopyPropertiesEXT -> Flags
$sel:copyDstLayouts:PhysicalDeviceHostImageCopyPropertiesEXT :: PhysicalDeviceHostImageCopyPropertiesEXT -> Ptr ImageLayout
$sel:optimalTilingLayoutUUID:PhysicalDeviceHostImageCopyPropertiesEXT :: PhysicalDeviceHostImageCopyPropertiesEXT -> ByteString
$sel:identicalMemoryTypeRequirements:PhysicalDeviceHostImageCopyPropertiesEXT :: PhysicalDeviceHostImageCopyPropertiesEXT -> Bool
copySrcLayoutCount :: Flags
copySrcLayouts :: Ptr ImageLayout
copyDstLayoutCount :: Flags
copyDstLayouts :: Ptr ImageLayout
optimalTilingLayoutUUID :: ByteString
identicalMemoryTypeRequirements :: Bool
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p Ptr PhysicalDeviceHostImageCopyPropertiesEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_HOST_IMAGE_COPY_PROPERTIES_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p Ptr PhysicalDeviceHostImageCopyPropertiesEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Flags -> Flags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p Ptr PhysicalDeviceHostImageCopyPropertiesEXT -> Int -> Ptr Flags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Flags
copySrcLayoutCount)
    Ptr (Ptr ImageLayout) -> Ptr ImageLayout -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p Ptr PhysicalDeviceHostImageCopyPropertiesEXT
-> Int -> Ptr (Ptr ImageLayout)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr ImageLayout))) (Ptr ImageLayout
copySrcLayouts)
    Ptr Flags -> Flags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p Ptr PhysicalDeviceHostImageCopyPropertiesEXT -> Int -> Ptr Flags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) (Flags
copyDstLayoutCount)
    Ptr (Ptr ImageLayout) -> Ptr ImageLayout -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p Ptr PhysicalDeviceHostImageCopyPropertiesEXT
-> Int -> Ptr (Ptr ImageLayout)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr ImageLayout))) (Ptr ImageLayout
copyDstLayouts)
    Ptr (FixedArray UUID_SIZE Word8) -> ByteString -> IO ()
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> ByteString -> IO ()
pokeFixedLengthByteString ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p Ptr PhysicalDeviceHostImageCopyPropertiesEXT
-> Int -> Ptr (FixedArray UUID_SIZE Word8)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr (FixedArray UUID_SIZE Word8))) (ByteString
optimalTilingLayoutUUID)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p Ptr PhysicalDeviceHostImageCopyPropertiesEXT -> Int -> Ptr Bool32
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
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p Ptr PhysicalDeviceHostImageCopyPropertiesEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_HOST_IMAGE_COPY_PROPERTIES_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p Ptr PhysicalDeviceHostImageCopyPropertiesEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p Ptr PhysicalDeviceHostImageCopyPropertiesEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
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 Ptr PhysicalDeviceHostImageCopyPropertiesEXT -> Int -> Ptr Flags
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 Ptr PhysicalDeviceHostImageCopyPropertiesEXT
-> Int -> Ptr (Ptr ImageLayout)
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 Ptr PhysicalDeviceHostImageCopyPropertiesEXT -> Int -> Ptr Flags
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 Ptr PhysicalDeviceHostImageCopyPropertiesEXT
-> Int -> Ptr (Ptr ImageLayout)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr ImageLayout)))
    ByteString
optimalTilingLayoutUUID <- Ptr (FixedArray UUID_SIZE Word8) -> IO ByteString
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> IO ByteString
peekByteStringFromSizedVectorPtr ((Ptr PhysicalDeviceHostImageCopyPropertiesEXT
p Ptr PhysicalDeviceHostImageCopyPropertiesEXT
-> Int -> Ptr (FixedArray UUID_SIZE Word8)
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 Ptr PhysicalDeviceHostImageCopyPropertiesEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr Bool32))
    PhysicalDeviceHostImageCopyPropertiesEXT
-> IO PhysicalDeviceHostImageCopyPropertiesEXT
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceHostImageCopyPropertiesEXT
 -> IO PhysicalDeviceHostImageCopyPropertiesEXT)
-> PhysicalDeviceHostImageCopyPropertiesEXT
-> IO PhysicalDeviceHostImageCopyPropertiesEXT
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 = Ptr PhysicalDeviceHostImageCopyPropertiesEXT
-> IO PhysicalDeviceHostImageCopyPropertiesEXT
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr PhysicalDeviceHostImageCopyPropertiesEXT
-> PhysicalDeviceHostImageCopyPropertiesEXT -> IO ()
poke Ptr PhysicalDeviceHostImageCopyPropertiesEXT
ptr PhysicalDeviceHostImageCopyPropertiesEXT
poked = Ptr PhysicalDeviceHostImageCopyPropertiesEXT
-> PhysicalDeviceHostImageCopyPropertiesEXT -> IO () -> IO ()
forall b.
Ptr PhysicalDeviceHostImageCopyPropertiesEXT
-> PhysicalDeviceHostImageCopyPropertiesEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceHostImageCopyPropertiesEXT
ptr PhysicalDeviceHostImageCopyPropertiesEXT
poked (() -> IO ()
forall a. a -> IO a
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
           Flags
forall a. Zero a => a
zero
           Ptr ImageLayout
forall a. Zero a => a
zero
           Flags
forall a. Zero a => a
zero
           Ptr ImageLayout
forall a. Zero a => a
zero
           ByteString
forall a. Monoid a => a
mempty
           Bool
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 = Int -> (Ptr MemoryToImageCopyEXT -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
72 ((Ptr MemoryToImageCopyEXT -> IO b) -> IO b)
-> (Ptr MemoryToImageCopyEXT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr MemoryToImageCopyEXT
p -> Ptr MemoryToImageCopyEXT -> MemoryToImageCopyEXT -> IO b -> IO b
forall b.
Ptr MemoryToImageCopyEXT -> MemoryToImageCopyEXT -> IO b -> IO b
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 ()
Extent3D
Offset3D
ImageSubresourceLayers
$sel:hostPointer:MemoryToImageCopyEXT :: MemoryToImageCopyEXT -> Ptr ()
$sel:memoryRowLength:MemoryToImageCopyEXT :: MemoryToImageCopyEXT -> Flags
$sel:memoryImageHeight:MemoryToImageCopyEXT :: MemoryToImageCopyEXT -> Flags
$sel:imageSubresource:MemoryToImageCopyEXT :: MemoryToImageCopyEXT -> ImageSubresourceLayers
$sel:imageOffset:MemoryToImageCopyEXT :: MemoryToImageCopyEXT -> Offset3D
$sel:imageExtent:MemoryToImageCopyEXT :: MemoryToImageCopyEXT -> Extent3D
hostPointer :: Ptr ()
memoryRowLength :: Flags
memoryImageHeight :: Flags
imageSubresource :: ImageSubresourceLayers
imageOffset :: Offset3D
imageExtent :: Extent3D
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p Ptr MemoryToImageCopyEXT -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_TO_IMAGE_COPY_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p Ptr MemoryToImageCopyEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p Ptr MemoryToImageCopyEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr ()))) (Ptr ()
hostPointer)
    Ptr Flags -> Flags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p Ptr MemoryToImageCopyEXT -> Int -> Ptr Flags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Flags
memoryRowLength)
    Ptr Flags -> Flags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p Ptr MemoryToImageCopyEXT -> Int -> Ptr Flags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (Flags
memoryImageHeight)
    Ptr ImageSubresourceLayers -> ImageSubresourceLayers -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p Ptr MemoryToImageCopyEXT -> Int -> Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageSubresourceLayers)) (ImageSubresourceLayers
imageSubresource)
    Ptr Offset3D -> Offset3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p Ptr MemoryToImageCopyEXT -> Int -> Ptr Offset3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Offset3D)) (Offset3D
imageOffset)
    Ptr Extent3D -> Extent3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p Ptr MemoryToImageCopyEXT -> Int -> Ptr Extent3D
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
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p Ptr MemoryToImageCopyEXT -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_MEMORY_TO_IMAGE_COPY_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p Ptr MemoryToImageCopyEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p Ptr MemoryToImageCopyEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr ()))) (Ptr ()
forall a. Zero a => a
zero)
    Ptr Flags -> Flags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p Ptr MemoryToImageCopyEXT -> Int -> Ptr Flags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Flags
forall a. Zero a => a
zero)
    Ptr Flags -> Flags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p Ptr MemoryToImageCopyEXT -> Int -> Ptr Flags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (Flags
forall a. Zero a => a
zero)
    Ptr ImageSubresourceLayers -> ImageSubresourceLayers -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p Ptr MemoryToImageCopyEXT -> Int -> Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageSubresourceLayers)) (ImageSubresourceLayers
forall a. Zero a => a
zero)
    Ptr Offset3D -> Offset3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p Ptr MemoryToImageCopyEXT -> Int -> Ptr Offset3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Offset3D)) (Offset3D
forall a. Zero a => a
zero)
    Ptr Extent3D -> Extent3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryToImageCopyEXT
p Ptr MemoryToImageCopyEXT -> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Extent3D)) (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 Ptr MemoryToImageCopyEXT -> Int -> Ptr (Ptr ())
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 Ptr MemoryToImageCopyEXT -> Int -> Ptr Flags
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 Ptr MemoryToImageCopyEXT -> Int -> Ptr Flags
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 Ptr MemoryToImageCopyEXT -> Int -> Ptr ImageSubresourceLayers
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 Ptr MemoryToImageCopyEXT -> Int -> Ptr Offset3D
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 Ptr MemoryToImageCopyEXT -> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Extent3D))
    MemoryToImageCopyEXT -> IO MemoryToImageCopyEXT
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MemoryToImageCopyEXT -> IO MemoryToImageCopyEXT)
-> MemoryToImageCopyEXT -> IO MemoryToImageCopyEXT
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 = Ptr MemoryToImageCopyEXT -> IO MemoryToImageCopyEXT
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr MemoryToImageCopyEXT -> MemoryToImageCopyEXT -> IO ()
poke Ptr MemoryToImageCopyEXT
ptr MemoryToImageCopyEXT
poked = Ptr MemoryToImageCopyEXT -> MemoryToImageCopyEXT -> IO () -> IO ()
forall b.
Ptr MemoryToImageCopyEXT -> MemoryToImageCopyEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr MemoryToImageCopyEXT
ptr MemoryToImageCopyEXT
poked (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

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

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

instance FromCStruct CopyMemoryToImageInfoEXT where
  peekCStruct :: Ptr CopyMemoryToImageInfoEXT -> IO CopyMemoryToImageInfoEXT
peekCStruct Ptr CopyMemoryToImageInfoEXT
p = do
    HostImageCopyFlagsEXT
flags <- forall a. Storable a => Ptr a -> IO a
peek @HostImageCopyFlagsEXT ((Ptr CopyMemoryToImageInfoEXT
p Ptr CopyMemoryToImageInfoEXT -> Int -> Ptr HostImageCopyFlagsEXT
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 ((Ptr CopyMemoryToImageInfoEXT
p Ptr CopyMemoryToImageInfoEXT -> Int -> Ptr Image
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 ((Ptr CopyMemoryToImageInfoEXT
p Ptr CopyMemoryToImageInfoEXT -> Int -> Ptr ImageLayout
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 ((Ptr CopyMemoryToImageInfoEXT
p Ptr CopyMemoryToImageInfoEXT -> Int -> Ptr Flags
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) ((Ptr CopyMemoryToImageInfoEXT
p Ptr CopyMemoryToImageInfoEXT
-> Int -> Ptr (Ptr MemoryToImageCopyEXT)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr MemoryToImageCopyEXT)))
    Vector MemoryToImageCopyEXT
pRegions' <- Int
-> (Int -> IO MemoryToImageCopyEXT)
-> IO (Vector MemoryToImageCopyEXT)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Flags -> Int
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 Ptr MemoryToImageCopyEXT -> Int -> Ptr MemoryToImageCopyEXT
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
72 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MemoryToImageCopyEXT)))
    CopyMemoryToImageInfoEXT -> IO CopyMemoryToImageInfoEXT
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CopyMemoryToImageInfoEXT -> IO CopyMemoryToImageInfoEXT)
-> CopyMemoryToImageInfoEXT -> IO CopyMemoryToImageInfoEXT
forall a b. (a -> b) -> a -> b
$ HostImageCopyFlagsEXT
-> Image
-> ImageLayout
-> Vector MemoryToImageCopyEXT
-> CopyMemoryToImageInfoEXT
CopyMemoryToImageInfoEXT
             HostImageCopyFlagsEXT
flags Image
dstImage ImageLayout
dstImageLayout Vector MemoryToImageCopyEXT
pRegions'

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

instance FromCStruct CopyImageToMemoryInfoEXT where
  peekCStruct :: Ptr CopyImageToMemoryInfoEXT -> IO CopyImageToMemoryInfoEXT
peekCStruct Ptr CopyImageToMemoryInfoEXT
p = do
    HostImageCopyFlagsEXT
flags <- forall a. Storable a => Ptr a -> IO a
peek @HostImageCopyFlagsEXT ((Ptr CopyImageToMemoryInfoEXT
p Ptr CopyImageToMemoryInfoEXT -> Int -> Ptr HostImageCopyFlagsEXT
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 ((Ptr CopyImageToMemoryInfoEXT
p Ptr CopyImageToMemoryInfoEXT -> Int -> Ptr Image
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 ((Ptr CopyImageToMemoryInfoEXT
p Ptr CopyImageToMemoryInfoEXT -> Int -> Ptr ImageLayout
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 ((Ptr CopyImageToMemoryInfoEXT
p Ptr CopyImageToMemoryInfoEXT -> Int -> Ptr Flags
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) ((Ptr CopyImageToMemoryInfoEXT
p Ptr CopyImageToMemoryInfoEXT
-> Int -> Ptr (Ptr ImageToMemoryCopyEXT)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr ImageToMemoryCopyEXT)))
    Vector ImageToMemoryCopyEXT
pRegions' <- Int
-> (Int -> IO ImageToMemoryCopyEXT)
-> IO (Vector ImageToMemoryCopyEXT)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Flags -> Int
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 Ptr ImageToMemoryCopyEXT -> Int -> Ptr ImageToMemoryCopyEXT
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
72 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr ImageToMemoryCopyEXT)))
    CopyImageToMemoryInfoEXT -> IO CopyImageToMemoryInfoEXT
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CopyImageToMemoryInfoEXT -> IO CopyImageToMemoryInfoEXT)
-> CopyImageToMemoryInfoEXT -> IO CopyImageToMemoryInfoEXT
forall a b. (a -> b) -> a -> b
$ HostImageCopyFlagsEXT
-> Image
-> ImageLayout
-> Vector ImageToMemoryCopyEXT
-> CopyImageToMemoryInfoEXT
CopyImageToMemoryInfoEXT
             HostImageCopyFlagsEXT
flags Image
srcImage ImageLayout
srcImageLayout Vector ImageToMemoryCopyEXT
pRegions'

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

instance FromCStruct CopyImageToImageInfoEXT where
  peekCStruct :: Ptr CopyImageToImageInfoEXT -> IO CopyImageToImageInfoEXT
peekCStruct Ptr CopyImageToImageInfoEXT
p = do
    HostImageCopyFlagsEXT
flags <- forall a. Storable a => Ptr a -> IO a
peek @HostImageCopyFlagsEXT ((Ptr CopyImageToImageInfoEXT
p Ptr CopyImageToImageInfoEXT -> Int -> Ptr HostImageCopyFlagsEXT
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 ((Ptr CopyImageToImageInfoEXT
p Ptr CopyImageToImageInfoEXT -> Int -> Ptr Image
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 ((Ptr CopyImageToImageInfoEXT
p Ptr CopyImageToImageInfoEXT -> Int -> Ptr ImageLayout
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 ((Ptr CopyImageToImageInfoEXT
p Ptr CopyImageToImageInfoEXT -> Int -> Ptr Image
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 ((Ptr CopyImageToImageInfoEXT
p Ptr CopyImageToImageInfoEXT -> Int -> Ptr ImageLayout
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 ((Ptr CopyImageToImageInfoEXT
p Ptr CopyImageToImageInfoEXT -> Int -> Ptr Flags
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) ((Ptr CopyImageToImageInfoEXT
p Ptr CopyImageToImageInfoEXT -> Int -> Ptr (Ptr ImageCopy2)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr (Ptr ImageCopy2)))
    Vector ImageCopy2
pRegions' <- Int -> (Int -> IO ImageCopy2) -> IO (Vector ImageCopy2)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Flags -> Int
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 Ptr ImageCopy2 -> Int -> Ptr ImageCopy2
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
88 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr ImageCopy2)))
    CopyImageToImageInfoEXT -> IO CopyImageToImageInfoEXT
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CopyImageToImageInfoEXT -> IO CopyImageToImageInfoEXT)
-> CopyImageToImageInfoEXT -> IO CopyImageToImageInfoEXT
forall a b. (a -> b) -> a -> b
$ HostImageCopyFlagsEXT
-> Image
-> ImageLayout
-> Image
-> ImageLayout
-> Vector ImageCopy2
-> CopyImageToImageInfoEXT
CopyImageToImageInfoEXT
             HostImageCopyFlagsEXT
flags Image
srcImage ImageLayout
srcImageLayout Image
dstImage ImageLayout
dstImageLayout Vector ImageCopy2
pRegions'

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

instance FromCStruct HostImageLayoutTransitionInfoEXT where
  peekCStruct :: Ptr HostImageLayoutTransitionInfoEXT
-> IO HostImageLayoutTransitionInfoEXT
peekCStruct Ptr HostImageLayoutTransitionInfoEXT
p = do
    Image
image <- forall a. Storable a => Ptr a -> IO a
peek @Image ((Ptr HostImageLayoutTransitionInfoEXT
p Ptr HostImageLayoutTransitionInfoEXT -> Int -> Ptr Image
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 ((Ptr HostImageLayoutTransitionInfoEXT
p Ptr HostImageLayoutTransitionInfoEXT -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout))
    ImageLayout
newLayout <- forall a. Storable a => Ptr a -> IO a
peek @ImageLayout ((Ptr HostImageLayoutTransitionInfoEXT
p Ptr HostImageLayoutTransitionInfoEXT -> Int -> Ptr ImageLayout
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 ((Ptr HostImageLayoutTransitionInfoEXT
p Ptr HostImageLayoutTransitionInfoEXT
-> Int -> Ptr ImageSubresourceRange
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageSubresourceRange))
    HostImageLayoutTransitionInfoEXT
-> IO HostImageLayoutTransitionInfoEXT
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HostImageLayoutTransitionInfoEXT
 -> IO HostImageLayoutTransitionInfoEXT)
-> HostImageLayoutTransitionInfoEXT
-> IO HostImageLayoutTransitionInfoEXT
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 :: Ptr HostImageLayoutTransitionInfoEXT
-> IO HostImageLayoutTransitionInfoEXT
peek = Ptr HostImageLayoutTransitionInfoEXT
-> IO HostImageLayoutTransitionInfoEXT
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr HostImageLayoutTransitionInfoEXT
-> HostImageLayoutTransitionInfoEXT -> IO ()
poke Ptr HostImageLayoutTransitionInfoEXT
ptr HostImageLayoutTransitionInfoEXT
poked = Ptr HostImageLayoutTransitionInfoEXT
-> HostImageLayoutTransitionInfoEXT -> IO () -> IO ()
forall b.
Ptr HostImageLayoutTransitionInfoEXT
-> HostImageLayoutTransitionInfoEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr HostImageLayoutTransitionInfoEXT
ptr HostImageLayoutTransitionInfoEXT
poked (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero HostImageLayoutTransitionInfoEXT where
  zero :: HostImageLayoutTransitionInfoEXT
zero = Image
-> ImageLayout
-> ImageLayout
-> ImageSubresourceRange
-> HostImageLayoutTransitionInfoEXT
HostImageLayoutTransitionInfoEXT
           Image
forall a. Zero a => a
zero
           ImageLayout
forall a. Zero a => a
zero
           ImageLayout
forall a. Zero a => a
zero
           ImageSubresourceRange
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
(SubresourceHostMemcpySizeEXT
 -> SubresourceHostMemcpySizeEXT -> Bool)
-> (SubresourceHostMemcpySizeEXT
    -> SubresourceHostMemcpySizeEXT -> Bool)
-> Eq SubresourceHostMemcpySizeEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubresourceHostMemcpySizeEXT
-> SubresourceHostMemcpySizeEXT -> Bool
== :: SubresourceHostMemcpySizeEXT
-> SubresourceHostMemcpySizeEXT -> Bool
$c/= :: SubresourceHostMemcpySizeEXT
-> SubresourceHostMemcpySizeEXT -> Bool
/= :: 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 = Int -> (Ptr SubresourceHostMemcpySizeEXT -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr SubresourceHostMemcpySizeEXT -> IO b) -> IO b)
-> (Ptr SubresourceHostMemcpySizeEXT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr SubresourceHostMemcpySizeEXT
p -> Ptr SubresourceHostMemcpySizeEXT
-> SubresourceHostMemcpySizeEXT -> IO b -> IO b
forall b.
Ptr SubresourceHostMemcpySizeEXT
-> SubresourceHostMemcpySizeEXT -> IO b -> IO b
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
$sel:size:SubresourceHostMemcpySizeEXT :: SubresourceHostMemcpySizeEXT -> DeviceSize
size :: DeviceSize
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SubresourceHostMemcpySizeEXT
p Ptr SubresourceHostMemcpySizeEXT -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SUBRESOURCE_HOST_MEMCPY_SIZE_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SubresourceHostMemcpySizeEXT
p Ptr SubresourceHostMemcpySizeEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr DeviceSize -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SubresourceHostMemcpySizeEXT
p Ptr SubresourceHostMemcpySizeEXT -> Int -> Ptr DeviceSize
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
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SubresourceHostMemcpySizeEXT
p Ptr SubresourceHostMemcpySizeEXT -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SUBRESOURCE_HOST_MEMCPY_SIZE_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SubresourceHostMemcpySizeEXT
p Ptr SubresourceHostMemcpySizeEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr DeviceSize -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SubresourceHostMemcpySizeEXT
p Ptr SubresourceHostMemcpySizeEXT -> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceSize)) (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 Ptr SubresourceHostMemcpySizeEXT -> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceSize))
    SubresourceHostMemcpySizeEXT -> IO SubresourceHostMemcpySizeEXT
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubresourceHostMemcpySizeEXT -> IO SubresourceHostMemcpySizeEXT)
-> SubresourceHostMemcpySizeEXT -> IO SubresourceHostMemcpySizeEXT
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 = Ptr SubresourceHostMemcpySizeEXT -> IO SubresourceHostMemcpySizeEXT
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr SubresourceHostMemcpySizeEXT
-> SubresourceHostMemcpySizeEXT -> IO ()
poke Ptr SubresourceHostMemcpySizeEXT
ptr SubresourceHostMemcpySizeEXT
poked = Ptr SubresourceHostMemcpySizeEXT
-> SubresourceHostMemcpySizeEXT -> IO () -> IO ()
forall b.
Ptr SubresourceHostMemcpySizeEXT
-> SubresourceHostMemcpySizeEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SubresourceHostMemcpySizeEXT
ptr SubresourceHostMemcpySizeEXT
poked (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero SubresourceHostMemcpySizeEXT where
  zero :: SubresourceHostMemcpySizeEXT
zero = DeviceSize -> SubresourceHostMemcpySizeEXT
SubresourceHostMemcpySizeEXT
           DeviceSize
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
(HostImageCopyDevicePerformanceQueryEXT
 -> HostImageCopyDevicePerformanceQueryEXT -> Bool)
-> (HostImageCopyDevicePerformanceQueryEXT
    -> HostImageCopyDevicePerformanceQueryEXT -> Bool)
-> Eq HostImageCopyDevicePerformanceQueryEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HostImageCopyDevicePerformanceQueryEXT
-> HostImageCopyDevicePerformanceQueryEXT -> Bool
== :: HostImageCopyDevicePerformanceQueryEXT
-> HostImageCopyDevicePerformanceQueryEXT -> Bool
$c/= :: HostImageCopyDevicePerformanceQueryEXT
-> HostImageCopyDevicePerformanceQueryEXT -> Bool
/= :: 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 = Int -> (Ptr HostImageCopyDevicePerformanceQueryEXT -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr HostImageCopyDevicePerformanceQueryEXT -> IO b) -> IO b)
-> (Ptr HostImageCopyDevicePerformanceQueryEXT -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr HostImageCopyDevicePerformanceQueryEXT
p -> Ptr HostImageCopyDevicePerformanceQueryEXT
-> HostImageCopyDevicePerformanceQueryEXT -> IO b -> IO b
forall b.
Ptr HostImageCopyDevicePerformanceQueryEXT
-> HostImageCopyDevicePerformanceQueryEXT -> IO b -> IO b
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
$sel:optimalDeviceAccess:HostImageCopyDevicePerformanceQueryEXT :: HostImageCopyDevicePerformanceQueryEXT -> Bool
$sel:identicalMemoryLayout:HostImageCopyDevicePerformanceQueryEXT :: HostImageCopyDevicePerformanceQueryEXT -> Bool
optimalDeviceAccess :: Bool
identicalMemoryLayout :: Bool
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr HostImageCopyDevicePerformanceQueryEXT
p Ptr HostImageCopyDevicePerformanceQueryEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_HOST_IMAGE_COPY_DEVICE_PERFORMANCE_QUERY_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr HostImageCopyDevicePerformanceQueryEXT
p Ptr HostImageCopyDevicePerformanceQueryEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr HostImageCopyDevicePerformanceQueryEXT
p Ptr HostImageCopyDevicePerformanceQueryEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
optimalDeviceAccess))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr HostImageCopyDevicePerformanceQueryEXT
p Ptr HostImageCopyDevicePerformanceQueryEXT -> Int -> Ptr Bool32
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
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr HostImageCopyDevicePerformanceQueryEXT
p Ptr HostImageCopyDevicePerformanceQueryEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_HOST_IMAGE_COPY_DEVICE_PERFORMANCE_QUERY_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr HostImageCopyDevicePerformanceQueryEXT
p Ptr HostImageCopyDevicePerformanceQueryEXT -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr HostImageCopyDevicePerformanceQueryEXT
p Ptr HostImageCopyDevicePerformanceQueryEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr HostImageCopyDevicePerformanceQueryEXT
p Ptr HostImageCopyDevicePerformanceQueryEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct 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 Ptr HostImageCopyDevicePerformanceQueryEXT -> Int -> Ptr Bool32
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 Ptr HostImageCopyDevicePerformanceQueryEXT -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32))
    HostImageCopyDevicePerformanceQueryEXT
-> IO HostImageCopyDevicePerformanceQueryEXT
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HostImageCopyDevicePerformanceQueryEXT
 -> IO HostImageCopyDevicePerformanceQueryEXT)
-> HostImageCopyDevicePerformanceQueryEXT
-> IO HostImageCopyDevicePerformanceQueryEXT
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 = Ptr HostImageCopyDevicePerformanceQueryEXT
-> IO HostImageCopyDevicePerformanceQueryEXT
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr HostImageCopyDevicePerformanceQueryEXT
-> HostImageCopyDevicePerformanceQueryEXT -> IO ()
poke Ptr HostImageCopyDevicePerformanceQueryEXT
ptr HostImageCopyDevicePerformanceQueryEXT
poked = Ptr HostImageCopyDevicePerformanceQueryEXT
-> HostImageCopyDevicePerformanceQueryEXT -> IO () -> IO ()
forall b.
Ptr HostImageCopyDevicePerformanceQueryEXT
-> HostImageCopyDevicePerformanceQueryEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr HostImageCopyDevicePerformanceQueryEXT
ptr HostImageCopyDevicePerformanceQueryEXT
poked (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero HostImageCopyDevicePerformanceQueryEXT where
  zero :: HostImageCopyDevicePerformanceQueryEXT
zero = Bool -> Bool -> HostImageCopyDevicePerformanceQueryEXT
HostImageCopyDevicePerformanceQueryEXT
           Bool
forall a. Zero a => a
zero
           Bool
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 (HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> Bool
(HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> Bool)
-> (HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> Bool)
-> Eq HostImageCopyFlagsEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> Bool
== :: HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> Bool
$c/= :: HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> Bool
/= :: HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> Bool
Eq, Eq HostImageCopyFlagsEXT
Eq HostImageCopyFlagsEXT =>
(HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> Ordering)
-> (HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> Bool)
-> (HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> Bool)
-> (HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> Bool)
-> (HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> Bool)
-> (HostImageCopyFlagsEXT
    -> HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT)
-> (HostImageCopyFlagsEXT
    -> HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT)
-> Ord HostImageCopyFlagsEXT
HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> Bool
HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> Ordering
HostImageCopyFlagsEXT
-> HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT
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
$ccompare :: HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> Ordering
compare :: HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> Ordering
$c< :: HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> Bool
< :: HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> Bool
$c<= :: HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> Bool
<= :: HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> Bool
$c> :: HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> Bool
> :: HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> Bool
$c>= :: HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> Bool
>= :: HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> Bool
$cmax :: HostImageCopyFlagsEXT
-> HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT
max :: HostImageCopyFlagsEXT
-> HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT
$cmin :: HostImageCopyFlagsEXT
-> HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT
min :: HostImageCopyFlagsEXT
-> HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT
Ord, Ptr HostImageCopyFlagsEXT -> IO HostImageCopyFlagsEXT
Ptr HostImageCopyFlagsEXT -> Int -> IO HostImageCopyFlagsEXT
Ptr HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT -> IO ()
Ptr HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> IO ()
HostImageCopyFlagsEXT -> Int
(HostImageCopyFlagsEXT -> Int)
-> (HostImageCopyFlagsEXT -> Int)
-> (Ptr HostImageCopyFlagsEXT -> Int -> IO HostImageCopyFlagsEXT)
-> (Ptr HostImageCopyFlagsEXT
    -> Int -> HostImageCopyFlagsEXT -> IO ())
-> (forall b. Ptr b -> Int -> IO HostImageCopyFlagsEXT)
-> (forall b. Ptr b -> Int -> HostImageCopyFlagsEXT -> IO ())
-> (Ptr HostImageCopyFlagsEXT -> IO HostImageCopyFlagsEXT)
-> (Ptr HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> IO ())
-> Storable HostImageCopyFlagsEXT
forall b. Ptr b -> Int -> IO HostImageCopyFlagsEXT
forall b. Ptr b -> Int -> HostImageCopyFlagsEXT -> 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
$csizeOf :: HostImageCopyFlagsEXT -> Int
sizeOf :: HostImageCopyFlagsEXT -> Int
$calignment :: HostImageCopyFlagsEXT -> Int
alignment :: HostImageCopyFlagsEXT -> Int
$cpeekElemOff :: Ptr HostImageCopyFlagsEXT -> Int -> IO HostImageCopyFlagsEXT
peekElemOff :: Ptr HostImageCopyFlagsEXT -> Int -> IO HostImageCopyFlagsEXT
$cpokeElemOff :: Ptr HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT -> IO ()
pokeElemOff :: Ptr HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO HostImageCopyFlagsEXT
peekByteOff :: forall b. Ptr b -> Int -> IO HostImageCopyFlagsEXT
$cpokeByteOff :: forall b. Ptr b -> Int -> HostImageCopyFlagsEXT -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> HostImageCopyFlagsEXT -> IO ()
$cpeek :: Ptr HostImageCopyFlagsEXT -> IO HostImageCopyFlagsEXT
peek :: Ptr HostImageCopyFlagsEXT -> IO HostImageCopyFlagsEXT
$cpoke :: Ptr HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> IO ()
poke :: Ptr HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT -> IO ()
Storable, HostImageCopyFlagsEXT
HostImageCopyFlagsEXT -> Zero HostImageCopyFlagsEXT
forall a. a -> Zero a
$czero :: HostImageCopyFlagsEXT
zero :: HostImageCopyFlagsEXT
Zero, Eq HostImageCopyFlagsEXT
HostImageCopyFlagsEXT
Eq HostImageCopyFlagsEXT =>
(HostImageCopyFlagsEXT
 -> HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT)
-> (HostImageCopyFlagsEXT
    -> HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT)
-> (HostImageCopyFlagsEXT
    -> HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT)
-> (HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT)
-> (HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT)
-> (HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT)
-> HostImageCopyFlagsEXT
-> (Int -> HostImageCopyFlagsEXT)
-> (HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT)
-> (HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT)
-> (HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT)
-> (HostImageCopyFlagsEXT -> Int -> Bool)
-> (HostImageCopyFlagsEXT -> Maybe Int)
-> (HostImageCopyFlagsEXT -> Int)
-> (HostImageCopyFlagsEXT -> Bool)
-> (HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT)
-> (HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT)
-> (HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT)
-> (HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT)
-> (HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT)
-> (HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT)
-> (HostImageCopyFlagsEXT -> Int)
-> Bits HostImageCopyFlagsEXT
Int -> HostImageCopyFlagsEXT
HostImageCopyFlagsEXT -> Bool
HostImageCopyFlagsEXT -> Int
HostImageCopyFlagsEXT -> Maybe Int
HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT
HostImageCopyFlagsEXT -> Int -> Bool
HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT
HostImageCopyFlagsEXT
-> HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT
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
$c.&. :: HostImageCopyFlagsEXT
-> HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT
.&. :: HostImageCopyFlagsEXT
-> HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT
$c.|. :: HostImageCopyFlagsEXT
-> HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT
.|. :: HostImageCopyFlagsEXT
-> HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT
$cxor :: HostImageCopyFlagsEXT
-> HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT
xor :: HostImageCopyFlagsEXT
-> HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT
$ccomplement :: HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT
complement :: HostImageCopyFlagsEXT -> HostImageCopyFlagsEXT
$cshift :: HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT
shift :: HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT
$crotate :: HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT
rotate :: HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT
$czeroBits :: HostImageCopyFlagsEXT
zeroBits :: HostImageCopyFlagsEXT
$cbit :: Int -> HostImageCopyFlagsEXT
bit :: Int -> HostImageCopyFlagsEXT
$csetBit :: HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT
setBit :: HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT
$cclearBit :: HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT
clearBit :: HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT
$ccomplementBit :: HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT
complementBit :: HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT
$ctestBit :: HostImageCopyFlagsEXT -> Int -> Bool
testBit :: HostImageCopyFlagsEXT -> Int -> Bool
$cbitSizeMaybe :: HostImageCopyFlagsEXT -> Maybe Int
bitSizeMaybe :: HostImageCopyFlagsEXT -> Maybe Int
$cbitSize :: HostImageCopyFlagsEXT -> Int
bitSize :: HostImageCopyFlagsEXT -> Int
$cisSigned :: HostImageCopyFlagsEXT -> Bool
isSigned :: HostImageCopyFlagsEXT -> Bool
$cshiftL :: HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT
shiftL :: HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT
$cunsafeShiftL :: HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT
unsafeShiftL :: HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT
$cshiftR :: HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT
shiftR :: HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT
$cunsafeShiftR :: HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT
unsafeShiftR :: HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT
$crotateL :: HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT
rotateL :: HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT
$crotateR :: HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT
rotateR :: HostImageCopyFlagsEXT -> Int -> HostImageCopyFlagsEXT
$cpopCount :: HostImageCopyFlagsEXT -> Int
popCount :: HostImageCopyFlagsEXT -> Int
Bits, Bits HostImageCopyFlagsEXT
Bits HostImageCopyFlagsEXT =>
(HostImageCopyFlagsEXT -> Int)
-> (HostImageCopyFlagsEXT -> Int)
-> (HostImageCopyFlagsEXT -> Int)
-> FiniteBits HostImageCopyFlagsEXT
HostImageCopyFlagsEXT -> Int
forall b.
Bits b =>
(b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
$cfiniteBitSize :: HostImageCopyFlagsEXT -> Int
finiteBitSize :: HostImageCopyFlagsEXT -> Int
$ccountLeadingZeros :: HostImageCopyFlagsEXT -> Int
countLeadingZeros :: HostImageCopyFlagsEXT -> Int
$ccountTrailingZeros :: HostImageCopyFlagsEXT -> Int
countTrailingZeros :: HostImageCopyFlagsEXT -> 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 :: HostImageCopyFlagsEXT
$mHOST_IMAGE_COPY_MEMCPY_EXT :: forall {r}.
HostImageCopyFlagsEXT -> ((# #) -> 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 :: [(HostImageCopyFlagsEXT, String)]
showTableHostImageCopyFlagBitsEXT = [(HostImageCopyFlagsEXT
HOST_IMAGE_COPY_MEMCPY_EXT, String
"")]

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

instance Read HostImageCopyFlagBitsEXT where
  readPrec :: ReadPrec HostImageCopyFlagsEXT
readPrec =
    String
-> [(HostImageCopyFlagsEXT, String)]
-> String
-> (Flags -> HostImageCopyFlagsEXT)
-> ReadPrec HostImageCopyFlagsEXT
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec
      String
enumPrefixHostImageCopyFlagBitsEXT
      [(HostImageCopyFlagsEXT, String)]
showTableHostImageCopyFlagBitsEXT
      String
conNameHostImageCopyFlagBitsEXT
      Flags -> HostImageCopyFlagsEXT
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"