{-# language CPP #-}
-- No documentation found for Chapter "Promoted_From_VK_KHR_copy_commands2"
module Vulkan.Core13.Promoted_From_VK_KHR_copy_commands2  ( cmdCopyBuffer2
                                                          , cmdCopyImage2
                                                          , cmdBlitImage2
                                                          , cmdCopyBufferToImage2
                                                          , cmdCopyImageToBuffer2
                                                          , cmdResolveImage2
                                                          , BufferCopy2(..)
                                                          , ImageCopy2(..)
                                                          , ImageBlit2(..)
                                                          , BufferImageCopy2(..)
                                                          , ImageResolve2(..)
                                                          , CopyBufferInfo2(..)
                                                          , CopyImageInfo2(..)
                                                          , BlitImageInfo2(..)
                                                          , CopyBufferToImageInfo2(..)
                                                          , CopyImageToBufferInfo2(..)
                                                          , ResolveImageInfo2(..)
                                                          , StructureType(..)
                                                          ) where

import Vulkan.CStruct.Utils (FixedArray)
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytes)
import GHC.IO (throwIO)
import GHC.Ptr (castPtr)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
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 Control.Monad.IO.Class (MonadIO)
import Data.Type.Equality ((:~:)(Refl))
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.CStruct.Utils (advancePtrBytes)
import Vulkan.CStruct.Extends (forgetExtensions)
import Vulkan.CStruct.Utils (lowerArrayPtr)
import Vulkan.CStruct.Extends (peekSomeCStruct)
import Vulkan.CStruct.Extends (pokeSomeCStruct)
import Vulkan.Core10.Handles (Buffer)
import Vulkan.CStruct.Extends (Chain)
import Vulkan.Core10.Handles (CommandBuffer)
import Vulkan.Core10.Handles (CommandBuffer(..))
import Vulkan.Core10.Handles (CommandBuffer(CommandBuffer))
import Vulkan.Core10.Handles (CommandBuffer_T)
import {-# SOURCE #-} Vulkan.Extensions.VK_QCOM_rotated_copy_commands (CopyCommandTransformInfoQCOM)
import Vulkan.Dynamic (DeviceCmds(pVkCmdBlitImage2))
import Vulkan.Dynamic (DeviceCmds(pVkCmdCopyBuffer2))
import Vulkan.Dynamic (DeviceCmds(pVkCmdCopyBufferToImage2))
import Vulkan.Dynamic (DeviceCmds(pVkCmdCopyImage2))
import Vulkan.Dynamic (DeviceCmds(pVkCmdCopyImageToBuffer2))
import Vulkan.Dynamic (DeviceCmds(pVkCmdResolveImage2))
import Vulkan.Core10.FundamentalTypes (DeviceSize)
import Vulkan.CStruct.Extends (Extends)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (Extensible(..))
import Vulkan.Core10.FundamentalTypes (Extent3D)
import Vulkan.Core10.Enums.Filter (Filter)
import Vulkan.Core10.Handles (Image)
import Vulkan.Core10.Enums.ImageLayout (ImageLayout)
import Vulkan.Core10.CommandBufferBuilding (ImageSubresourceLayers)
import Vulkan.Core10.FundamentalTypes (Offset3D)
import Vulkan.CStruct.Extends (PeekChain)
import Vulkan.CStruct.Extends (PeekChain(..))
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (PokeChain(..))
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_BLIT_IMAGE_INFO_2))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_BUFFER_COPY_2))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_BUFFER_IMAGE_COPY_2))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_COPY_BUFFER_INFO_2))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_COPY_BUFFER_TO_IMAGE_INFO_2))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_COPY_IMAGE_INFO_2))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_COPY_IMAGE_TO_BUFFER_INFO_2))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_IMAGE_BLIT_2))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_IMAGE_COPY_2))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_IMAGE_RESOLVE_2))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_RESOLVE_IMAGE_INFO_2))
import Vulkan.Core10.Enums.StructureType (StructureType(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdCopyBuffer2
  :: FunPtr (Ptr CommandBuffer_T -> Ptr CopyBufferInfo2 -> IO ()) -> Ptr CommandBuffer_T -> Ptr CopyBufferInfo2 -> IO ()

-- | vkCmdCopyBuffer2 - Copy data between buffer regions
--
-- = Description
--
-- This command is functionally identical to
-- 'Vulkan.Core10.CommandBufferBuilding.cmdCopyBuffer', but includes
-- extensible sub-structures that include @sType@ and @pNext@ parameters,
-- allowing them to be more easily extended.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdCopyBuffer2-commandBuffer-01822# If @commandBuffer@ is an
--     unprotected command buffer and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-protectedNoFault protectedNoFault>
--     is not supported, @srcBuffer@ /must/ not be a protected buffer
--
-- -   #VUID-vkCmdCopyBuffer2-commandBuffer-01823# If @commandBuffer@ is an
--     unprotected command buffer and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-protectedNoFault protectedNoFault>
--     is not supported, @dstBuffer@ /must/ not be a protected buffer
--
-- -   #VUID-vkCmdCopyBuffer2-commandBuffer-01824# If @commandBuffer@ is a
--     protected command buffer and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-protectedNoFault protectedNoFault>
--     is not supported, @dstBuffer@ /must/ not be an unprotected buffer
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdCopyBuffer2-commandBuffer-parameter# @commandBuffer@
--     /must/ be a valid 'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdCopyBuffer2-pCopyBufferInfo-parameter# @pCopyBufferInfo@
--     /must/ be a valid pointer to a valid 'CopyBufferInfo2' structure
--
-- -   #VUID-vkCmdCopyBuffer2-commandBuffer-recording# @commandBuffer@
--     /must/ be in the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#commandbuffers-lifecycle recording state>
--
-- -   #VUID-vkCmdCopyBuffer2-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support transfer, graphics, or compute
--     operations
--
-- -   #VUID-vkCmdCopyBuffer2-renderpass# This command /must/ only be
--     called outside of a render pass instance
--
-- -   #VUID-vkCmdCopyBuffer2-videocoding# This command /must/ only be
--     called outside of a video coding scope
--
-- == Host Synchronization
--
-- -   Host access to @commandBuffer@ /must/ be externally synchronized
--
-- -   Host access to the 'Vulkan.Core10.Handles.CommandPool' that
--     @commandBuffer@ was allocated from /must/ be externally synchronized
--
-- == Command Properties
--
-- \'
--
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
-- | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkCommandBufferLevel Command Buffer Levels> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginRenderPass Render Pass Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginVideoCodingKHR Video Coding Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkQueueFlagBits Supported Queue Types> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-queueoperation-command-types Command Type> |
-- +============================================================================================================================+========================================================================================================================+=============================================================================================================================+=======================================================================================================================+========================================================================================================================================+
-- | Primary                                                                                                                    | Outside                                                                                                                | Outside                                                                                                                     | Transfer                                                                                                              | Action                                                                                                                                 |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                             | Graphics                                                                                                              |                                                                                                                                        |
-- |                                                                                                                            |                                                                                                                        |                                                                                                                             | Compute                                                                                                               |                                                                                                                                        |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_copy_commands2 VK_KHR_copy_commands2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.Handles.CommandBuffer', 'CopyBufferInfo2'
cmdCopyBuffer2 :: forall io
                . (MonadIO io)
               => -- | @commandBuffer@ is the command buffer into which the command will be
                  -- recorded.
                  CommandBuffer
               -> -- | @pCopyBufferInfo@ is a pointer to a 'CopyBufferInfo2' structure
                  -- describing the copy parameters.
                  CopyBufferInfo2
               -> io ()
cmdCopyBuffer2 :: forall (io :: * -> *).
MonadIO io =>
CommandBuffer -> CopyBufferInfo2 -> io ()
cmdCopyBuffer2 CommandBuffer
commandBuffer CopyBufferInfo2
copyBufferInfo = IO () -> io ()
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 vkCmdCopyBuffer2Ptr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> IO ())
vkCmdCopyBuffer2Ptr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> IO ())
pVkCmdCopyBuffer2 (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT () IO ()
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 CommandBuffer_T
   -> ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> IO ())
vkCmdCopyBuffer2Ptr FunPtr
  (Ptr CommandBuffer_T
   -> ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> IO ())
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 vkCmdCopyBuffer2 is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdCopyBuffer2' :: Ptr CommandBuffer_T
-> ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> IO ()
vkCmdCopyBuffer2' = FunPtr
  (Ptr CommandBuffer_T
   -> ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> IO ())
-> Ptr CommandBuffer_T
-> ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2)
-> IO ()
mkVkCmdCopyBuffer2 FunPtr
  (Ptr CommandBuffer_T
   -> ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> IO ())
vkCmdCopyBuffer2Ptr
  "pCopyBufferInfo" ::: Ptr CopyBufferInfo2
pCopyBufferInfo <- ((("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> IO ()) -> IO ())
-> ContT () IO ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> IO ()) -> IO ())
 -> ContT () IO ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2))
-> ((("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> IO ())
    -> IO ())
-> ContT () IO ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2)
forall a b. (a -> b) -> a -> b
$ CopyBufferInfo2
-> (("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (CopyBufferInfo2
copyBufferInfo)
  IO () -> ContT () IO ()
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
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdCopyBuffer2" (Ptr CommandBuffer_T
-> ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> IO ()
vkCmdCopyBuffer2'
                                                (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer))
                                                "pCopyBufferInfo" ::: Ptr CopyBufferInfo2
pCopyBufferInfo)
  () -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdCopyImage2
  :: FunPtr (Ptr CommandBuffer_T -> Ptr CopyImageInfo2 -> IO ()) -> Ptr CommandBuffer_T -> Ptr CopyImageInfo2 -> IO ()

-- | vkCmdCopyImage2 - Copy data between images
--
-- = Description
--
-- This command is functionally identical to
-- 'Vulkan.Core10.CommandBufferBuilding.cmdCopyImage', but includes
-- extensible sub-structures that include @sType@ and @pNext@ parameters,
-- allowing them to be more easily extended.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdCopyImage2-commandBuffer-01825# If @commandBuffer@ is an
--     unprotected command buffer and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-protectedNoFault protectedNoFault>
--     is not supported, @srcImage@ /must/ not be a protected image
--
-- -   #VUID-vkCmdCopyImage2-commandBuffer-01826# If @commandBuffer@ is an
--     unprotected command buffer and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-protectedNoFault protectedNoFault>
--     is not supported, @dstImage@ /must/ not be a protected image
--
-- -   #VUID-vkCmdCopyImage2-commandBuffer-01827# If @commandBuffer@ is a
--     protected command buffer and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-protectedNoFault protectedNoFault>
--     is not supported, @dstImage@ /must/ not be an unprotected image
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdCopyImage2-commandBuffer-parameter# @commandBuffer@
--     /must/ be a valid 'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdCopyImage2-pCopyImageInfo-parameter# @pCopyImageInfo@
--     /must/ be a valid pointer to a valid 'CopyImageInfo2' structure
--
-- -   #VUID-vkCmdCopyImage2-commandBuffer-recording# @commandBuffer@
--     /must/ be in the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#commandbuffers-lifecycle recording state>
--
-- -   #VUID-vkCmdCopyImage2-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support transfer, graphics, or compute
--     operations
--
-- -   #VUID-vkCmdCopyImage2-renderpass# This command /must/ only be called
--     outside of a render pass instance
--
-- -   #VUID-vkCmdCopyImage2-videocoding# This command /must/ only be
--     called outside of a video coding scope
--
-- == Host Synchronization
--
-- -   Host access to @commandBuffer@ /must/ be externally synchronized
--
-- -   Host access to the 'Vulkan.Core10.Handles.CommandPool' that
--     @commandBuffer@ was allocated from /must/ be externally synchronized
--
-- == Command Properties
--
-- \'
--
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
-- | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkCommandBufferLevel Command Buffer Levels> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginRenderPass Render Pass Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginVideoCodingKHR Video Coding Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkQueueFlagBits Supported Queue Types> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-queueoperation-command-types Command Type> |
-- +============================================================================================================================+========================================================================================================================+=============================================================================================================================+=======================================================================================================================+========================================================================================================================================+
-- | Primary                                                                                                                    | Outside                                                                                                                | Outside                                                                                                                     | Transfer                                                                                                              | Action                                                                                                                                 |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                             | Graphics                                                                                                              |                                                                                                                                        |
-- |                                                                                                                            |                                                                                                                        |                                                                                                                             | Compute                                                                                                               |                                                                                                                                        |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_copy_commands2 VK_KHR_copy_commands2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.Handles.CommandBuffer', 'CopyImageInfo2'
cmdCopyImage2 :: forall io
               . (MonadIO io)
              => -- | @commandBuffer@ is the command buffer into which the command will be
                 -- recorded.
                 CommandBuffer
              -> -- | @pCopyImageInfo@ is a pointer to a 'CopyImageInfo2' structure describing
                 -- the copy parameters.
                 CopyImageInfo2
              -> io ()
cmdCopyImage2 :: forall (io :: * -> *).
MonadIO io =>
CommandBuffer -> CopyImageInfo2 -> io ()
cmdCopyImage2 CommandBuffer
commandBuffer CopyImageInfo2
copyImageInfo = IO () -> io ()
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 vkCmdCopyImage2Ptr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> IO ())
vkCmdCopyImage2Ptr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> IO ())
pVkCmdCopyImage2 (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT () IO ()
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 CommandBuffer_T
   -> ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> IO ())
vkCmdCopyImage2Ptr FunPtr
  (Ptr CommandBuffer_T
   -> ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> IO ())
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 vkCmdCopyImage2 is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdCopyImage2' :: Ptr CommandBuffer_T
-> ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> IO ()
vkCmdCopyImage2' = FunPtr
  (Ptr CommandBuffer_T
   -> ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> IO ())
-> Ptr CommandBuffer_T
-> ("pCopyImageInfo" ::: Ptr CopyImageInfo2)
-> IO ()
mkVkCmdCopyImage2 FunPtr
  (Ptr CommandBuffer_T
   -> ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> IO ())
vkCmdCopyImage2Ptr
  "pCopyImageInfo" ::: Ptr CopyImageInfo2
pCopyImageInfo <- ((("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> IO ()) -> IO ())
-> ContT () IO ("pCopyImageInfo" ::: Ptr CopyImageInfo2)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> IO ()) -> IO ())
 -> ContT () IO ("pCopyImageInfo" ::: Ptr CopyImageInfo2))
-> ((("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> IO ()) -> IO ())
-> ContT () IO ("pCopyImageInfo" ::: Ptr CopyImageInfo2)
forall a b. (a -> b) -> a -> b
$ CopyImageInfo2
-> (("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (CopyImageInfo2
copyImageInfo)
  IO () -> ContT () IO ()
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
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdCopyImage2" (Ptr CommandBuffer_T
-> ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> IO ()
vkCmdCopyImage2'
                                               (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer))
                                               "pCopyImageInfo" ::: Ptr CopyImageInfo2
pCopyImageInfo)
  () -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdBlitImage2
  :: FunPtr (Ptr CommandBuffer_T -> Ptr BlitImageInfo2 -> IO ()) -> Ptr CommandBuffer_T -> Ptr BlitImageInfo2 -> IO ()

-- | vkCmdBlitImage2 - Copy regions of an image, potentially performing
-- format conversion,
--
-- = Description
--
-- This command is functionally identical to
-- 'Vulkan.Core10.CommandBufferBuilding.cmdBlitImage', but includes
-- extensible sub-structures that include @sType@ and @pNext@ parameters,
-- allowing them to be more easily extended.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdBlitImage2-commandBuffer-01834# If @commandBuffer@ is an
--     unprotected command buffer and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-protectedNoFault protectedNoFault>
--     is not supported, @srcImage@ /must/ not be a protected image
--
-- -   #VUID-vkCmdBlitImage2-commandBuffer-01835# If @commandBuffer@ is an
--     unprotected command buffer and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-protectedNoFault protectedNoFault>
--     is not supported, @dstImage@ /must/ not be a protected image
--
-- -   #VUID-vkCmdBlitImage2-commandBuffer-01836# If @commandBuffer@ is a
--     protected command buffer and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-protectedNoFault protectedNoFault>
--     is not supported, @dstImage@ /must/ not be an unprotected image
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdBlitImage2-commandBuffer-parameter# @commandBuffer@
--     /must/ be a valid 'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdBlitImage2-pBlitImageInfo-parameter# @pBlitImageInfo@
--     /must/ be a valid pointer to a valid 'BlitImageInfo2' structure
--
-- -   #VUID-vkCmdBlitImage2-commandBuffer-recording# @commandBuffer@
--     /must/ be in the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#commandbuffers-lifecycle recording state>
--
-- -   #VUID-vkCmdBlitImage2-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- -   #VUID-vkCmdBlitImage2-renderpass# This command /must/ only be called
--     outside of a render pass instance
--
-- -   #VUID-vkCmdBlitImage2-videocoding# This command /must/ only be
--     called outside of a video coding scope
--
-- == Host Synchronization
--
-- -   Host access to @commandBuffer@ /must/ be externally synchronized
--
-- -   Host access to the 'Vulkan.Core10.Handles.CommandPool' that
--     @commandBuffer@ was allocated from /must/ be externally synchronized
--
-- == Command Properties
--
-- \'
--
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
-- | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkCommandBufferLevel Command Buffer Levels> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginRenderPass Render Pass Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginVideoCodingKHR Video Coding Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkQueueFlagBits Supported Queue Types> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-queueoperation-command-types Command Type> |
-- +============================================================================================================================+========================================================================================================================+=============================================================================================================================+=======================================================================================================================+========================================================================================================================================+
-- | Primary                                                                                                                    | Outside                                                                                                                | Outside                                                                                                                     | Graphics                                                                                                              | Action                                                                                                                                 |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                             |                                                                                                                       |                                                                                                                                        |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_copy_commands2 VK_KHR_copy_commands2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'BlitImageInfo2', 'Vulkan.Core10.Handles.CommandBuffer'
cmdBlitImage2 :: forall io
               . (MonadIO io)
              => -- | @commandBuffer@ is the command buffer into which the command will be
                 -- recorded.
                 CommandBuffer
              -> -- | @pBlitImageInfo@ is a pointer to a 'BlitImageInfo2' structure describing
                 -- the blit parameters.
                 BlitImageInfo2
              -> io ()
cmdBlitImage2 :: forall (io :: * -> *).
MonadIO io =>
CommandBuffer -> BlitImageInfo2 -> io ()
cmdBlitImage2 CommandBuffer
commandBuffer BlitImageInfo2
blitImageInfo = IO () -> io ()
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 vkCmdBlitImage2Ptr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> IO ())
vkCmdBlitImage2Ptr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> IO ())
pVkCmdBlitImage2 (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT () IO ()
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 CommandBuffer_T
   -> ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> IO ())
vkCmdBlitImage2Ptr FunPtr
  (Ptr CommandBuffer_T
   -> ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> IO ())
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 vkCmdBlitImage2 is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdBlitImage2' :: Ptr CommandBuffer_T
-> ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> IO ()
vkCmdBlitImage2' = FunPtr
  (Ptr CommandBuffer_T
   -> ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> IO ())
-> Ptr CommandBuffer_T
-> ("pBlitImageInfo" ::: Ptr BlitImageInfo2)
-> IO ()
mkVkCmdBlitImage2 FunPtr
  (Ptr CommandBuffer_T
   -> ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> IO ())
vkCmdBlitImage2Ptr
  "pBlitImageInfo" ::: Ptr BlitImageInfo2
pBlitImageInfo <- ((("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> IO ()) -> IO ())
-> ContT () IO ("pBlitImageInfo" ::: Ptr BlitImageInfo2)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> IO ()) -> IO ())
 -> ContT () IO ("pBlitImageInfo" ::: Ptr BlitImageInfo2))
-> ((("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> IO ()) -> IO ())
-> ContT () IO ("pBlitImageInfo" ::: Ptr BlitImageInfo2)
forall a b. (a -> b) -> a -> b
$ BlitImageInfo2
-> (("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (BlitImageInfo2
blitImageInfo)
  IO () -> ContT () IO ()
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
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdBlitImage2" (Ptr CommandBuffer_T
-> ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> IO ()
vkCmdBlitImage2'
                                               (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer))
                                               "pBlitImageInfo" ::: Ptr BlitImageInfo2
pBlitImageInfo)
  () -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdCopyBufferToImage2
  :: FunPtr (Ptr CommandBuffer_T -> Ptr CopyBufferToImageInfo2 -> IO ()) -> Ptr CommandBuffer_T -> Ptr CopyBufferToImageInfo2 -> IO ()

-- | vkCmdCopyBufferToImage2 - Copy data from a buffer into an image
--
-- = Description
--
-- This command is functionally identical to
-- 'Vulkan.Core10.CommandBufferBuilding.cmdCopyBufferToImage', but includes
-- extensible sub-structures that include @sType@ and @pNext@ parameters,
-- allowing them to be more easily extended.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdCopyBufferToImage2-commandBuffer-01828# If
--     @commandBuffer@ is an unprotected command buffer and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-protectedNoFault protectedNoFault>
--     is not supported, @srcBuffer@ /must/ not be a protected buffer
--
-- -   #VUID-vkCmdCopyBufferToImage2-commandBuffer-01829# If
--     @commandBuffer@ is an unprotected command buffer and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-protectedNoFault protectedNoFault>
--     is not supported, @dstImage@ /must/ not be a protected image
--
-- -   #VUID-vkCmdCopyBufferToImage2-commandBuffer-01830# If
--     @commandBuffer@ is a protected command buffer and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-protectedNoFault protectedNoFault>
--     is not supported, @dstImage@ /must/ not be an unprotected image
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdCopyBufferToImage2-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdCopyBufferToImage2-pCopyBufferToImageInfo-parameter#
--     @pCopyBufferToImageInfo@ /must/ be a valid pointer to a valid
--     'CopyBufferToImageInfo2' structure
--
-- -   #VUID-vkCmdCopyBufferToImage2-commandBuffer-recording#
--     @commandBuffer@ /must/ be in the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#commandbuffers-lifecycle recording state>
--
-- -   #VUID-vkCmdCopyBufferToImage2-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support transfer, graphics, or compute
--     operations
--
-- -   #VUID-vkCmdCopyBufferToImage2-renderpass# This command /must/ only
--     be called outside of a render pass instance
--
-- -   #VUID-vkCmdCopyBufferToImage2-videocoding# This command /must/ only
--     be called outside of a video coding scope
--
-- == Host Synchronization
--
-- -   Host access to @commandBuffer@ /must/ be externally synchronized
--
-- -   Host access to the 'Vulkan.Core10.Handles.CommandPool' that
--     @commandBuffer@ was allocated from /must/ be externally synchronized
--
-- == Command Properties
--
-- \'
--
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
-- | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkCommandBufferLevel Command Buffer Levels> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginRenderPass Render Pass Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginVideoCodingKHR Video Coding Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkQueueFlagBits Supported Queue Types> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-queueoperation-command-types Command Type> |
-- +============================================================================================================================+========================================================================================================================+=============================================================================================================================+=======================================================================================================================+========================================================================================================================================+
-- | Primary                                                                                                                    | Outside                                                                                                                | Outside                                                                                                                     | Transfer                                                                                                              | Action                                                                                                                                 |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                             | Graphics                                                                                                              |                                                                                                                                        |
-- |                                                                                                                            |                                                                                                                        |                                                                                                                             | Compute                                                                                                               |                                                                                                                                        |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_copy_commands2 VK_KHR_copy_commands2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.Handles.CommandBuffer', 'CopyBufferToImageInfo2'
cmdCopyBufferToImage2 :: forall io
                       . (MonadIO io)
                      => -- | @commandBuffer@ is the command buffer into which the command will be
                         -- recorded.
                         CommandBuffer
                      -> -- | @pCopyBufferToImageInfo@ is a pointer to a 'CopyBufferToImageInfo2'
                         -- structure describing the copy parameters.
                         CopyBufferToImageInfo2
                      -> io ()
cmdCopyBufferToImage2 :: forall (io :: * -> *).
MonadIO io =>
CommandBuffer -> CopyBufferToImageInfo2 -> io ()
cmdCopyBufferToImage2 CommandBuffer
commandBuffer
                        CopyBufferToImageInfo2
copyBufferToImageInfo = IO () -> io ()
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 vkCmdCopyBufferToImage2Ptr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
   -> IO ())
vkCmdCopyBufferToImage2Ptr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
      -> IO ())
pVkCmdCopyBufferToImage2 (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT () IO ()
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 CommandBuffer_T
   -> ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
   -> IO ())
vkCmdCopyBufferToImage2Ptr FunPtr
  (Ptr CommandBuffer_T
   -> ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
   -> IO ())
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 vkCmdCopyBufferToImage2 is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdCopyBufferToImage2' :: Ptr CommandBuffer_T
-> ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
-> IO ()
vkCmdCopyBufferToImage2' = FunPtr
  (Ptr CommandBuffer_T
   -> ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
   -> IO ())
-> Ptr CommandBuffer_T
-> ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
-> IO ()
mkVkCmdCopyBufferToImage2 FunPtr
  (Ptr CommandBuffer_T
   -> ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
   -> IO ())
vkCmdCopyBufferToImage2Ptr
  "pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2
pCopyBufferToImageInfo <- ((("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
  -> IO ())
 -> IO ())
-> ContT
     () IO ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
   -> IO ())
  -> IO ())
 -> ContT
      () IO ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2))
-> ((("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
     -> IO ())
    -> IO ())
-> ContT
     () IO ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
forall a b. (a -> b) -> a -> b
$ CopyBufferToImageInfo2
-> (("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
    -> IO ())
-> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (CopyBufferToImageInfo2
copyBufferToImageInfo)
  IO () -> ContT () IO ()
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
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdCopyBufferToImage2" (Ptr CommandBuffer_T
-> ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
-> IO ()
vkCmdCopyBufferToImage2'
                                                       (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer))
                                                       "pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2
pCopyBufferToImageInfo)
  () -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdCopyImageToBuffer2
  :: FunPtr (Ptr CommandBuffer_T -> Ptr CopyImageToBufferInfo2 -> IO ()) -> Ptr CommandBuffer_T -> Ptr CopyImageToBufferInfo2 -> IO ()

-- | vkCmdCopyImageToBuffer2 - Copy image data into a buffer
--
-- = Description
--
-- This command is functionally identical to
-- 'Vulkan.Core10.CommandBufferBuilding.cmdCopyImageToBuffer', but includes
-- extensible sub-structures that include @sType@ and @pNext@ parameters,
-- allowing them to be more easily extended.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdCopyImageToBuffer2-commandBuffer-01831# If
--     @commandBuffer@ is an unprotected command buffer and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-protectedNoFault protectedNoFault>
--     is not supported, @srcImage@ /must/ not be a protected image
--
-- -   #VUID-vkCmdCopyImageToBuffer2-commandBuffer-01832# If
--     @commandBuffer@ is an unprotected command buffer and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-protectedNoFault protectedNoFault>
--     is not supported, @dstBuffer@ /must/ not be a protected buffer
--
-- -   #VUID-vkCmdCopyImageToBuffer2-commandBuffer-01833# If
--     @commandBuffer@ is a protected command buffer and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-protectedNoFault protectedNoFault>
--     is not supported, @dstBuffer@ /must/ not be an unprotected buffer
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdCopyImageToBuffer2-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdCopyImageToBuffer2-pCopyImageToBufferInfo-parameter#
--     @pCopyImageToBufferInfo@ /must/ be a valid pointer to a valid
--     'CopyImageToBufferInfo2' structure
--
-- -   #VUID-vkCmdCopyImageToBuffer2-commandBuffer-recording#
--     @commandBuffer@ /must/ be in the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#commandbuffers-lifecycle recording state>
--
-- -   #VUID-vkCmdCopyImageToBuffer2-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support transfer, graphics, or compute
--     operations
--
-- -   #VUID-vkCmdCopyImageToBuffer2-renderpass# This command /must/ only
--     be called outside of a render pass instance
--
-- -   #VUID-vkCmdCopyImageToBuffer2-videocoding# This command /must/ only
--     be called outside of a video coding scope
--
-- == Host Synchronization
--
-- -   Host access to @commandBuffer@ /must/ be externally synchronized
--
-- -   Host access to the 'Vulkan.Core10.Handles.CommandPool' that
--     @commandBuffer@ was allocated from /must/ be externally synchronized
--
-- == Command Properties
--
-- \'
--
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
-- | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkCommandBufferLevel Command Buffer Levels> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginRenderPass Render Pass Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginVideoCodingKHR Video Coding Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkQueueFlagBits Supported Queue Types> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-queueoperation-command-types Command Type> |
-- +============================================================================================================================+========================================================================================================================+=============================================================================================================================+=======================================================================================================================+========================================================================================================================================+
-- | Primary                                                                                                                    | Outside                                                                                                                | Outside                                                                                                                     | Transfer                                                                                                              | Action                                                                                                                                 |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                             | Graphics                                                                                                              |                                                                                                                                        |
-- |                                                                                                                            |                                                                                                                        |                                                                                                                             | Compute                                                                                                               |                                                                                                                                        |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_copy_commands2 VK_KHR_copy_commands2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.Handles.CommandBuffer', 'CopyImageToBufferInfo2'
cmdCopyImageToBuffer2 :: forall io
                       . (MonadIO io)
                      => -- | @commandBuffer@ is the command buffer into which the command will be
                         -- recorded.
                         CommandBuffer
                      -> -- | @pCopyImageToBufferInfo@ is a pointer to a 'CopyImageToBufferInfo2'
                         -- structure describing the copy parameters.
                         CopyImageToBufferInfo2
                      -> io ()
cmdCopyImageToBuffer2 :: forall (io :: * -> *).
MonadIO io =>
CommandBuffer -> CopyImageToBufferInfo2 -> io ()
cmdCopyImageToBuffer2 CommandBuffer
commandBuffer
                        CopyImageToBufferInfo2
copyImageToBufferInfo = IO () -> io ()
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 vkCmdCopyImageToBuffer2Ptr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
   -> IO ())
vkCmdCopyImageToBuffer2Ptr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
      -> IO ())
pVkCmdCopyImageToBuffer2 (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT () IO ()
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 CommandBuffer_T
   -> ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
   -> IO ())
vkCmdCopyImageToBuffer2Ptr FunPtr
  (Ptr CommandBuffer_T
   -> ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
   -> IO ())
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 vkCmdCopyImageToBuffer2 is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdCopyImageToBuffer2' :: Ptr CommandBuffer_T
-> ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
-> IO ()
vkCmdCopyImageToBuffer2' = FunPtr
  (Ptr CommandBuffer_T
   -> ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
   -> IO ())
-> Ptr CommandBuffer_T
-> ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
-> IO ()
mkVkCmdCopyImageToBuffer2 FunPtr
  (Ptr CommandBuffer_T
   -> ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
   -> IO ())
vkCmdCopyImageToBuffer2Ptr
  "pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2
pCopyImageToBufferInfo <- ((("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
  -> IO ())
 -> IO ())
-> ContT
     () IO ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
   -> IO ())
  -> IO ())
 -> ContT
      () IO ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2))
-> ((("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
     -> IO ())
    -> IO ())
-> ContT
     () IO ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
forall a b. (a -> b) -> a -> b
$ CopyImageToBufferInfo2
-> (("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
    -> IO ())
-> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (CopyImageToBufferInfo2
copyImageToBufferInfo)
  IO () -> ContT () IO ()
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
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdCopyImageToBuffer2" (Ptr CommandBuffer_T
-> ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
-> IO ()
vkCmdCopyImageToBuffer2'
                                                       (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer))
                                                       "pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2
pCopyImageToBufferInfo)
  () -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdResolveImage2
  :: FunPtr (Ptr CommandBuffer_T -> Ptr ResolveImageInfo2 -> IO ()) -> Ptr CommandBuffer_T -> Ptr ResolveImageInfo2 -> IO ()

-- | vkCmdResolveImage2 - Resolve regions of an image
--
-- = Description
--
-- This command is functionally identical to
-- 'Vulkan.Core10.CommandBufferBuilding.cmdResolveImage', but includes
-- extensible sub-structures that include @sType@ and @pNext@ parameters,
-- allowing them to be more easily extended.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdResolveImage2-commandBuffer-01837# If @commandBuffer@ is
--     an unprotected command buffer and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-protectedNoFault protectedNoFault>
--     is not supported, @srcImage@ /must/ not be a protected image
--
-- -   #VUID-vkCmdResolveImage2-commandBuffer-01838# If @commandBuffer@ is
--     an unprotected command buffer and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-protectedNoFault protectedNoFault>
--     is not supported, @dstImage@ /must/ not be a protected image
--
-- -   #VUID-vkCmdResolveImage2-commandBuffer-01839# If @commandBuffer@ is
--     a protected command buffer and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-protectedNoFault protectedNoFault>
--     is not supported, @dstImage@ /must/ not be an unprotected image
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdResolveImage2-commandBuffer-parameter# @commandBuffer@
--     /must/ be a valid 'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdResolveImage2-pResolveImageInfo-parameter#
--     @pResolveImageInfo@ /must/ be a valid pointer to a valid
--     'ResolveImageInfo2' structure
--
-- -   #VUID-vkCmdResolveImage2-commandBuffer-recording# @commandBuffer@
--     /must/ be in the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#commandbuffers-lifecycle recording state>
--
-- -   #VUID-vkCmdResolveImage2-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- -   #VUID-vkCmdResolveImage2-renderpass# This command /must/ only be
--     called outside of a render pass instance
--
-- -   #VUID-vkCmdResolveImage2-videocoding# This command /must/ only be
--     called outside of a video coding scope
--
-- == Host Synchronization
--
-- -   Host access to @commandBuffer@ /must/ be externally synchronized
--
-- -   Host access to the 'Vulkan.Core10.Handles.CommandPool' that
--     @commandBuffer@ was allocated from /must/ be externally synchronized
--
-- == Command Properties
--
-- \'
--
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
-- | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkCommandBufferLevel Command Buffer Levels> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginRenderPass Render Pass Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginVideoCodingKHR Video Coding Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkQueueFlagBits Supported Queue Types> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-queueoperation-command-types Command Type> |
-- +============================================================================================================================+========================================================================================================================+=============================================================================================================================+=======================================================================================================================+========================================================================================================================================+
-- | Primary                                                                                                                    | Outside                                                                                                                | Outside                                                                                                                     | Graphics                                                                                                              | Action                                                                                                                                 |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                             |                                                                                                                       |                                                                                                                                        |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_copy_commands2 VK_KHR_copy_commands2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.Handles.CommandBuffer', 'ResolveImageInfo2'
cmdResolveImage2 :: forall io
                  . (MonadIO io)
                 => -- | @commandBuffer@ is the command buffer into which the command will be
                    -- recorded.
                    CommandBuffer
                 -> -- | @pResolveImageInfo@ is a pointer to a 'ResolveImageInfo2' structure
                    -- describing the resolve parameters.
                    ResolveImageInfo2
                 -> io ()
cmdResolveImage2 :: forall (io :: * -> *).
MonadIO io =>
CommandBuffer -> ResolveImageInfo2 -> io ()
cmdResolveImage2 CommandBuffer
commandBuffer ResolveImageInfo2
resolveImageInfo = IO () -> io ()
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 vkCmdResolveImage2Ptr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("pResolveImageInfo" ::: Ptr ResolveImageInfo2) -> IO ())
vkCmdResolveImage2Ptr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pResolveImageInfo" ::: Ptr ResolveImageInfo2) -> IO ())
pVkCmdResolveImage2 (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT () IO ()
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 CommandBuffer_T
   -> ("pResolveImageInfo" ::: Ptr ResolveImageInfo2) -> IO ())
vkCmdResolveImage2Ptr FunPtr
  (Ptr CommandBuffer_T
   -> ("pResolveImageInfo" ::: Ptr ResolveImageInfo2) -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pResolveImageInfo" ::: Ptr ResolveImageInfo2) -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("pResolveImageInfo" ::: Ptr ResolveImageInfo2) -> IO ())
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 vkCmdResolveImage2 is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdResolveImage2' :: Ptr CommandBuffer_T
-> ("pResolveImageInfo" ::: Ptr ResolveImageInfo2) -> IO ()
vkCmdResolveImage2' = FunPtr
  (Ptr CommandBuffer_T
   -> ("pResolveImageInfo" ::: Ptr ResolveImageInfo2) -> IO ())
-> Ptr CommandBuffer_T
-> ("pResolveImageInfo" ::: Ptr ResolveImageInfo2)
-> IO ()
mkVkCmdResolveImage2 FunPtr
  (Ptr CommandBuffer_T
   -> ("pResolveImageInfo" ::: Ptr ResolveImageInfo2) -> IO ())
vkCmdResolveImage2Ptr
  "pResolveImageInfo" ::: Ptr ResolveImageInfo2
pResolveImageInfo <- ((("pResolveImageInfo" ::: Ptr ResolveImageInfo2) -> IO ())
 -> IO ())
-> ContT () IO ("pResolveImageInfo" ::: Ptr ResolveImageInfo2)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pResolveImageInfo" ::: Ptr ResolveImageInfo2) -> IO ())
  -> IO ())
 -> ContT () IO ("pResolveImageInfo" ::: Ptr ResolveImageInfo2))
-> ((("pResolveImageInfo" ::: Ptr ResolveImageInfo2) -> IO ())
    -> IO ())
-> ContT () IO ("pResolveImageInfo" ::: Ptr ResolveImageInfo2)
forall a b. (a -> b) -> a -> b
$ ResolveImageInfo2
-> (("pResolveImageInfo" ::: Ptr ResolveImageInfo2) -> IO ())
-> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (ResolveImageInfo2
resolveImageInfo)
  IO () -> ContT () IO ()
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
$ String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdResolveImage2" (Ptr CommandBuffer_T
-> ("pResolveImageInfo" ::: Ptr ResolveImageInfo2) -> IO ()
vkCmdResolveImage2'
                                                  (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer))
                                                  "pResolveImageInfo" ::: Ptr ResolveImageInfo2
pResolveImageInfo)
  () -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()


-- | VkBufferCopy2 - Structure specifying a buffer copy operation
--
-- == Valid Usage
--
-- -   #VUID-VkBufferCopy2-size-01988# The @size@ /must/ be greater than
--     @0@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkBufferCopy2-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_BUFFER_COPY_2'
--
-- -   #VUID-VkBufferCopy2-pNext-pNext# @pNext@ /must/ be @NULL@
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_copy_commands2 VK_KHR_copy_commands2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'CopyBufferInfo2', 'Vulkan.Core10.FundamentalTypes.DeviceSize',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data BufferCopy2 = BufferCopy2
  { -- | @srcOffset@ is the starting offset in bytes from the start of
    -- @srcBuffer@.
    BufferCopy2 -> DeviceSize
srcOffset :: DeviceSize
  , -- | @dstOffset@ is the starting offset in bytes from the start of
    -- @dstBuffer@.
    BufferCopy2 -> DeviceSize
dstOffset :: DeviceSize
  , -- | @size@ is the number of bytes to copy.
    BufferCopy2 -> DeviceSize
size :: DeviceSize
  }
  deriving (Typeable, BufferCopy2 -> BufferCopy2 -> Bool
(BufferCopy2 -> BufferCopy2 -> Bool)
-> (BufferCopy2 -> BufferCopy2 -> Bool) -> Eq BufferCopy2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BufferCopy2 -> BufferCopy2 -> Bool
$c/= :: BufferCopy2 -> BufferCopy2 -> Bool
== :: BufferCopy2 -> BufferCopy2 -> Bool
$c== :: BufferCopy2 -> BufferCopy2 -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (BufferCopy2)
#endif
deriving instance Show BufferCopy2

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

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

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

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


-- | VkImageCopy2 - Structure specifying an image copy operation
--
-- == Valid Usage
--
-- -   #VUID-VkImageCopy2-extent-00140# The number of slices of the
--     @extent@ (for 3D) or layers of the @srcSubresource@ (for non-3D)
--     /must/ match the number of slices of the @extent@ (for 3D) or layers
--     of the @dstSubresource@ (for non-3D)
--
-- -   #VUID-VkImageCopy2-extent-06668# @extent.width@ /must/ not be 0
--
-- -   #VUID-VkImageCopy2-extent-06669# @extent.height@ /must/ not be 0
--
-- -   #VUID-VkImageCopy2-extent-06670# @extent.depth@ /must/ not be 0
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkImageCopy2-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_IMAGE_COPY_2'
--
-- -   #VUID-VkImageCopy2-pNext-pNext# @pNext@ /must/ be @NULL@
--
-- -   #VUID-VkImageCopy2-srcSubresource-parameter# @srcSubresource@ /must/
--     be a valid
--     'Vulkan.Core10.CommandBufferBuilding.ImageSubresourceLayers'
--     structure
--
-- -   #VUID-VkImageCopy2-dstSubresource-parameter# @dstSubresource@ /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_KHR_copy_commands2 VK_KHR_copy_commands2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'CopyImageInfo2', 'Vulkan.Core10.FundamentalTypes.Extent3D',
-- 'Vulkan.Core10.CommandBufferBuilding.ImageSubresourceLayers',
-- 'Vulkan.Core10.FundamentalTypes.Offset3D',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data ImageCopy2 = ImageCopy2
  { -- | @srcSubresource@ and @dstSubresource@ are
    -- 'Vulkan.Core10.CommandBufferBuilding.ImageSubresourceLayers' structures
    -- specifying the image subresources of the images used for the source and
    -- destination image data, respectively.
    ImageCopy2 -> ImageSubresourceLayers
srcSubresource :: ImageSubresourceLayers
  , -- | @srcOffset@ and @dstOffset@ select the initial @x@, @y@, and @z@ offsets
    -- in texels of the sub-regions of the source and destination image data.
    ImageCopy2 -> Offset3D
srcOffset :: Offset3D
  , -- No documentation found for Nested "VkImageCopy2" "dstSubresource"
    ImageCopy2 -> ImageSubresourceLayers
dstSubresource :: ImageSubresourceLayers
  , -- No documentation found for Nested "VkImageCopy2" "dstOffset"
    ImageCopy2 -> Offset3D
dstOffset :: Offset3D
  , -- | @extent@ is the size in texels of the image to copy in @width@, @height@
    -- and @depth@.
    ImageCopy2 -> Extent3D
extent :: Extent3D
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ImageCopy2)
#endif
deriving instance Show ImageCopy2

instance ToCStruct ImageCopy2 where
  withCStruct :: forall b. ImageCopy2 -> (Ptr ImageCopy2 -> IO b) -> IO b
withCStruct ImageCopy2
x Ptr ImageCopy2 -> IO b
f = Int -> (Ptr ImageCopy2 -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
88 ((Ptr ImageCopy2 -> IO b) -> IO b)
-> (Ptr ImageCopy2 -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr ImageCopy2
p -> Ptr ImageCopy2 -> ImageCopy2 -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ImageCopy2
p ImageCopy2
x (Ptr ImageCopy2 -> IO b
f Ptr ImageCopy2
p)
  pokeCStruct :: forall b. Ptr ImageCopy2 -> ImageCopy2 -> IO b -> IO b
pokeCStruct Ptr ImageCopy2
p ImageCopy2{ImageSubresourceLayers
Offset3D
Extent3D
extent :: Extent3D
dstOffset :: Offset3D
dstSubresource :: ImageSubresourceLayers
srcOffset :: Offset3D
srcSubresource :: ImageSubresourceLayers
$sel:extent:ImageCopy2 :: ImageCopy2 -> Extent3D
$sel:dstOffset:ImageCopy2 :: ImageCopy2 -> Offset3D
$sel:dstSubresource:ImageCopy2 :: ImageCopy2 -> ImageSubresourceLayers
$sel:srcOffset:ImageCopy2 :: ImageCopy2 -> Offset3D
$sel:srcSubresource:ImageCopy2 :: ImageCopy2 -> ImageSubresourceLayers
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageCopy2
p Ptr ImageCopy2 -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_COPY_2)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageCopy2
p Ptr ImageCopy2 -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ImageSubresourceLayers -> ImageSubresourceLayers -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageCopy2
p Ptr ImageCopy2 -> Int -> Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageSubresourceLayers)) (ImageSubresourceLayers
srcSubresource)
    Ptr Offset3D -> Offset3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageCopy2
p Ptr ImageCopy2 -> Int -> Ptr Offset3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Offset3D)) (Offset3D
srcOffset)
    Ptr ImageSubresourceLayers -> ImageSubresourceLayers -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageCopy2
p Ptr ImageCopy2 -> Int -> Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr ImageSubresourceLayers)) (ImageSubresourceLayers
dstSubresource)
    Ptr Offset3D -> Offset3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageCopy2
p Ptr ImageCopy2 -> Int -> Ptr Offset3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Offset3D)) (Offset3D
dstOffset)
    Ptr Extent3D -> Extent3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageCopy2
p Ptr ImageCopy2 -> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr Extent3D)) (Extent3D
extent)
    IO b
f
  cStructSize :: Int
cStructSize = Int
88
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr ImageCopy2 -> IO b -> IO b
pokeZeroCStruct Ptr ImageCopy2
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageCopy2
p Ptr ImageCopy2 -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_COPY_2)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageCopy2
p Ptr ImageCopy2 -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ImageSubresourceLayers -> ImageSubresourceLayers -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageCopy2
p Ptr ImageCopy2 -> Int -> Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageSubresourceLayers)) (ImageSubresourceLayers
forall a. Zero a => a
zero)
    Ptr Offset3D -> Offset3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageCopy2
p Ptr ImageCopy2 -> Int -> Ptr Offset3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Offset3D)) (Offset3D
forall a. Zero a => a
zero)
    Ptr ImageSubresourceLayers -> ImageSubresourceLayers -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageCopy2
p Ptr ImageCopy2 -> Int -> Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr ImageSubresourceLayers)) (ImageSubresourceLayers
forall a. Zero a => a
zero)
    Ptr Offset3D -> Offset3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageCopy2
p Ptr ImageCopy2 -> Int -> Ptr Offset3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Offset3D)) (Offset3D
forall a. Zero a => a
zero)
    Ptr Extent3D -> Extent3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageCopy2
p Ptr ImageCopy2 -> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr Extent3D)) (Extent3D
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct ImageCopy2 where
  peekCStruct :: Ptr ImageCopy2 -> IO ImageCopy2
peekCStruct Ptr ImageCopy2
p = do
    ImageSubresourceLayers
srcSubresource <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ImageSubresourceLayers ((Ptr ImageCopy2
p Ptr ImageCopy2 -> Int -> Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageSubresourceLayers))
    Offset3D
srcOffset <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Offset3D ((Ptr ImageCopy2
p Ptr ImageCopy2 -> Int -> Ptr Offset3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Offset3D))
    ImageSubresourceLayers
dstSubresource <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ImageSubresourceLayers ((Ptr ImageCopy2
p Ptr ImageCopy2 -> Int -> Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr ImageSubresourceLayers))
    Offset3D
dstOffset <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Offset3D ((Ptr ImageCopy2
p Ptr ImageCopy2 -> Int -> Ptr Offset3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Offset3D))
    Extent3D
extent <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent3D ((Ptr ImageCopy2
p Ptr ImageCopy2 -> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr Extent3D))
    ImageCopy2 -> IO ImageCopy2
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImageCopy2 -> IO ImageCopy2) -> ImageCopy2 -> IO ImageCopy2
forall a b. (a -> b) -> a -> b
$ ImageSubresourceLayers
-> Offset3D
-> ImageSubresourceLayers
-> Offset3D
-> Extent3D
-> ImageCopy2
ImageCopy2
             ImageSubresourceLayers
srcSubresource Offset3D
srcOffset ImageSubresourceLayers
dstSubresource Offset3D
dstOffset Extent3D
extent

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

instance Zero ImageCopy2 where
  zero :: ImageCopy2
zero = ImageSubresourceLayers
-> Offset3D
-> ImageSubresourceLayers
-> Offset3D
-> Extent3D
-> ImageCopy2
ImageCopy2
           ImageSubresourceLayers
forall a. Zero a => a
zero
           Offset3D
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


-- | VkImageBlit2 - Structure specifying an image blit operation
--
-- = Description
--
-- For each element of the @pRegions@ array, a blit operation is performed
-- for the specified source and destination regions.
--
-- == Valid Usage
--
-- -   #VUID-VkImageBlit2-aspectMask-00238# The @aspectMask@ member of
--     @srcSubresource@ and @dstSubresource@ /must/ match
--
-- -   #VUID-VkImageBlit2-layerCount-00239# The @layerCount@ member of
--     @srcSubresource@ and @dstSubresource@ /must/ match
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkImageBlit2-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_IMAGE_BLIT_2'
--
-- -   #VUID-VkImageBlit2-pNext-pNext# @pNext@ /must/ be @NULL@ or a
--     pointer to a valid instance of
--     'Vulkan.Extensions.VK_QCOM_rotated_copy_commands.CopyCommandTransformInfoQCOM'
--
-- -   #VUID-VkImageBlit2-sType-unique# The @sType@ value of each struct in
--     the @pNext@ chain /must/ be unique
--
-- -   #VUID-VkImageBlit2-srcSubresource-parameter# @srcSubresource@ /must/
--     be a valid
--     'Vulkan.Core10.CommandBufferBuilding.ImageSubresourceLayers'
--     structure
--
-- -   #VUID-VkImageBlit2-dstSubresource-parameter# @dstSubresource@ /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_KHR_copy_commands2 VK_KHR_copy_commands2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'BlitImageInfo2',
-- 'Vulkan.Core10.CommandBufferBuilding.ImageSubresourceLayers',
-- 'Vulkan.Core10.FundamentalTypes.Offset3D',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data ImageBlit2 (es :: [Type]) = ImageBlit2
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    forall (es :: [*]). ImageBlit2 es -> Chain es
next :: Chain es
  , -- | @srcSubresource@ is the subresource to blit from.
    forall (es :: [*]). ImageBlit2 es -> ImageSubresourceLayers
srcSubresource :: ImageSubresourceLayers
  , -- | @srcOffsets@ is a pointer to an array of two
    -- 'Vulkan.Core10.FundamentalTypes.Offset3D' structures specifying the
    -- bounds of the source region within @srcSubresource@.
    forall (es :: [*]). ImageBlit2 es -> (Offset3D, Offset3D)
srcOffsets :: (Offset3D, Offset3D)
  , -- | @dstSubresource@ is the subresource to blit into.
    forall (es :: [*]). ImageBlit2 es -> ImageSubresourceLayers
dstSubresource :: ImageSubresourceLayers
  , -- | @dstOffsets@ is a pointer to an array of two
    -- 'Vulkan.Core10.FundamentalTypes.Offset3D' structures specifying the
    -- bounds of the destination region within @dstSubresource@.
    forall (es :: [*]). ImageBlit2 es -> (Offset3D, Offset3D)
dstOffsets :: (Offset3D, Offset3D)
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ImageBlit2 (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (ImageBlit2 es)

instance Extensible ImageBlit2 where
  extensibleTypeName :: String
extensibleTypeName = String
"ImageBlit2"
  setNext :: forall (ds :: [*]) (es :: [*]).
ImageBlit2 ds -> Chain es -> ImageBlit2 es
setNext ImageBlit2{(Offset3D, Offset3D)
Chain ds
ImageSubresourceLayers
dstOffsets :: (Offset3D, Offset3D)
dstSubresource :: ImageSubresourceLayers
srcOffsets :: (Offset3D, Offset3D)
srcSubresource :: ImageSubresourceLayers
next :: Chain ds
$sel:dstOffsets:ImageBlit2 :: forall (es :: [*]). ImageBlit2 es -> (Offset3D, Offset3D)
$sel:dstSubresource:ImageBlit2 :: forall (es :: [*]). ImageBlit2 es -> ImageSubresourceLayers
$sel:srcOffsets:ImageBlit2 :: forall (es :: [*]). ImageBlit2 es -> (Offset3D, Offset3D)
$sel:srcSubresource:ImageBlit2 :: forall (es :: [*]). ImageBlit2 es -> ImageSubresourceLayers
$sel:next:ImageBlit2 :: forall (es :: [*]). ImageBlit2 es -> Chain es
..} Chain es
next' = ImageBlit2 :: forall (es :: [*]).
Chain es
-> ImageSubresourceLayers
-> (Offset3D, Offset3D)
-> ImageSubresourceLayers
-> (Offset3D, Offset3D)
-> ImageBlit2 es
ImageBlit2{$sel:next:ImageBlit2 :: Chain es
next = Chain es
next', (Offset3D, Offset3D)
ImageSubresourceLayers
dstOffsets :: (Offset3D, Offset3D)
dstSubresource :: ImageSubresourceLayers
srcOffsets :: (Offset3D, Offset3D)
srcSubresource :: ImageSubresourceLayers
$sel:dstOffsets:ImageBlit2 :: (Offset3D, Offset3D)
$sel:dstSubresource:ImageBlit2 :: ImageSubresourceLayers
$sel:srcOffsets:ImageBlit2 :: (Offset3D, Offset3D)
$sel:srcSubresource:ImageBlit2 :: ImageSubresourceLayers
..}
  getNext :: forall (es :: [*]). ImageBlit2 es -> Chain es
getNext ImageBlit2{(Offset3D, Offset3D)
Chain es
ImageSubresourceLayers
dstOffsets :: (Offset3D, Offset3D)
dstSubresource :: ImageSubresourceLayers
srcOffsets :: (Offset3D, Offset3D)
srcSubresource :: ImageSubresourceLayers
next :: Chain es
$sel:dstOffsets:ImageBlit2 :: forall (es :: [*]). ImageBlit2 es -> (Offset3D, Offset3D)
$sel:dstSubresource:ImageBlit2 :: forall (es :: [*]). ImageBlit2 es -> ImageSubresourceLayers
$sel:srcOffsets:ImageBlit2 :: forall (es :: [*]). ImageBlit2 es -> (Offset3D, Offset3D)
$sel:srcSubresource:ImageBlit2 :: forall (es :: [*]). ImageBlit2 es -> ImageSubresourceLayers
$sel:next:ImageBlit2 :: forall (es :: [*]). ImageBlit2 es -> Chain es
..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends ImageBlit2 e => b) -> Maybe b
  extends :: forall e b (proxy :: * -> *).
Typeable e =>
proxy e -> (Extends ImageBlit2 e => b) -> Maybe b
extends proxy e
_ Extends ImageBlit2 e => b
f
    | Just e :~: CopyCommandTransformInfoQCOM
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @e @CopyCommandTransformInfoQCOM = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends ImageBlit2 e => b
f
    | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing

instance ( Extendss ImageBlit2 es
         , PokeChain es ) => ToCStruct (ImageBlit2 es) where
  withCStruct :: forall b. ImageBlit2 es -> (Ptr (ImageBlit2 es) -> IO b) -> IO b
withCStruct ImageBlit2 es
x Ptr (ImageBlit2 es) -> IO b
f = Int -> (Ptr (ImageBlit2 es) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
96 ((Ptr (ImageBlit2 es) -> IO b) -> IO b)
-> (Ptr (ImageBlit2 es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr (ImageBlit2 es)
p -> Ptr (ImageBlit2 es) -> ImageBlit2 es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (ImageBlit2 es)
p ImageBlit2 es
x (Ptr (ImageBlit2 es) -> IO b
f Ptr (ImageBlit2 es)
p)
  pokeCStruct :: forall b. Ptr (ImageBlit2 es) -> ImageBlit2 es -> IO b -> IO b
pokeCStruct Ptr (ImageBlit2 es)
p ImageBlit2{(Offset3D, Offset3D)
Chain es
ImageSubresourceLayers
dstOffsets :: (Offset3D, Offset3D)
dstSubresource :: ImageSubresourceLayers
srcOffsets :: (Offset3D, Offset3D)
srcSubresource :: ImageSubresourceLayers
next :: Chain es
$sel:dstOffsets:ImageBlit2 :: forall (es :: [*]). ImageBlit2 es -> (Offset3D, Offset3D)
$sel:dstSubresource:ImageBlit2 :: forall (es :: [*]). ImageBlit2 es -> ImageSubresourceLayers
$sel:srcOffsets:ImageBlit2 :: forall (es :: [*]). ImageBlit2 es -> (Offset3D, Offset3D)
$sel:srcSubresource:ImageBlit2 :: forall (es :: [*]). ImageBlit2 es -> ImageSubresourceLayers
$sel:next:ImageBlit2 :: forall (es :: [*]). ImageBlit2 es -> Chain es
..} 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 (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 (ImageBlit2 es)
p Ptr (ImageBlit2 es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_BLIT_2)
    Ptr ()
pNext'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
    IO () -> ContT b IO ()
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 (ImageBlit2 es)
p Ptr (ImageBlit2 es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext''
    IO () -> ContT b IO ()
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 ImageSubresourceLayers -> ImageSubresourceLayers -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageBlit2 es)
p Ptr (ImageBlit2 es) -> Int -> Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageSubresourceLayers)) (ImageSubresourceLayers
srcSubresource)
    let pSrcOffsets' :: Ptr Offset3D
pSrcOffsets' = Ptr (FixedArray 2 Offset3D) -> Ptr Offset3D
forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr (ImageBlit2 es)
p Ptr (ImageBlit2 es) -> Int -> Ptr (FixedArray 2 Offset3D)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (FixedArray 2 Offset3D)))
    IO () -> ContT b IO ()
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
$ case ((Offset3D, Offset3D)
srcOffsets) of
      (Offset3D
e0, Offset3D
e1) -> do
        Ptr Offset3D -> Offset3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Offset3D
pSrcOffsets' :: Ptr Offset3D) (Offset3D
e0)
        Ptr Offset3D -> Offset3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Offset3D
pSrcOffsets' Ptr Offset3D -> Int -> Ptr Offset3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Offset3D) (Offset3D
e1)
    IO () -> ContT b IO ()
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 ImageSubresourceLayers -> ImageSubresourceLayers -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageBlit2 es)
p Ptr (ImageBlit2 es) -> Int -> Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr ImageSubresourceLayers)) (ImageSubresourceLayers
dstSubresource)
    let pDstOffsets' :: Ptr Offset3D
pDstOffsets' = Ptr (FixedArray 2 Offset3D) -> Ptr Offset3D
forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr (ImageBlit2 es)
p Ptr (ImageBlit2 es) -> Int -> Ptr (FixedArray 2 Offset3D)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr (FixedArray 2 Offset3D)))
    IO () -> ContT b IO ()
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
$ case ((Offset3D, Offset3D)
dstOffsets) of
      (Offset3D
e0, Offset3D
e1) -> do
        Ptr Offset3D -> Offset3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Offset3D
pDstOffsets' :: Ptr Offset3D) (Offset3D
e0)
        Ptr Offset3D -> Offset3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Offset3D
pDstOffsets' Ptr Offset3D -> Int -> Ptr Offset3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Offset3D) (Offset3D
e1)
    IO b -> ContT b IO b
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
96
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr (ImageBlit2 es) -> IO b -> IO b
pokeZeroCStruct Ptr (ImageBlit2 es)
p 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 (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 (ImageBlit2 es)
p Ptr (ImageBlit2 es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_BLIT_2)
    Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
    IO () -> ContT b IO ()
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 (ImageBlit2 es)
p Ptr (ImageBlit2 es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext'
    IO () -> ContT b IO ()
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 ImageSubresourceLayers -> ImageSubresourceLayers -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageBlit2 es)
p Ptr (ImageBlit2 es) -> Int -> Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageSubresourceLayers)) (ImageSubresourceLayers
forall a. Zero a => a
zero)
    let pSrcOffsets' :: Ptr Offset3D
pSrcOffsets' = Ptr (FixedArray 2 Offset3D) -> Ptr Offset3D
forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr (ImageBlit2 es)
p Ptr (ImageBlit2 es) -> Int -> Ptr (FixedArray 2 Offset3D)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (FixedArray 2 Offset3D)))
    IO () -> ContT b IO ()
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
$ case ((Offset3D
forall a. Zero a => a
zero, Offset3D
forall a. Zero a => a
zero)) of
      (Offset3D
e0, Offset3D
e1) -> do
        Ptr Offset3D -> Offset3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Offset3D
pSrcOffsets' :: Ptr Offset3D) (Offset3D
e0)
        Ptr Offset3D -> Offset3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Offset3D
pSrcOffsets' Ptr Offset3D -> Int -> Ptr Offset3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Offset3D) (Offset3D
e1)
    IO () -> ContT b IO ()
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 ImageSubresourceLayers -> ImageSubresourceLayers -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (ImageBlit2 es)
p Ptr (ImageBlit2 es) -> Int -> Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr ImageSubresourceLayers)) (ImageSubresourceLayers
forall a. Zero a => a
zero)
    let pDstOffsets' :: Ptr Offset3D
pDstOffsets' = Ptr (FixedArray 2 Offset3D) -> Ptr Offset3D
forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr (ImageBlit2 es)
p Ptr (ImageBlit2 es) -> Int -> Ptr (FixedArray 2 Offset3D)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr (FixedArray 2 Offset3D)))
    IO () -> ContT b IO ()
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
$ case ((Offset3D
forall a. Zero a => a
zero, Offset3D
forall a. Zero a => a
zero)) of
      (Offset3D
e0, Offset3D
e1) -> do
        Ptr Offset3D -> Offset3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Offset3D
pDstOffsets' :: Ptr Offset3D) (Offset3D
e0)
        Ptr Offset3D -> Offset3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Offset3D
pDstOffsets' Ptr Offset3D -> Int -> Ptr Offset3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Offset3D) (Offset3D
e1)
    IO b -> ContT b IO b
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

instance ( Extendss ImageBlit2 es
         , PeekChain es ) => FromCStruct (ImageBlit2 es) where
  peekCStruct :: Ptr (ImageBlit2 es) -> IO (ImageBlit2 es)
peekCStruct Ptr (ImageBlit2 es)
p = do
    Ptr ()
pNext <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (ImageBlit2 es)
p Ptr (ImageBlit2 es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ())))
    Chain es
next <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
    ImageSubresourceLayers
srcSubresource <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ImageSubresourceLayers ((Ptr (ImageBlit2 es)
p Ptr (ImageBlit2 es) -> Int -> Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageSubresourceLayers))
    let psrcOffsets :: Ptr Offset3D
psrcOffsets = forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr @Offset3D ((Ptr (ImageBlit2 es)
p Ptr (ImageBlit2 es) -> Int -> Ptr (FixedArray 2 Offset3D)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (FixedArray 2 Offset3D)))
    Offset3D
srcOffsets0 <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Offset3D ((Ptr Offset3D
psrcOffsets Ptr Offset3D -> Int -> Ptr Offset3D
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` Int
0 :: Ptr Offset3D))
    Offset3D
srcOffsets1 <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Offset3D ((Ptr Offset3D
psrcOffsets Ptr Offset3D -> Int -> Ptr Offset3D
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` Int
12 :: Ptr Offset3D))
    ImageSubresourceLayers
dstSubresource <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ImageSubresourceLayers ((Ptr (ImageBlit2 es)
p Ptr (ImageBlit2 es) -> Int -> Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr ImageSubresourceLayers))
    let pdstOffsets :: Ptr Offset3D
pdstOffsets = forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr @Offset3D ((Ptr (ImageBlit2 es)
p Ptr (ImageBlit2 es) -> Int -> Ptr (FixedArray 2 Offset3D)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr (FixedArray 2 Offset3D)))
    Offset3D
dstOffsets0 <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Offset3D ((Ptr Offset3D
pdstOffsets Ptr Offset3D -> Int -> Ptr Offset3D
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` Int
0 :: Ptr Offset3D))
    Offset3D
dstOffsets1 <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Offset3D ((Ptr Offset3D
pdstOffsets Ptr Offset3D -> Int -> Ptr Offset3D
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` Int
12 :: Ptr Offset3D))
    ImageBlit2 es -> IO (ImageBlit2 es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImageBlit2 es -> IO (ImageBlit2 es))
-> ImageBlit2 es -> IO (ImageBlit2 es)
forall a b. (a -> b) -> a -> b
$ Chain es
-> ImageSubresourceLayers
-> (Offset3D, Offset3D)
-> ImageSubresourceLayers
-> (Offset3D, Offset3D)
-> ImageBlit2 es
forall (es :: [*]).
Chain es
-> ImageSubresourceLayers
-> (Offset3D, Offset3D)
-> ImageSubresourceLayers
-> (Offset3D, Offset3D)
-> ImageBlit2 es
ImageBlit2
             Chain es
next
             ImageSubresourceLayers
srcSubresource
             ((Offset3D
srcOffsets0, Offset3D
srcOffsets1))
             ImageSubresourceLayers
dstSubresource
             ((Offset3D
dstOffsets0, Offset3D
dstOffsets1))

instance es ~ '[] => Zero (ImageBlit2 es) where
  zero :: ImageBlit2 es
zero = Chain es
-> ImageSubresourceLayers
-> (Offset3D, Offset3D)
-> ImageSubresourceLayers
-> (Offset3D, Offset3D)
-> ImageBlit2 es
forall (es :: [*]).
Chain es
-> ImageSubresourceLayers
-> (Offset3D, Offset3D)
-> ImageSubresourceLayers
-> (Offset3D, Offset3D)
-> ImageBlit2 es
ImageBlit2
           ()
           ImageSubresourceLayers
forall a. Zero a => a
zero
           (Offset3D
forall a. Zero a => a
zero, Offset3D
forall a. Zero a => a
zero)
           ImageSubresourceLayers
forall a. Zero a => a
zero
           (Offset3D
forall a. Zero a => a
zero, Offset3D
forall a. Zero a => a
zero)


-- | VkBufferImageCopy2 - Structure specifying a buffer image copy operation
--
-- = Description
--
-- This structure is functionally identical to
-- 'Vulkan.Core10.CommandBufferBuilding.BufferImageCopy', but adds @sType@
-- and @pNext@ parameters, allowing it to be more easily extended.
--
-- == Valid Usage
--
-- -   #VUID-VkBufferImageCopy2-bufferRowLength-00195# @bufferRowLength@
--     /must/ be @0@, or greater than or equal to the @width@ member of
--     @imageExtent@
--
-- -   #VUID-VkBufferImageCopy2-bufferImageHeight-00196#
--     @bufferImageHeight@ /must/ be @0@, or greater than or equal to the
--     @height@ member of @imageExtent@
--
-- -   #VUID-VkBufferImageCopy2-aspectMask-00212# The @aspectMask@ member
--     of @imageSubresource@ /must/ only have a single bit set
--
-- -   #VUID-VkBufferImageCopy2-imageExtent-06659# @imageExtent.width@
--     /must/ not be 0
--
-- -   #VUID-VkBufferImageCopy2-imageExtent-06660# @imageExtent.height@
--     /must/ not be 0
--
-- -   #VUID-VkBufferImageCopy2-imageExtent-06661# @imageExtent.depth@
--     /must/ not be 0
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkBufferImageCopy2-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_BUFFER_IMAGE_COPY_2'
--
-- -   #VUID-VkBufferImageCopy2-pNext-pNext# @pNext@ /must/ be @NULL@ or a
--     pointer to a valid instance of
--     'Vulkan.Extensions.VK_QCOM_rotated_copy_commands.CopyCommandTransformInfoQCOM'
--
-- -   #VUID-VkBufferImageCopy2-sType-unique# The @sType@ value of each
--     struct in the @pNext@ chain /must/ be unique
--
-- -   #VUID-VkBufferImageCopy2-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_KHR_copy_commands2 VK_KHR_copy_commands2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'CopyBufferToImageInfo2', 'CopyImageToBufferInfo2',
-- 'Vulkan.Core10.FundamentalTypes.DeviceSize',
-- 'Vulkan.Core10.FundamentalTypes.Extent3D',
-- 'Vulkan.Core10.CommandBufferBuilding.ImageSubresourceLayers',
-- 'Vulkan.Core10.FundamentalTypes.Offset3D',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data BufferImageCopy2 (es :: [Type]) = BufferImageCopy2
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    forall (es :: [*]). BufferImageCopy2 es -> Chain es
next :: Chain es
  , -- | @bufferOffset@ is the offset in bytes from the start of the buffer
    -- object where the image data is copied from or to.
    forall (es :: [*]). BufferImageCopy2 es -> DeviceSize
bufferOffset :: DeviceSize
  , -- | @bufferRowLength@ and @bufferImageHeight@ specify in texels a subregion
    -- of a larger two- or three-dimensional image in buffer memory, and
    -- control the addressing calculations. If either of these values is zero,
    -- that aspect of the buffer memory is considered to be tightly packed
    -- according to the @imageExtent@.
    forall (es :: [*]). BufferImageCopy2 es -> Word32
bufferRowLength :: Word32
  , -- No documentation found for Nested "VkBufferImageCopy2" "bufferImageHeight"
    forall (es :: [*]). BufferImageCopy2 es -> Word32
bufferImageHeight :: 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.
    forall (es :: [*]). BufferImageCopy2 es -> ImageSubresourceLayers
imageSubresource :: ImageSubresourceLayers
  , -- | @imageOffset@ selects the initial @x@, @y@, @z@ offsets in texels of the
    -- sub-region of the source or destination image data.
    forall (es :: [*]). BufferImageCopy2 es -> Offset3D
imageOffset :: Offset3D
  , -- | @imageExtent@ is the size in texels of the image to copy in @width@,
    -- @height@ and @depth@.
    forall (es :: [*]). BufferImageCopy2 es -> Extent3D
imageExtent :: Extent3D
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (BufferImageCopy2 (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (BufferImageCopy2 es)

instance Extensible BufferImageCopy2 where
  extensibleTypeName :: String
extensibleTypeName = String
"BufferImageCopy2"
  setNext :: forall (ds :: [*]) (es :: [*]).
BufferImageCopy2 ds -> Chain es -> BufferImageCopy2 es
setNext BufferImageCopy2{Word32
DeviceSize
Chain ds
ImageSubresourceLayers
Offset3D
Extent3D
imageExtent :: Extent3D
imageOffset :: Offset3D
imageSubresource :: ImageSubresourceLayers
bufferImageHeight :: Word32
bufferRowLength :: Word32
bufferOffset :: DeviceSize
next :: Chain ds
$sel:imageExtent:BufferImageCopy2 :: forall (es :: [*]). BufferImageCopy2 es -> Extent3D
$sel:imageOffset:BufferImageCopy2 :: forall (es :: [*]). BufferImageCopy2 es -> Offset3D
$sel:imageSubresource:BufferImageCopy2 :: forall (es :: [*]). BufferImageCopy2 es -> ImageSubresourceLayers
$sel:bufferImageHeight:BufferImageCopy2 :: forall (es :: [*]). BufferImageCopy2 es -> Word32
$sel:bufferRowLength:BufferImageCopy2 :: forall (es :: [*]). BufferImageCopy2 es -> Word32
$sel:bufferOffset:BufferImageCopy2 :: forall (es :: [*]). BufferImageCopy2 es -> DeviceSize
$sel:next:BufferImageCopy2 :: forall (es :: [*]). BufferImageCopy2 es -> Chain es
..} Chain es
next' = BufferImageCopy2 :: forall (es :: [*]).
Chain es
-> DeviceSize
-> Word32
-> Word32
-> ImageSubresourceLayers
-> Offset3D
-> Extent3D
-> BufferImageCopy2 es
BufferImageCopy2{$sel:next:BufferImageCopy2 :: Chain es
next = Chain es
next', Word32
DeviceSize
ImageSubresourceLayers
Offset3D
Extent3D
imageExtent :: Extent3D
imageOffset :: Offset3D
imageSubresource :: ImageSubresourceLayers
bufferImageHeight :: Word32
bufferRowLength :: Word32
bufferOffset :: DeviceSize
$sel:imageExtent:BufferImageCopy2 :: Extent3D
$sel:imageOffset:BufferImageCopy2 :: Offset3D
$sel:imageSubresource:BufferImageCopy2 :: ImageSubresourceLayers
$sel:bufferImageHeight:BufferImageCopy2 :: Word32
$sel:bufferRowLength:BufferImageCopy2 :: Word32
$sel:bufferOffset:BufferImageCopy2 :: DeviceSize
..}
  getNext :: forall (es :: [*]). BufferImageCopy2 es -> Chain es
getNext BufferImageCopy2{Word32
DeviceSize
Chain es
ImageSubresourceLayers
Offset3D
Extent3D
imageExtent :: Extent3D
imageOffset :: Offset3D
imageSubresource :: ImageSubresourceLayers
bufferImageHeight :: Word32
bufferRowLength :: Word32
bufferOffset :: DeviceSize
next :: Chain es
$sel:imageExtent:BufferImageCopy2 :: forall (es :: [*]). BufferImageCopy2 es -> Extent3D
$sel:imageOffset:BufferImageCopy2 :: forall (es :: [*]). BufferImageCopy2 es -> Offset3D
$sel:imageSubresource:BufferImageCopy2 :: forall (es :: [*]). BufferImageCopy2 es -> ImageSubresourceLayers
$sel:bufferImageHeight:BufferImageCopy2 :: forall (es :: [*]). BufferImageCopy2 es -> Word32
$sel:bufferRowLength:BufferImageCopy2 :: forall (es :: [*]). BufferImageCopy2 es -> Word32
$sel:bufferOffset:BufferImageCopy2 :: forall (es :: [*]). BufferImageCopy2 es -> DeviceSize
$sel:next:BufferImageCopy2 :: forall (es :: [*]). BufferImageCopy2 es -> Chain es
..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends BufferImageCopy2 e => b) -> Maybe b
  extends :: forall e b (proxy :: * -> *).
Typeable e =>
proxy e -> (Extends BufferImageCopy2 e => b) -> Maybe b
extends proxy e
_ Extends BufferImageCopy2 e => b
f
    | Just e :~: CopyCommandTransformInfoQCOM
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @e @CopyCommandTransformInfoQCOM = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends BufferImageCopy2 e => b
f
    | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing

instance ( Extendss BufferImageCopy2 es
         , PokeChain es ) => ToCStruct (BufferImageCopy2 es) where
  withCStruct :: forall b.
BufferImageCopy2 es -> (Ptr (BufferImageCopy2 es) -> IO b) -> IO b
withCStruct BufferImageCopy2 es
x Ptr (BufferImageCopy2 es) -> IO b
f = Int -> (Ptr (BufferImageCopy2 es) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
72 ((Ptr (BufferImageCopy2 es) -> IO b) -> IO b)
-> (Ptr (BufferImageCopy2 es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr (BufferImageCopy2 es)
p -> Ptr (BufferImageCopy2 es) -> BufferImageCopy2 es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (BufferImageCopy2 es)
p BufferImageCopy2 es
x (Ptr (BufferImageCopy2 es) -> IO b
f Ptr (BufferImageCopy2 es)
p)
  pokeCStruct :: forall b.
Ptr (BufferImageCopy2 es) -> BufferImageCopy2 es -> IO b -> IO b
pokeCStruct Ptr (BufferImageCopy2 es)
p BufferImageCopy2{Word32
DeviceSize
Chain es
ImageSubresourceLayers
Offset3D
Extent3D
imageExtent :: Extent3D
imageOffset :: Offset3D
imageSubresource :: ImageSubresourceLayers
bufferImageHeight :: Word32
bufferRowLength :: Word32
bufferOffset :: DeviceSize
next :: Chain es
$sel:imageExtent:BufferImageCopy2 :: forall (es :: [*]). BufferImageCopy2 es -> Extent3D
$sel:imageOffset:BufferImageCopy2 :: forall (es :: [*]). BufferImageCopy2 es -> Offset3D
$sel:imageSubresource:BufferImageCopy2 :: forall (es :: [*]). BufferImageCopy2 es -> ImageSubresourceLayers
$sel:bufferImageHeight:BufferImageCopy2 :: forall (es :: [*]). BufferImageCopy2 es -> Word32
$sel:bufferRowLength:BufferImageCopy2 :: forall (es :: [*]). BufferImageCopy2 es -> Word32
$sel:bufferOffset:BufferImageCopy2 :: forall (es :: [*]). BufferImageCopy2 es -> DeviceSize
$sel:next:BufferImageCopy2 :: forall (es :: [*]). BufferImageCopy2 es -> Chain es
..} 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 (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 (BufferImageCopy2 es)
p Ptr (BufferImageCopy2 es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_BUFFER_IMAGE_COPY_2)
    Ptr ()
pNext'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
    IO () -> ContT b IO ()
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 (BufferImageCopy2 es)
p Ptr (BufferImageCopy2 es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext''
    IO () -> ContT b IO ()
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 DeviceSize -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferImageCopy2 es)
p Ptr (BufferImageCopy2 es) -> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceSize)) (DeviceSize
bufferOffset)
    IO () -> ContT b IO ()
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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferImageCopy2 es)
p Ptr (BufferImageCopy2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Word32
bufferRowLength)
    IO () -> ContT b IO ()
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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferImageCopy2 es)
p Ptr (BufferImageCopy2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (Word32
bufferImageHeight)
    IO () -> ContT b IO ()
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 ImageSubresourceLayers -> ImageSubresourceLayers -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferImageCopy2 es)
p Ptr (BufferImageCopy2 es) -> Int -> Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageSubresourceLayers)) (ImageSubresourceLayers
imageSubresource)
    IO () -> ContT b IO ()
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 Offset3D -> Offset3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferImageCopy2 es)
p Ptr (BufferImageCopy2 es) -> Int -> Ptr Offset3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Offset3D)) (Offset3D
imageOffset)
    IO () -> ContT b IO ()
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 Extent3D -> Extent3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferImageCopy2 es)
p Ptr (BufferImageCopy2 es) -> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Extent3D)) (Extent3D
imageExtent)
    IO b -> ContT b IO b
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
72
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr (BufferImageCopy2 es) -> IO b -> IO b
pokeZeroCStruct Ptr (BufferImageCopy2 es)
p 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 (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 (BufferImageCopy2 es)
p Ptr (BufferImageCopy2 es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_BUFFER_IMAGE_COPY_2)
    Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
    IO () -> ContT b IO ()
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 (BufferImageCopy2 es)
p Ptr (BufferImageCopy2 es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext'
    IO () -> ContT b IO ()
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 DeviceSize -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferImageCopy2 es)
p Ptr (BufferImageCopy2 es) -> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceSize)) (DeviceSize
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferImageCopy2 es)
p Ptr (BufferImageCopy2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferImageCopy2 es)
p Ptr (BufferImageCopy2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
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 ImageSubresourceLayers -> ImageSubresourceLayers -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferImageCopy2 es)
p Ptr (BufferImageCopy2 es) -> Int -> Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageSubresourceLayers)) (ImageSubresourceLayers
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
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 Offset3D -> Offset3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferImageCopy2 es)
p Ptr (BufferImageCopy2 es) -> Int -> Ptr Offset3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Offset3D)) (Offset3D
forall a. Zero a => a
zero)
    IO () -> ContT b IO ()
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 Extent3D -> Extent3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (BufferImageCopy2 es)
p Ptr (BufferImageCopy2 es) -> 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 -> ContT b IO b
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

instance ( Extendss BufferImageCopy2 es
         , PeekChain es ) => FromCStruct (BufferImageCopy2 es) where
  peekCStruct :: Ptr (BufferImageCopy2 es) -> IO (BufferImageCopy2 es)
peekCStruct Ptr (BufferImageCopy2 es)
p = do
    Ptr ()
pNext <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (BufferImageCopy2 es)
p Ptr (BufferImageCopy2 es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ())))
    Chain es
next <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
    DeviceSize
bufferOffset <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr (BufferImageCopy2 es)
p Ptr (BufferImageCopy2 es) -> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr DeviceSize))
    Word32
bufferRowLength <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (BufferImageCopy2 es)
p Ptr (BufferImageCopy2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32))
    Word32
bufferImageHeight <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (BufferImageCopy2 es)
p Ptr (BufferImageCopy2 es) -> Int -> Ptr Word32
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 (BufferImageCopy2 es)
p Ptr (BufferImageCopy2 es) -> 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 (BufferImageCopy2 es)
p Ptr (BufferImageCopy2 es) -> 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 (BufferImageCopy2 es)
p Ptr (BufferImageCopy2 es) -> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Extent3D))
    BufferImageCopy2 es -> IO (BufferImageCopy2 es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BufferImageCopy2 es -> IO (BufferImageCopy2 es))
-> BufferImageCopy2 es -> IO (BufferImageCopy2 es)
forall a b. (a -> b) -> a -> b
$ Chain es
-> DeviceSize
-> Word32
-> Word32
-> ImageSubresourceLayers
-> Offset3D
-> Extent3D
-> BufferImageCopy2 es
forall (es :: [*]).
Chain es
-> DeviceSize
-> Word32
-> Word32
-> ImageSubresourceLayers
-> Offset3D
-> Extent3D
-> BufferImageCopy2 es
BufferImageCopy2
             Chain es
next
             DeviceSize
bufferOffset
             Word32
bufferRowLength
             Word32
bufferImageHeight
             ImageSubresourceLayers
imageSubresource
             Offset3D
imageOffset
             Extent3D
imageExtent

instance es ~ '[] => Zero (BufferImageCopy2 es) where
  zero :: BufferImageCopy2 es
zero = Chain es
-> DeviceSize
-> Word32
-> Word32
-> ImageSubresourceLayers
-> Offset3D
-> Extent3D
-> BufferImageCopy2 es
forall (es :: [*]).
Chain es
-> DeviceSize
-> Word32
-> Word32
-> ImageSubresourceLayers
-> Offset3D
-> Extent3D
-> BufferImageCopy2 es
BufferImageCopy2
           ()
           DeviceSize
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Word32
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


-- | VkImageResolve2 - Structure specifying an image resolve operation
--
-- == Valid Usage
--
-- -   #VUID-VkImageResolve2-aspectMask-00266# The @aspectMask@ member of
--     @srcSubresource@ and @dstSubresource@ /must/ only contain
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_COLOR_BIT'
--
-- -   #VUID-VkImageResolve2-layerCount-00267# The @layerCount@ member of
--     @srcSubresource@ and @dstSubresource@ /must/ match
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkImageResolve2-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_IMAGE_RESOLVE_2'
--
-- -   #VUID-VkImageResolve2-pNext-pNext# @pNext@ /must/ be @NULL@
--
-- -   #VUID-VkImageResolve2-srcSubresource-parameter# @srcSubresource@
--     /must/ be a valid
--     'Vulkan.Core10.CommandBufferBuilding.ImageSubresourceLayers'
--     structure
--
-- -   #VUID-VkImageResolve2-dstSubresource-parameter# @dstSubresource@
--     /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_KHR_copy_commands2 VK_KHR_copy_commands2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.FundamentalTypes.Extent3D',
-- 'Vulkan.Core10.CommandBufferBuilding.ImageSubresourceLayers',
-- 'Vulkan.Core10.FundamentalTypes.Offset3D', 'ResolveImageInfo2',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data ImageResolve2 = ImageResolve2
  { -- | @srcSubresource@ and @dstSubresource@ are
    -- 'Vulkan.Core10.CommandBufferBuilding.ImageSubresourceLayers' structures
    -- specifying the image subresources of the images used for the source and
    -- destination image data, respectively. Resolve of depth\/stencil images
    -- is not supported.
    ImageResolve2 -> ImageSubresourceLayers
srcSubresource :: ImageSubresourceLayers
  , -- | @srcOffset@ and @dstOffset@ select the initial @x@, @y@, and @z@ offsets
    -- in texels of the sub-regions of the source and destination image data.
    ImageResolve2 -> Offset3D
srcOffset :: Offset3D
  , -- No documentation found for Nested "VkImageResolve2" "dstSubresource"
    ImageResolve2 -> ImageSubresourceLayers
dstSubresource :: ImageSubresourceLayers
  , -- No documentation found for Nested "VkImageResolve2" "dstOffset"
    ImageResolve2 -> Offset3D
dstOffset :: Offset3D
  , -- | @extent@ is the size in texels of the source image to resolve in
    -- @width@, @height@ and @depth@.
    ImageResolve2 -> Extent3D
extent :: Extent3D
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ImageResolve2)
#endif
deriving instance Show ImageResolve2

instance ToCStruct ImageResolve2 where
  withCStruct :: forall b. ImageResolve2 -> (Ptr ImageResolve2 -> IO b) -> IO b
withCStruct ImageResolve2
x Ptr ImageResolve2 -> IO b
f = Int -> (Ptr ImageResolve2 -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
88 ((Ptr ImageResolve2 -> IO b) -> IO b)
-> (Ptr ImageResolve2 -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr ImageResolve2
p -> Ptr ImageResolve2 -> ImageResolve2 -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ImageResolve2
p ImageResolve2
x (Ptr ImageResolve2 -> IO b
f Ptr ImageResolve2
p)
  pokeCStruct :: forall b. Ptr ImageResolve2 -> ImageResolve2 -> IO b -> IO b
pokeCStruct Ptr ImageResolve2
p ImageResolve2{ImageSubresourceLayers
Offset3D
Extent3D
extent :: Extent3D
dstOffset :: Offset3D
dstSubresource :: ImageSubresourceLayers
srcOffset :: Offset3D
srcSubresource :: ImageSubresourceLayers
$sel:extent:ImageResolve2 :: ImageResolve2 -> Extent3D
$sel:dstOffset:ImageResolve2 :: ImageResolve2 -> Offset3D
$sel:dstSubresource:ImageResolve2 :: ImageResolve2 -> ImageSubresourceLayers
$sel:srcOffset:ImageResolve2 :: ImageResolve2 -> Offset3D
$sel:srcSubresource:ImageResolve2 :: ImageResolve2 -> ImageSubresourceLayers
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageResolve2
p Ptr ImageResolve2 -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_RESOLVE_2)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageResolve2
p Ptr ImageResolve2 -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ImageSubresourceLayers -> ImageSubresourceLayers -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageResolve2
p Ptr ImageResolve2 -> Int -> Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageSubresourceLayers)) (ImageSubresourceLayers
srcSubresource)
    Ptr Offset3D -> Offset3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageResolve2
p Ptr ImageResolve2 -> Int -> Ptr Offset3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Offset3D)) (Offset3D
srcOffset)
    Ptr ImageSubresourceLayers -> ImageSubresourceLayers -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageResolve2
p Ptr ImageResolve2 -> Int -> Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr ImageSubresourceLayers)) (ImageSubresourceLayers
dstSubresource)
    Ptr Offset3D -> Offset3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageResolve2
p Ptr ImageResolve2 -> Int -> Ptr Offset3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Offset3D)) (Offset3D
dstOffset)
    Ptr Extent3D -> Extent3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageResolve2
p Ptr ImageResolve2 -> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr Extent3D)) (Extent3D
extent)
    IO b
f
  cStructSize :: Int
cStructSize = Int
88
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr ImageResolve2 -> IO b -> IO b
pokeZeroCStruct Ptr ImageResolve2
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageResolve2
p Ptr ImageResolve2 -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_IMAGE_RESOLVE_2)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageResolve2
p Ptr ImageResolve2 -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ImageSubresourceLayers -> ImageSubresourceLayers -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageResolve2
p Ptr ImageResolve2 -> Int -> Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageSubresourceLayers)) (ImageSubresourceLayers
forall a. Zero a => a
zero)
    Ptr Offset3D -> Offset3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageResolve2
p Ptr ImageResolve2 -> Int -> Ptr Offset3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Offset3D)) (Offset3D
forall a. Zero a => a
zero)
    Ptr ImageSubresourceLayers -> ImageSubresourceLayers -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageResolve2
p Ptr ImageResolve2 -> Int -> Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr ImageSubresourceLayers)) (ImageSubresourceLayers
forall a. Zero a => a
zero)
    Ptr Offset3D -> Offset3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageResolve2
p Ptr ImageResolve2 -> Int -> Ptr Offset3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Offset3D)) (Offset3D
forall a. Zero a => a
zero)
    Ptr Extent3D -> Extent3D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ImageResolve2
p Ptr ImageResolve2 -> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr Extent3D)) (Extent3D
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct ImageResolve2 where
  peekCStruct :: Ptr ImageResolve2 -> IO ImageResolve2
peekCStruct Ptr ImageResolve2
p = do
    ImageSubresourceLayers
srcSubresource <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ImageSubresourceLayers ((Ptr ImageResolve2
p Ptr ImageResolve2 -> Int -> Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageSubresourceLayers))
    Offset3D
srcOffset <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Offset3D ((Ptr ImageResolve2
p Ptr ImageResolve2 -> Int -> Ptr Offset3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Offset3D))
    ImageSubresourceLayers
dstSubresource <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ImageSubresourceLayers ((Ptr ImageResolve2
p Ptr ImageResolve2 -> Int -> Ptr ImageSubresourceLayers
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr ImageSubresourceLayers))
    Offset3D
dstOffset <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Offset3D ((Ptr ImageResolve2
p Ptr ImageResolve2 -> Int -> Ptr Offset3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Offset3D))
    Extent3D
extent <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent3D ((Ptr ImageResolve2
p Ptr ImageResolve2 -> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr Extent3D))
    ImageResolve2 -> IO ImageResolve2
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImageResolve2 -> IO ImageResolve2)
-> ImageResolve2 -> IO ImageResolve2
forall a b. (a -> b) -> a -> b
$ ImageSubresourceLayers
-> Offset3D
-> ImageSubresourceLayers
-> Offset3D
-> Extent3D
-> ImageResolve2
ImageResolve2
             ImageSubresourceLayers
srcSubresource Offset3D
srcOffset ImageSubresourceLayers
dstSubresource Offset3D
dstOffset Extent3D
extent

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

instance Zero ImageResolve2 where
  zero :: ImageResolve2
zero = ImageSubresourceLayers
-> Offset3D
-> ImageSubresourceLayers
-> Offset3D
-> Extent3D
-> ImageResolve2
ImageResolve2
           ImageSubresourceLayers
forall a. Zero a => a
zero
           Offset3D
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


-- | VkCopyBufferInfo2 - Structure specifying parameters of a buffer copy
-- command
--
-- = Description
--
-- Members defined by this structure with the same name as parameters in
-- 'Vulkan.Core10.CommandBufferBuilding.cmdCopyBuffer' have the identical
-- effect to those parameters; the child structure 'BufferCopy2' is a
-- variant of 'Vulkan.Core10.CommandBufferBuilding.BufferCopy' which
-- includes @sType@ and @pNext@ parameters, allowing it to be extended.
--
-- == Valid Usage
--
-- -   #VUID-VkCopyBufferInfo2-srcOffset-00113# The @srcOffset@ member of
--     each element of @pRegions@ /must/ be less than the size of
--     @srcBuffer@
--
-- -   #VUID-VkCopyBufferInfo2-dstOffset-00114# The @dstOffset@ member of
--     each element of @pRegions@ /must/ be less than the size of
--     @dstBuffer@
--
-- -   #VUID-VkCopyBufferInfo2-size-00115# The @size@ member of each
--     element of @pRegions@ /must/ be less than or equal to the size of
--     @srcBuffer@ minus @srcOffset@
--
-- -   #VUID-VkCopyBufferInfo2-size-00116# The @size@ member of each
--     element of @pRegions@ /must/ be less than or equal to the size of
--     @dstBuffer@ minus @dstOffset@
--
-- -   #VUID-VkCopyBufferInfo2-pRegions-00117# The union of the source
--     regions, and the union of the destination regions, specified by the
--     elements of @pRegions@, /must/ not overlap in memory
--
-- -   #VUID-VkCopyBufferInfo2-srcBuffer-00118# @srcBuffer@ /must/ have
--     been created with
--     'Vulkan.Core10.Enums.BufferUsageFlagBits.BUFFER_USAGE_TRANSFER_SRC_BIT'
--     usage flag
--
-- -   #VUID-VkCopyBufferInfo2-srcBuffer-00119# If @srcBuffer@ is
--     non-sparse then it /must/ be bound completely and contiguously to a
--     single 'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   #VUID-VkCopyBufferInfo2-dstBuffer-00120# @dstBuffer@ /must/ have
--     been created with
--     'Vulkan.Core10.Enums.BufferUsageFlagBits.BUFFER_USAGE_TRANSFER_DST_BIT'
--     usage flag
--
-- -   #VUID-VkCopyBufferInfo2-dstBuffer-00121# If @dstBuffer@ is
--     non-sparse then it /must/ be bound completely and contiguously to a
--     single 'Vulkan.Core10.Handles.DeviceMemory' object
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkCopyBufferInfo2-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_COPY_BUFFER_INFO_2'
--
-- -   #VUID-VkCopyBufferInfo2-pNext-pNext# @pNext@ /must/ be @NULL@
--
-- -   #VUID-VkCopyBufferInfo2-srcBuffer-parameter# @srcBuffer@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Buffer' handle
--
-- -   #VUID-VkCopyBufferInfo2-dstBuffer-parameter# @dstBuffer@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Buffer' handle
--
-- -   #VUID-VkCopyBufferInfo2-pRegions-parameter# @pRegions@ /must/ be a
--     valid pointer to an array of @regionCount@ valid 'BufferCopy2'
--     structures
--
-- -   #VUID-VkCopyBufferInfo2-regionCount-arraylength# @regionCount@
--     /must/ be greater than @0@
--
-- -   #VUID-VkCopyBufferInfo2-commonparent# Both of @dstBuffer@, and
--     @srcBuffer@ /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_KHR_copy_commands2 VK_KHR_copy_commands2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.Handles.Buffer', 'BufferCopy2',
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'cmdCopyBuffer2',
-- 'Vulkan.Extensions.VK_KHR_copy_commands2.cmdCopyBuffer2KHR'
data CopyBufferInfo2 = CopyBufferInfo2
  { -- | @srcBuffer@ is the source buffer.
    CopyBufferInfo2 -> Buffer
srcBuffer :: Buffer
  , -- | @dstBuffer@ is the destination buffer.
    CopyBufferInfo2 -> Buffer
dstBuffer :: Buffer
  , -- | @pRegions@ is a pointer to an array of 'BufferCopy2' structures
    -- specifying the regions to copy.
    CopyBufferInfo2 -> Vector BufferCopy2
regions :: Vector BufferCopy2
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CopyBufferInfo2)
#endif
deriving instance Show CopyBufferInfo2

instance ToCStruct CopyBufferInfo2 where
  withCStruct :: forall b.
CopyBufferInfo2
-> (("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> IO b) -> IO b
withCStruct CopyBufferInfo2
x ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> IO b
f = Int
-> (("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
48 ((("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> IO b) -> IO b)
-> (("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \"pCopyBufferInfo" ::: Ptr CopyBufferInfo2
p -> ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2)
-> CopyBufferInfo2 -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCopyBufferInfo" ::: Ptr CopyBufferInfo2
p CopyBufferInfo2
x (("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> IO b
f "pCopyBufferInfo" ::: Ptr CopyBufferInfo2
p)
  pokeCStruct :: forall b.
("pCopyBufferInfo" ::: Ptr CopyBufferInfo2)
-> CopyBufferInfo2 -> IO b -> IO b
pokeCStruct "pCopyBufferInfo" ::: Ptr CopyBufferInfo2
p CopyBufferInfo2{Vector BufferCopy2
Buffer
regions :: Vector BufferCopy2
dstBuffer :: Buffer
srcBuffer :: Buffer
$sel:regions:CopyBufferInfo2 :: CopyBufferInfo2 -> Vector BufferCopy2
$sel:dstBuffer:CopyBufferInfo2 :: CopyBufferInfo2 -> Buffer
$sel:srcBuffer:CopyBufferInfo2 :: CopyBufferInfo2 -> Buffer
..} 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 (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 (("pCopyBufferInfo" ::: Ptr CopyBufferInfo2
p ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COPY_BUFFER_INFO_2)
    IO () -> ContT b IO ()
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 (("pCopyBufferInfo" ::: Ptr CopyBufferInfo2
p ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> 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 (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 Buffer -> Buffer -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyBufferInfo" ::: Ptr CopyBufferInfo2
p ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> Int -> Ptr Buffer
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Buffer)) (Buffer
srcBuffer)
    IO () -> ContT b IO ()
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 Buffer -> Buffer -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyBufferInfo" ::: Ptr CopyBufferInfo2
p ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> Int -> Ptr Buffer
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Buffer)) (Buffer
dstBuffer)
    IO () -> ContT b IO ()
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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyBufferInfo" ::: Ptr CopyBufferInfo2
p ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector BufferCopy2 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector BufferCopy2 -> Int) -> Vector BufferCopy2 -> Int
forall a b. (a -> b) -> a -> b
$ (Vector BufferCopy2
regions)) :: Word32))
    Ptr BufferCopy2
pPRegions' <- ((Ptr BufferCopy2 -> IO b) -> IO b) -> ContT b IO (Ptr BufferCopy2)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr BufferCopy2 -> IO b) -> IO b)
 -> ContT b IO (Ptr BufferCopy2))
-> ((Ptr BufferCopy2 -> IO b) -> IO b)
-> ContT b IO (Ptr BufferCopy2)
forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @BufferCopy2 ((Vector BufferCopy2 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector BufferCopy2
regions)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
40)
    IO () -> ContT b IO ()
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 -> BufferCopy2 -> IO ()) -> Vector BufferCopy2 -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i BufferCopy2
e -> Ptr BufferCopy2 -> BufferCopy2 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BufferCopy2
pPRegions' Ptr BufferCopy2 -> Int -> Ptr BufferCopy2
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
40 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr BufferCopy2) (BufferCopy2
e)) (Vector BufferCopy2
regions)
    IO () -> ContT b IO ()
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 BufferCopy2) -> Ptr BufferCopy2 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyBufferInfo" ::: Ptr CopyBufferInfo2
p ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2)
-> Int -> Ptr (Ptr BufferCopy2)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr BufferCopy2))) (Ptr BufferCopy2
pPRegions')
    IO b -> ContT b IO b
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.
("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> IO b -> IO b
pokeZeroCStruct "pCopyBufferInfo" ::: Ptr CopyBufferInfo2
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyBufferInfo" ::: Ptr CopyBufferInfo2
p ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COPY_BUFFER_INFO_2)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyBufferInfo" ::: Ptr CopyBufferInfo2
p ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Buffer -> Buffer -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyBufferInfo" ::: Ptr CopyBufferInfo2
p ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> Int -> Ptr Buffer
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Buffer)) (Buffer
forall a. Zero a => a
zero)
    Ptr Buffer -> Buffer -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyBufferInfo" ::: Ptr CopyBufferInfo2
p ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> Int -> Ptr Buffer
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Buffer)) (Buffer
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct CopyBufferInfo2 where
  peekCStruct :: ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> IO CopyBufferInfo2
peekCStruct "pCopyBufferInfo" ::: Ptr CopyBufferInfo2
p = do
    Buffer
srcBuffer <- forall a. Storable a => Ptr a -> IO a
peek @Buffer (("pCopyBufferInfo" ::: Ptr CopyBufferInfo2
p ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> Int -> Ptr Buffer
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Buffer))
    Buffer
dstBuffer <- forall a. Storable a => Ptr a -> IO a
peek @Buffer (("pCopyBufferInfo" ::: Ptr CopyBufferInfo2
p ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> Int -> Ptr Buffer
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Buffer))
    Word32
regionCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pCopyBufferInfo" ::: Ptr CopyBufferInfo2
p ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32))
    Ptr BufferCopy2
pRegions <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr BufferCopy2) (("pCopyBufferInfo" ::: Ptr CopyBufferInfo2
p ("pCopyBufferInfo" ::: Ptr CopyBufferInfo2)
-> Int -> Ptr (Ptr BufferCopy2)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr BufferCopy2)))
    Vector BufferCopy2
pRegions' <- Int -> (Int -> IO BufferCopy2) -> IO (Vector BufferCopy2)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
regionCount) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @BufferCopy2 ((Ptr BufferCopy2
pRegions Ptr BufferCopy2 -> Int -> Ptr BufferCopy2
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
40 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr BufferCopy2)))
    CopyBufferInfo2 -> IO CopyBufferInfo2
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CopyBufferInfo2 -> IO CopyBufferInfo2)
-> CopyBufferInfo2 -> IO CopyBufferInfo2
forall a b. (a -> b) -> a -> b
$ Buffer -> Buffer -> Vector BufferCopy2 -> CopyBufferInfo2
CopyBufferInfo2
             Buffer
srcBuffer Buffer
dstBuffer Vector BufferCopy2
pRegions'

instance Zero CopyBufferInfo2 where
  zero :: CopyBufferInfo2
zero = Buffer -> Buffer -> Vector BufferCopy2 -> CopyBufferInfo2
CopyBufferInfo2
           Buffer
forall a. Zero a => a
zero
           Buffer
forall a. Zero a => a
zero
           Vector BufferCopy2
forall a. Monoid a => a
mempty


-- | VkCopyImageInfo2 - Structure specifying parameters of an image copy
-- command
--
-- == Valid Usage
--
-- -   #VUID-VkCopyImageInfo2-pRegions-00124# 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-VkCopyImageInfo2-srcImage-01995# The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-format-features format features>
--     of @srcImage@ /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_TRANSFER_SRC_BIT'
--
-- -   #VUID-VkCopyImageInfo2-srcImage-01546# If @srcImage@ is non-sparse
--     then the image or /disjoint/ plane to be copied /must/ be bound
--     completely and contiguously to a single
--     'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   #VUID-VkCopyImageInfo2-srcImageLayout-00128# @srcImageLayout@ /must/
--     specify the layout of the image subresources of @srcImage@ specified
--     in @pRegions@ at the time this command is executed on a
--     'Vulkan.Core10.Handles.Device'
--
-- -   #VUID-VkCopyImageInfo2-srcImageLayout-01917# @srcImageLayout@ /must/
--     be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_TRANSFER_SRC_OPTIMAL',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_GENERAL', or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_SHARED_PRESENT_KHR'
--
-- -   #VUID-VkCopyImageInfo2-dstImage-01996# The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-format-features format features>
--     of @dstImage@ /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_TRANSFER_DST_BIT'
--
-- -   #VUID-VkCopyImageInfo2-dstImage-01547# If @dstImage@ is non-sparse
--     then the image or /disjoint/ plane that is the destination of the
--     copy /must/ be bound completely and contiguously to a single
--     'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   #VUID-VkCopyImageInfo2-dstImageLayout-00133# @dstImageLayout@ /must/
--     specify the layout of the image subresources of @dstImage@ specified
--     in @pRegions@ at the time this command is executed on a
--     'Vulkan.Core10.Handles.Device'
--
-- -   #VUID-VkCopyImageInfo2-dstImageLayout-01395# @dstImageLayout@ /must/
--     be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_GENERAL', or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_SHARED_PRESENT_KHR'
--
-- -   #VUID-VkCopyImageInfo2-srcImage-01548# If the
--     'Vulkan.Core10.Enums.Format.Format' of each of @srcImage@ and
--     @dstImage@ is not a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion multi-planar format>,
--     the 'Vulkan.Core10.Enums.Format.Format' of each of @srcImage@ and
--     @dstImage@ /must/ be
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-size-compatibility size-compatible>
--
-- -   #VUID-VkCopyImageInfo2-None-01549# In a copy to or from a plane of a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion multi-planar image>,
--     the 'Vulkan.Core10.Enums.Format.Format' of the image and plane
--     /must/ be compatible according to
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatible-planes the description of compatible planes>
--     for the plane being copied
--
-- -   #VUID-VkCopyImageInfo2-srcImage-00136# The sample count of
--     @srcImage@ and @dstImage@ /must/ match
--
-- -   #VUID-VkCopyImageInfo2-srcSubresource-01696# 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-VkCopyImageInfo2-dstSubresource-01697# 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-VkCopyImageInfo2-srcSubresource-01698# The
--     @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-VkCopyImageInfo2-dstSubresource-01699# The
--     @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-VkCopyImageInfo2-srcOffset-01783# The @srcOffset@ and @extent@
--     members of each element of @pRegions@ /must/ respect the image
--     transfer granularity requirements of @commandBuffer@’s command
--     pool’s queue family, as described in
--     'Vulkan.Core10.DeviceInitialization.QueueFamilyProperties'
--
-- -   #VUID-VkCopyImageInfo2-dstOffset-01784# The @dstOffset@ and @extent@
--     members of each element of @pRegions@ /must/ respect the image
--     transfer granularity requirements of @commandBuffer@’s command
--     pool’s queue family, as described in
--     'Vulkan.Core10.DeviceInitialization.QueueFamilyProperties'
--
-- -   #VUID-VkCopyImageInfo2-dstImage-02542# @dstImage@ and @srcImage@
--     /must/ not have been created with @flags@ containing
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SUBSAMPLED_BIT_EXT'
--
-- -   #VUID-VkCopyImageInfo2-srcImage-01551# If neither @srcImage@ nor
--     @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@, @srcSubresource.aspectMask@ and
--     @dstSubresource.aspectMask@ /must/ match
--
-- -   #VUID-VkCopyImageInfo2-srcImage-01552# If @srcImage@ has a
--     'Vulkan.Core10.Enums.Format.Format' with
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion two planes>
--     then for each element of @pRegions@, @srcSubresource.aspectMask@
--     /must/ be
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_0_BIT'
--     or
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_1_BIT'
--
-- -   #VUID-VkCopyImageInfo2-srcImage-01553# If @srcImage@ has a
--     'Vulkan.Core10.Enums.Format.Format' with
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion three planes>
--     then for each element of @pRegions@, @srcSubresource.aspectMask@
--     /must/ be
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_0_BIT',
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_1_BIT',
--     or
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_2_BIT'
--
-- -   #VUID-VkCopyImageInfo2-dstImage-01554# If @dstImage@ has a
--     'Vulkan.Core10.Enums.Format.Format' with
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion two planes>
--     then for each element of @pRegions@, @dstSubresource.aspectMask@
--     /must/ be
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_0_BIT'
--     or
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_1_BIT'
--
-- -   #VUID-VkCopyImageInfo2-dstImage-01555# If @dstImage@ has a
--     'Vulkan.Core10.Enums.Format.Format' with
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion three planes>
--     then for each element of @pRegions@, @dstSubresource.aspectMask@
--     /must/ be
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_0_BIT',
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_1_BIT',
--     or
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_2_BIT'
--
-- -   #VUID-VkCopyImageInfo2-srcImage-01556# 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>
--     and the @dstImage@ does not have a multi-planar image format, then
--     for each element of @pRegions@, @dstSubresource.aspectMask@ /must/
--     be 'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_COLOR_BIT'
--
-- -   #VUID-VkCopyImageInfo2-dstImage-01557# 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>
--     and the @srcImage@ does not have a multi-planar image format, then
--     for each element of @pRegions@, @srcSubresource.aspectMask@ /must/
--     be 'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_COLOR_BIT'
--
-- -   #VUID-VkCopyImageInfo2-srcImage-04443# If @srcImage@ is of type
--     'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_3D', then for each element
--     of @pRegions@, @srcSubresource.baseArrayLayer@ /must/ be @0@ and
--     @srcSubresource.layerCount@ /must/ be @1@
--
-- -   #VUID-VkCopyImageInfo2-dstImage-04444# If @dstImage@ is of type
--     'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_3D', then for each element
--     of @pRegions@, @dstSubresource.baseArrayLayer@ /must/ be @0@ and
--     @dstSubresource.layerCount@ /must/ be @1@
--
-- -   #VUID-VkCopyImageInfo2-aspectMask-00142# For each element of
--     @pRegions@, @srcSubresource.aspectMask@ /must/ specify aspects
--     present in @srcImage@
--
-- -   #VUID-VkCopyImageInfo2-aspectMask-00143# For each element of
--     @pRegions@, @dstSubresource.aspectMask@ /must/ specify aspects
--     present in @dstImage@
--
-- -   #VUID-VkCopyImageInfo2-srcOffset-00144# 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-VkCopyImageInfo2-srcOffset-00145# 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-VkCopyImageInfo2-srcImage-00146# 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-VkCopyImageInfo2-srcOffset-00147# If @srcImage@ is of type
--     'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_3D', then 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-VkCopyImageInfo2-srcImage-01785# If @srcImage@ is of type
--     'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_1D', then for each element
--     of @pRegions@, @srcOffset.z@ /must/ be @0@ and @extent.depth@ /must/
--     be @1@
--
-- -   #VUID-VkCopyImageInfo2-dstImage-01786# If @dstImage@ is of type
--     'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_1D', then for each element
--     of @pRegions@, @dstOffset.z@ /must/ be @0@ and @extent.depth@ /must/
--     be @1@
--
-- -   #VUID-VkCopyImageInfo2-srcImage-01787# If @srcImage@ is of type
--     'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_2D', then for each element
--     of @pRegions@, @srcOffset.z@ /must/ be @0@
--
-- -   #VUID-VkCopyImageInfo2-dstImage-01788# If @dstImage@ is of type
--     'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_2D', then for each element
--     of @pRegions@, @dstOffset.z@ /must/ be @0@
--
-- -   #VUID-VkCopyImageInfo2-srcImage-01790# If @srcImage@ and @dstImage@
--     are both of type 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_2D', then
--     for each element of @pRegions@, @extent.depth@ /must/ be @1@
--
-- -   #VUID-VkCopyImageInfo2-srcImage-01791# If @srcImage@ is of type
--     'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_2D', and @dstImage@ is of
--     type 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_3D', then for each
--     element of @pRegions@, @extent.depth@ /must/ equal
--     @srcSubresource.layerCount@
--
-- -   #VUID-VkCopyImageInfo2-dstImage-01792# If @dstImage@ is of type
--     'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_2D', and @srcImage@ is of
--     type 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_3D', then for each
--     element of @pRegions@, @extent.depth@ /must/ equal
--     @dstSubresource.layerCount@
--
-- -   #VUID-VkCopyImageInfo2-dstOffset-00150# 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-VkCopyImageInfo2-dstOffset-00151# 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-VkCopyImageInfo2-dstImage-00152# 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-VkCopyImageInfo2-dstOffset-00153# If @dstImage@ is of type
--     'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_3D', then 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-VkCopyImageInfo2-pRegions-07278# 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-VkCopyImageInfo2-pRegions-07279# 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-VkCopyImageInfo2-pRegions-07280# 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-VkCopyImageInfo2-pRegions-07281# 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-VkCopyImageInfo2-pRegions-07282# 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-VkCopyImageInfo2-pRegions-07283# 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-VkCopyImageInfo2-srcImage-01728# For each element of
--     @pRegions@, if the sum of @srcOffset.x@ and @extent.width@ does not
--     equal the width of the 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-VkCopyImageInfo2-srcImage-01729# For each element of
--     @pRegions@, if the sum of @srcOffset.y@ and @extent.height@ does not
--     equal the height of the 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-VkCopyImageInfo2-srcImage-01730# For each element of
--     @pRegions@, if the sum of @srcOffset.z@ and @extent.depth@ does not
--     equal the depth of the 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-VkCopyImageInfo2-dstImage-01732# For each element of
--     @pRegions@, if the sum of @dstOffset.x@ and @extent.width@ does not
--     equal the width of the the subresource specified by
--     @dstSubresource@, @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-VkCopyImageInfo2-dstImage-01733# For each element of
--     @pRegions@, if the sum of @dstOffset.y@ and @extent.height@ does not
--     equal the height of the the subresource specified by
--     @dstSubresource@, @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-VkCopyImageInfo2-dstImage-01734# For each element of
--     @pRegions@, if the sum of @dstOffset.z@ and @extent.depth@ does not
--     equal the depth of the the subresource specified by
--     @dstSubresource@, @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-VkCopyImageInfo2-aspect-06662# If the @aspect@ member of any
--     element of @pRegions@ includes any flag other than
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_STENCIL_BIT'
--     or @srcImage@ was not created with
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkImageStencilUsageCreateInfo separate stencil usage>,
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_TRANSFER_SRC_BIT'
--     /must/ have been included in the
--     'Vulkan.Core10.Image.ImageCreateInfo'::@usage@ used to create
--     @srcImage@
--
-- -   #VUID-VkCopyImageInfo2-aspect-06663# If the @aspect@ member of any
--     element of @pRegions@ includes any flag other than
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_STENCIL_BIT'
--     or @dstImage@ was not created with
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkImageStencilUsageCreateInfo separate stencil usage>,
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_TRANSFER_DST_BIT'
--     /must/ have been included in the
--     'Vulkan.Core10.Image.ImageCreateInfo'::@usage@ used to create
--     @dstImage@
--
-- -   #VUID-VkCopyImageInfo2-aspect-06664# If the @aspect@ member of any
--     element of @pRegions@ includes
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_STENCIL_BIT',
--     and @srcImage@ was created with
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkImageStencilUsageCreateInfo separate stencil usage>,
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_TRANSFER_SRC_BIT'
--     /must/ have been included in the
--     'Vulkan.Core12.Promoted_From_VK_EXT_separate_stencil_usage.ImageStencilUsageCreateInfo'::@stencilUsage@
--     used to create @srcImage@
--
-- -   #VUID-VkCopyImageInfo2-aspect-06665# If the @aspect@ member of any
--     element of @pRegions@ includes
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_STENCIL_BIT',
--     and @dstImage@ was created with
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkImageStencilUsageCreateInfo separate stencil usage>,
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_TRANSFER_DST_BIT'
--     /must/ have been included in the
--     'Vulkan.Core12.Promoted_From_VK_EXT_separate_stencil_usage.ImageStencilUsageCreateInfo'::@stencilUsage@
--     used to create @dstImage@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkCopyImageInfo2-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_COPY_IMAGE_INFO_2'
--
-- -   #VUID-VkCopyImageInfo2-pNext-pNext# @pNext@ /must/ be @NULL@
--
-- -   #VUID-VkCopyImageInfo2-srcImage-parameter# @srcImage@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Image' handle
--
-- -   #VUID-VkCopyImageInfo2-srcImageLayout-parameter# @srcImageLayout@
--     /must/ be a valid 'Vulkan.Core10.Enums.ImageLayout.ImageLayout'
--     value
--
-- -   #VUID-VkCopyImageInfo2-dstImage-parameter# @dstImage@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Image' handle
--
-- -   #VUID-VkCopyImageInfo2-dstImageLayout-parameter# @dstImageLayout@
--     /must/ be a valid 'Vulkan.Core10.Enums.ImageLayout.ImageLayout'
--     value
--
-- -   #VUID-VkCopyImageInfo2-pRegions-parameter# @pRegions@ /must/ be a
--     valid pointer to an array of @regionCount@ valid 'ImageCopy2'
--     structures
--
-- -   #VUID-VkCopyImageInfo2-regionCount-arraylength# @regionCount@ /must/
--     be greater than @0@
--
-- -   #VUID-VkCopyImageInfo2-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_KHR_copy_commands2 VK_KHR_copy_commands2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.Handles.Image', 'ImageCopy2',
-- 'Vulkan.Core10.Enums.ImageLayout.ImageLayout',
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'cmdCopyImage2',
-- 'Vulkan.Extensions.VK_KHR_copy_commands2.cmdCopyImage2KHR'
data CopyImageInfo2 = CopyImageInfo2
  { -- | @srcImage@ is the source image.
    CopyImageInfo2 -> Image
srcImage :: Image
  , -- | @srcImageLayout@ is the current layout of the source image subresource.
    CopyImageInfo2 -> ImageLayout
srcImageLayout :: ImageLayout
  , -- | @dstImage@ is the destination image.
    CopyImageInfo2 -> Image
dstImage :: Image
  , -- | @dstImageLayout@ is the current layout of the destination image
    -- subresource.
    CopyImageInfo2 -> ImageLayout
dstImageLayout :: ImageLayout
  , -- | @pRegions@ is a pointer to an array of 'ImageCopy2' structures
    -- specifying the regions to copy.
    CopyImageInfo2 -> Vector ImageCopy2
regions :: Vector ImageCopy2
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CopyImageInfo2)
#endif
deriving instance Show CopyImageInfo2

instance ToCStruct CopyImageInfo2 where
  withCStruct :: forall b.
CopyImageInfo2
-> (("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> IO b) -> IO b
withCStruct CopyImageInfo2
x ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> IO b
f = Int -> (("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
56 ((("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> IO b) -> IO b)
-> (("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \"pCopyImageInfo" ::: Ptr CopyImageInfo2
p -> ("pCopyImageInfo" ::: Ptr CopyImageInfo2)
-> CopyImageInfo2 -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCopyImageInfo" ::: Ptr CopyImageInfo2
p CopyImageInfo2
x (("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> IO b
f "pCopyImageInfo" ::: Ptr CopyImageInfo2
p)
  pokeCStruct :: forall b.
("pCopyImageInfo" ::: Ptr CopyImageInfo2)
-> CopyImageInfo2 -> IO b -> IO b
pokeCStruct "pCopyImageInfo" ::: Ptr CopyImageInfo2
p CopyImageInfo2{Vector ImageCopy2
ImageLayout
Image
regions :: Vector ImageCopy2
dstImageLayout :: ImageLayout
dstImage :: Image
srcImageLayout :: ImageLayout
srcImage :: Image
$sel:regions:CopyImageInfo2 :: CopyImageInfo2 -> Vector ImageCopy2
$sel:dstImageLayout:CopyImageInfo2 :: CopyImageInfo2 -> ImageLayout
$sel:dstImage:CopyImageInfo2 :: CopyImageInfo2 -> Image
$sel:srcImageLayout:CopyImageInfo2 :: CopyImageInfo2 -> ImageLayout
$sel:srcImage:CopyImageInfo2 :: CopyImageInfo2 -> Image
..} 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 (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 (("pCopyImageInfo" ::: Ptr CopyImageInfo2
p ("pCopyImageInfo" ::: Ptr CopyImageInfo2)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COPY_IMAGE_INFO_2)
    IO () -> ContT b IO ()
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 (("pCopyImageInfo" ::: Ptr CopyImageInfo2
p ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> 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 (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 (("pCopyImageInfo" ::: Ptr CopyImageInfo2
p ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> Int -> Ptr Image
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Image)) (Image
srcImage)
    IO () -> ContT b IO ()
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 (("pCopyImageInfo" ::: Ptr CopyImageInfo2
p ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout)) (ImageLayout
srcImageLayout)
    IO () -> ContT b IO ()
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 (("pCopyImageInfo" ::: Ptr CopyImageInfo2
p ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> Int -> Ptr Image
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Image)) (Image
dstImage)
    IO () -> ContT b IO ()
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 (("pCopyImageInfo" ::: Ptr CopyImageInfo2
p ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr ImageLayout)) (ImageLayout
dstImageLayout)
    IO () -> ContT b IO ()
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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageInfo" ::: Ptr CopyImageInfo2
p ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Word32)) ((Int -> Word32
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 (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 (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 (("pCopyImageInfo" ::: Ptr CopyImageInfo2
p ("pCopyImageInfo" ::: Ptr CopyImageInfo2)
-> Int -> Ptr (Ptr ImageCopy2)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr (Ptr ImageCopy2))) (Ptr ImageCopy2
pPRegions')
    IO b -> ContT b IO b
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
56
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> IO b -> IO b
pokeZeroCStruct "pCopyImageInfo" ::: Ptr CopyImageInfo2
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageInfo" ::: Ptr CopyImageInfo2
p ("pCopyImageInfo" ::: Ptr CopyImageInfo2)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COPY_IMAGE_INFO_2)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageInfo" ::: Ptr CopyImageInfo2
p ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> 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 (("pCopyImageInfo" ::: Ptr CopyImageInfo2
p ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> 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 (("pCopyImageInfo" ::: Ptr CopyImageInfo2
p ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout)) (ImageLayout
forall a. Zero a => a
zero)
    Ptr Image -> Image -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageInfo" ::: Ptr CopyImageInfo2
p ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> Int -> Ptr Image
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Image)) (Image
forall a. Zero a => a
zero)
    Ptr ImageLayout -> ImageLayout -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageInfo" ::: Ptr CopyImageInfo2
p ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr ImageLayout)) (ImageLayout
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct CopyImageInfo2 where
  peekCStruct :: ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> IO CopyImageInfo2
peekCStruct "pCopyImageInfo" ::: Ptr CopyImageInfo2
p = do
    Image
srcImage <- forall a. Storable a => Ptr a -> IO a
peek @Image (("pCopyImageInfo" ::: Ptr CopyImageInfo2
p ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> Int -> Ptr Image
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Image))
    ImageLayout
srcImageLayout <- forall a. Storable a => Ptr a -> IO a
peek @ImageLayout (("pCopyImageInfo" ::: Ptr CopyImageInfo2
p ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout))
    Image
dstImage <- forall a. Storable a => Ptr a -> IO a
peek @Image (("pCopyImageInfo" ::: Ptr CopyImageInfo2
p ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> Int -> Ptr Image
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Image))
    ImageLayout
dstImageLayout <- forall a. Storable a => Ptr a -> IO a
peek @ImageLayout (("pCopyImageInfo" ::: Ptr CopyImageInfo2
p ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr ImageLayout))
    Word32
regionCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pCopyImageInfo" ::: Ptr CopyImageInfo2
p ("pCopyImageInfo" ::: Ptr CopyImageInfo2) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Word32))
    Ptr ImageCopy2
pRegions <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ImageCopy2) (("pCopyImageInfo" ::: Ptr CopyImageInfo2
p ("pCopyImageInfo" ::: Ptr CopyImageInfo2)
-> Int -> Ptr (Ptr ImageCopy2)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: 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 (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
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)))
    CopyImageInfo2 -> IO CopyImageInfo2
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CopyImageInfo2 -> IO CopyImageInfo2)
-> CopyImageInfo2 -> IO CopyImageInfo2
forall a b. (a -> b) -> a -> b
$ Image
-> ImageLayout
-> Image
-> ImageLayout
-> Vector ImageCopy2
-> CopyImageInfo2
CopyImageInfo2
             Image
srcImage ImageLayout
srcImageLayout Image
dstImage ImageLayout
dstImageLayout Vector ImageCopy2
pRegions'

instance Zero CopyImageInfo2 where
  zero :: CopyImageInfo2
zero = Image
-> ImageLayout
-> Image
-> ImageLayout
-> Vector ImageCopy2
-> CopyImageInfo2
CopyImageInfo2
           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


-- | VkBlitImageInfo2 - Structure specifying parameters of blit image command
--
-- == Valid Usage
--
-- -   #VUID-VkBlitImageInfo2-pRegions-00215# The source region specified
--     by each element of @pRegions@ /must/ be a region that is contained
--     within @srcImage@
--
-- -   #VUID-VkBlitImageInfo2-pRegions-00216# The destination region
--     specified by each element of @pRegions@ /must/ be a region that is
--     contained within @dstImage@
--
-- -   #VUID-VkBlitImageInfo2-pRegions-00217# The union of all destination
--     regions, specified by the elements of @pRegions@, /must/ not overlap
--     in memory with any texel that /may/ be sampled during the blit
--     operation
--
-- -   #VUID-VkBlitImageInfo2-srcImage-01999# The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-format-features format features>
--     of @srcImage@ /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_BLIT_SRC_BIT'
--
-- -   #VUID-VkBlitImageInfo2-srcImage-06421# @srcImage@ /must/ not use a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion format that requires a sampler Y′CBCR conversion>
--
-- -   #VUID-VkBlitImageInfo2-srcImage-00219# @srcImage@ /must/ have been
--     created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_TRANSFER_SRC_BIT'
--     usage flag
--
-- -   #VUID-VkBlitImageInfo2-srcImage-00220# If @srcImage@ is non-sparse
--     then it /must/ be bound completely and contiguously to a single
--     'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   #VUID-VkBlitImageInfo2-srcImageLayout-00221# @srcImageLayout@ /must/
--     specify the layout of the image subresources of @srcImage@ specified
--     in @pRegions@ at the time this command is executed on a
--     'Vulkan.Core10.Handles.Device'
--
-- -   #VUID-VkBlitImageInfo2-srcImageLayout-01398# @srcImageLayout@ /must/
--     be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_SHARED_PRESENT_KHR',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_TRANSFER_SRC_OPTIMAL'
--     or 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_GENERAL'
--
-- -   #VUID-VkBlitImageInfo2-dstImage-02000# The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-format-features format features>
--     of @dstImage@ /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_BLIT_DST_BIT'
--
-- -   #VUID-VkBlitImageInfo2-dstImage-06422# @dstImage@ /must/ not use a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion format that requires a sampler Y′CBCR conversion>
--
-- -   #VUID-VkBlitImageInfo2-dstImage-00224# @dstImage@ /must/ have been
--     created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_TRANSFER_DST_BIT'
--     usage flag
--
-- -   #VUID-VkBlitImageInfo2-dstImage-00225# If @dstImage@ is non-sparse
--     then it /must/ be bound completely and contiguously to a single
--     'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   #VUID-VkBlitImageInfo2-dstImageLayout-00226# @dstImageLayout@ /must/
--     specify the layout of the image subresources of @dstImage@ specified
--     in @pRegions@ at the time this command is executed on a
--     'Vulkan.Core10.Handles.Device'
--
-- -   #VUID-VkBlitImageInfo2-dstImageLayout-01399# @dstImageLayout@ /must/
--     be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_SHARED_PRESENT_KHR',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL'
--     or 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_GENERAL'
--
-- -   #VUID-VkBlitImageInfo2-srcImage-00229# If either of @srcImage@ or
--     @dstImage@ was created with a signed integer
--     'Vulkan.Core10.Enums.Format.Format', the other /must/ also have been
--     created with a signed integer 'Vulkan.Core10.Enums.Format.Format'
--
-- -   #VUID-VkBlitImageInfo2-srcImage-00230# If either of @srcImage@ or
--     @dstImage@ was created with an unsigned integer
--     'Vulkan.Core10.Enums.Format.Format', the other /must/ also have been
--     created with an unsigned integer 'Vulkan.Core10.Enums.Format.Format'
--
-- -   #VUID-VkBlitImageInfo2-srcImage-00231# If either of @srcImage@ or
--     @dstImage@ was created with a depth\/stencil format, the other
--     /must/ have exactly the same format
--
-- -   #VUID-VkBlitImageInfo2-srcImage-00232# If @srcImage@ was created
--     with a depth\/stencil format, @filter@ /must/ be
--     'Vulkan.Core10.Enums.Filter.FILTER_NEAREST'
--
-- -   #VUID-VkBlitImageInfo2-srcImage-00233# @srcImage@ /must/ have been
--     created with a @samples@ value of
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SAMPLE_COUNT_1_BIT'
--
-- -   #VUID-VkBlitImageInfo2-dstImage-00234# @dstImage@ /must/ have been
--     created with a @samples@ value of
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SAMPLE_COUNT_1_BIT'
--
-- -   #VUID-VkBlitImageInfo2-filter-02001# If @filter@ is
--     'Vulkan.Core10.Enums.Filter.FILTER_LINEAR', then the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-format-features format features>
--     of @srcImage@ /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_SAMPLED_IMAGE_FILTER_LINEAR_BIT'
--
-- -   #VUID-VkBlitImageInfo2-filter-02002# If @filter@ is
--     'Vulkan.Core10.Enums.Filter.FILTER_CUBIC_EXT', then the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-format-features format features>
--     of @srcImage@ /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_SAMPLED_IMAGE_FILTER_CUBIC_BIT_EXT'
--
-- -   #VUID-VkBlitImageInfo2-filter-00237# If @filter@ is
--     'Vulkan.Core10.Enums.Filter.FILTER_CUBIC_EXT', @srcImage@ /must/ be
--     of type 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_2D'
--
-- -   #VUID-VkBlitImageInfo2-srcSubresource-01705# 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-VkBlitImageInfo2-dstSubresource-01706# 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-VkBlitImageInfo2-srcSubresource-01707# The
--     @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-VkBlitImageInfo2-dstSubresource-01708# The
--     @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-VkBlitImageInfo2-dstImage-02545# @dstImage@ and @srcImage@
--     /must/ not have been created with @flags@ containing
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SUBSAMPLED_BIT_EXT'
--
-- -   #VUID-VkBlitImageInfo2-srcImage-00240# If either @srcImage@ or
--     @dstImage@ is of type 'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_3D',
--     then for each element of @pRegions@, @srcSubresource.baseArrayLayer@
--     and @dstSubresource.baseArrayLayer@ /must/ each be @0@, and
--     @srcSubresource.layerCount@ and @dstSubresource.layerCount@ /must/
--     each be @1@
--
-- -   #VUID-VkBlitImageInfo2-aspectMask-00241# For each element of
--     @pRegions@, @srcSubresource.aspectMask@ /must/ specify aspects
--     present in @srcImage@
--
-- -   #VUID-VkBlitImageInfo2-aspectMask-00242# For each element of
--     @pRegions@, @dstSubresource.aspectMask@ /must/ specify aspects
--     present in @dstImage@
--
-- -   #VUID-VkBlitImageInfo2-srcOffset-00243# For each element of
--     @pRegions@, @srcOffsets@[0].x and @srcOffsets@[1].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-VkBlitImageInfo2-srcOffset-00244# For each element of
--     @pRegions@, @srcOffsets@[0].y and @srcOffsets@[1].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-VkBlitImageInfo2-srcImage-00245# If @srcImage@ is of type
--     'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_1D', then for each element
--     of @pRegions@, @srcOffsets@[0].y /must/ be @0@ and @srcOffsets@[1].y
--     /must/ be @1@
--
-- -   #VUID-VkBlitImageInfo2-srcOffset-00246# For each element of
--     @pRegions@, @srcOffsets@[0].z and @srcOffsets@[1].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-VkBlitImageInfo2-srcImage-00247# 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@, @srcOffsets@[0].z /must/ be @0@ and @srcOffsets@[1].z
--     /must/ be @1@
--
-- -   #VUID-VkBlitImageInfo2-dstOffset-00248# For each element of
--     @pRegions@, @dstOffsets@[0].x and @dstOffsets@[1].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-VkBlitImageInfo2-dstOffset-00249# For each element of
--     @pRegions@, @dstOffsets@[0].y and @dstOffsets@[1].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-VkBlitImageInfo2-dstImage-00250# If @dstImage@ is of type
--     'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_1D', then for each element
--     of @pRegions@, @dstOffsets@[0].y /must/ be @0@ and @dstOffsets@[1].y
--     /must/ be @1@
--
-- -   #VUID-VkBlitImageInfo2-dstOffset-00251# For each element of
--     @pRegions@, @dstOffsets@[0].z and @dstOffsets@[1].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-VkBlitImageInfo2-dstImage-00252# 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@, @dstOffsets@[0].z /must/ be @0@ and @dstOffsets@[1].z
--     /must/ be @1@
--
-- -   #VUID-VkBlitImageInfo2-pRegions-04561# If any element of @pRegions@
--     contains
--     'Vulkan.Extensions.VK_QCOM_rotated_copy_commands.CopyCommandTransformInfoQCOM'
--     in its @pNext@ chain, then @srcImage@ and @dstImage@ /must/ not be
--     block-compressed images
--
-- -   #VUID-VkBlitImageInfo2KHR-pRegions-06207# If any element of
--     @pRegions@ contains
--     'Vulkan.Extensions.VK_QCOM_rotated_copy_commands.CopyCommandTransformInfoQCOM'
--     in its @pNext@ chain, then @srcImage@ /must/ be of type
--     'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_2D'
--
-- -   #VUID-VkBlitImageInfo2KHR-pRegions-06208# If any element of
--     @pRegions@ contains
--     'Vulkan.Extensions.VK_QCOM_rotated_copy_commands.CopyCommandTransformInfoQCOM'
--     in its @pNext@ chain, then @srcImage@ /must/ not have a
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion multi-planar format>
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkBlitImageInfo2-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_BLIT_IMAGE_INFO_2'
--
-- -   #VUID-VkBlitImageInfo2-pNext-pNext# @pNext@ /must/ be @NULL@
--
-- -   #VUID-VkBlitImageInfo2-srcImage-parameter# @srcImage@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Image' handle
--
-- -   #VUID-VkBlitImageInfo2-srcImageLayout-parameter# @srcImageLayout@
--     /must/ be a valid 'Vulkan.Core10.Enums.ImageLayout.ImageLayout'
--     value
--
-- -   #VUID-VkBlitImageInfo2-dstImage-parameter# @dstImage@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Image' handle
--
-- -   #VUID-VkBlitImageInfo2-dstImageLayout-parameter# @dstImageLayout@
--     /must/ be a valid 'Vulkan.Core10.Enums.ImageLayout.ImageLayout'
--     value
--
-- -   #VUID-VkBlitImageInfo2-pRegions-parameter# @pRegions@ /must/ be a
--     valid pointer to an array of @regionCount@ valid 'ImageBlit2'
--     structures
--
-- -   #VUID-VkBlitImageInfo2-filter-parameter# @filter@ /must/ be a valid
--     'Vulkan.Core10.Enums.Filter.Filter' value
--
-- -   #VUID-VkBlitImageInfo2-regionCount-arraylength# @regionCount@ /must/
--     be greater than @0@
--
-- -   #VUID-VkBlitImageInfo2-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_KHR_copy_commands2 VK_KHR_copy_commands2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.Enums.Filter.Filter', 'Vulkan.Core10.Handles.Image',
-- 'ImageBlit2', 'Vulkan.Core10.Enums.ImageLayout.ImageLayout',
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'cmdBlitImage2',
-- 'Vulkan.Extensions.VK_KHR_copy_commands2.cmdBlitImage2KHR'
data BlitImageInfo2 = BlitImageInfo2
  { -- | @srcImage@ is the source image.
    BlitImageInfo2 -> Image
srcImage :: Image
  , -- | @srcImageLayout@ is the layout of the source image subresources for the
    -- blit.
    BlitImageInfo2 -> ImageLayout
srcImageLayout :: ImageLayout
  , -- | @dstImage@ is the destination image.
    BlitImageInfo2 -> Image
dstImage :: Image
  , -- | @dstImageLayout@ is the layout of the destination image subresources for
    -- the blit.
    BlitImageInfo2 -> ImageLayout
dstImageLayout :: ImageLayout
  , -- | @pRegions@ is a pointer to an array of 'ImageBlit2' structures
    -- specifying the regions to blit.
    BlitImageInfo2 -> Vector (SomeStruct ImageBlit2)
regions :: Vector (SomeStruct ImageBlit2)
  , -- | @filter@ is a 'Vulkan.Core10.Enums.Filter.Filter' specifying the filter
    -- to apply if the blits require scaling.
    BlitImageInfo2 -> Filter
filter' :: Filter
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (BlitImageInfo2)
#endif
deriving instance Show BlitImageInfo2

instance ToCStruct BlitImageInfo2 where
  withCStruct :: forall b.
BlitImageInfo2
-> (("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> IO b) -> IO b
withCStruct BlitImageInfo2
x ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> IO b
f = Int -> (("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
64 ((("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> IO b) -> IO b)
-> (("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \"pBlitImageInfo" ::: Ptr BlitImageInfo2
p -> ("pBlitImageInfo" ::: Ptr BlitImageInfo2)
-> BlitImageInfo2 -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pBlitImageInfo" ::: Ptr BlitImageInfo2
p BlitImageInfo2
x (("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> IO b
f "pBlitImageInfo" ::: Ptr BlitImageInfo2
p)
  pokeCStruct :: forall b.
("pBlitImageInfo" ::: Ptr BlitImageInfo2)
-> BlitImageInfo2 -> IO b -> IO b
pokeCStruct "pBlitImageInfo" ::: Ptr BlitImageInfo2
p BlitImageInfo2{Vector (SomeStruct ImageBlit2)
Filter
ImageLayout
Image
filter' :: Filter
regions :: Vector (SomeStruct ImageBlit2)
dstImageLayout :: ImageLayout
dstImage :: Image
srcImageLayout :: ImageLayout
srcImage :: Image
$sel:filter':BlitImageInfo2 :: BlitImageInfo2 -> Filter
$sel:regions:BlitImageInfo2 :: BlitImageInfo2 -> Vector (SomeStruct ImageBlit2)
$sel:dstImageLayout:BlitImageInfo2 :: BlitImageInfo2 -> ImageLayout
$sel:dstImage:BlitImageInfo2 :: BlitImageInfo2 -> Image
$sel:srcImageLayout:BlitImageInfo2 :: BlitImageInfo2 -> ImageLayout
$sel:srcImage:BlitImageInfo2 :: BlitImageInfo2 -> Image
..} 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 (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 (("pBlitImageInfo" ::: Ptr BlitImageInfo2
p ("pBlitImageInfo" ::: Ptr BlitImageInfo2)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_BLIT_IMAGE_INFO_2)
    IO () -> ContT b IO ()
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 (("pBlitImageInfo" ::: Ptr BlitImageInfo2
p ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> 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 (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 (("pBlitImageInfo" ::: Ptr BlitImageInfo2
p ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> Int -> Ptr Image
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Image)) (Image
srcImage)
    IO () -> ContT b IO ()
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 (("pBlitImageInfo" ::: Ptr BlitImageInfo2
p ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout)) (ImageLayout
srcImageLayout)
    IO () -> ContT b IO ()
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 (("pBlitImageInfo" ::: Ptr BlitImageInfo2
p ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> Int -> Ptr Image
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Image)) (Image
dstImage)
    IO () -> ContT b IO ()
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 (("pBlitImageInfo" ::: Ptr BlitImageInfo2
p ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr ImageLayout)) (ImageLayout
dstImageLayout)
    IO () -> ContT b IO ()
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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pBlitImageInfo" ::: Ptr BlitImageInfo2
p ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector (SomeStruct ImageBlit2) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (SomeStruct ImageBlit2) -> Int)
-> Vector (SomeStruct ImageBlit2) -> Int
forall a b. (a -> b) -> a -> b
$ (Vector (SomeStruct ImageBlit2)
regions)) :: Word32))
    Ptr (ImageBlit2 Any)
pPRegions' <- ((Ptr (ImageBlit2 Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (ImageBlit2 Any))
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (ImageBlit2 Any) -> IO b) -> IO b)
 -> ContT b IO (Ptr (ImageBlit2 Any)))
-> ((Ptr (ImageBlit2 Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (ImageBlit2 Any))
forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @(ImageBlit2 _) ((Vector (SomeStruct ImageBlit2) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (SomeStruct ImageBlit2)
regions)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
96)
    (Int -> SomeStruct ImageBlit2 -> ContT b IO ())
-> Vector (SomeStruct ImageBlit2) -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i SomeStruct ImageBlit2
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (SomeStruct ImageBlit2)
-> SomeStruct ImageBlit2 -> IO b -> IO b
forall (a :: [*] -> *) b.
(forall (es :: [*]).
 (Extendss a es, PokeChain es) =>
 ToCStruct (a es)) =>
Ptr (SomeStruct a) -> SomeStruct a -> IO b -> IO b
pokeSomeCStruct (Ptr (ImageBlit2 Any) -> Ptr (SomeStruct ImageBlit2)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (ImageBlit2 Any)
pPRegions' Ptr (ImageBlit2 Any) -> Int -> Ptr (ImageBlit2 w)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
96 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (ImageBlit2 _))) (SomeStruct ImageBlit2
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector (SomeStruct ImageBlit2)
regions)
    IO () -> ContT b IO ()
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 (ImageBlit2 Any)) -> Ptr (ImageBlit2 Any) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pBlitImageInfo" ::: Ptr BlitImageInfo2
p ("pBlitImageInfo" ::: Ptr BlitImageInfo2)
-> Int -> Ptr (Ptr (ImageBlit2 w))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr (Ptr (ImageBlit2 _)))) (Ptr (ImageBlit2 Any)
pPRegions')
    IO () -> ContT b IO ()
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 Filter -> Filter -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pBlitImageInfo" ::: Ptr BlitImageInfo2
p ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> Int -> Ptr Filter
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr Filter)) (Filter
filter')
    IO b -> ContT b IO b
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. ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> IO b -> IO b
pokeZeroCStruct "pBlitImageInfo" ::: Ptr BlitImageInfo2
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pBlitImageInfo" ::: Ptr BlitImageInfo2
p ("pBlitImageInfo" ::: Ptr BlitImageInfo2)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_BLIT_IMAGE_INFO_2)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pBlitImageInfo" ::: Ptr BlitImageInfo2
p ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> 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 (("pBlitImageInfo" ::: Ptr BlitImageInfo2
p ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> 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 (("pBlitImageInfo" ::: Ptr BlitImageInfo2
p ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout)) (ImageLayout
forall a. Zero a => a
zero)
    Ptr Image -> Image -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pBlitImageInfo" ::: Ptr BlitImageInfo2
p ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> Int -> Ptr Image
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Image)) (Image
forall a. Zero a => a
zero)
    Ptr ImageLayout -> ImageLayout -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pBlitImageInfo" ::: Ptr BlitImageInfo2
p ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr ImageLayout)) (ImageLayout
forall a. Zero a => a
zero)
    Ptr Filter -> Filter -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pBlitImageInfo" ::: Ptr BlitImageInfo2
p ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> Int -> Ptr Filter
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr Filter)) (Filter
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct BlitImageInfo2 where
  peekCStruct :: ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> IO BlitImageInfo2
peekCStruct "pBlitImageInfo" ::: Ptr BlitImageInfo2
p = do
    Image
srcImage <- forall a. Storable a => Ptr a -> IO a
peek @Image (("pBlitImageInfo" ::: Ptr BlitImageInfo2
p ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> Int -> Ptr Image
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Image))
    ImageLayout
srcImageLayout <- forall a. Storable a => Ptr a -> IO a
peek @ImageLayout (("pBlitImageInfo" ::: Ptr BlitImageInfo2
p ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout))
    Image
dstImage <- forall a. Storable a => Ptr a -> IO a
peek @Image (("pBlitImageInfo" ::: Ptr BlitImageInfo2
p ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> Int -> Ptr Image
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Image))
    ImageLayout
dstImageLayout <- forall a. Storable a => Ptr a -> IO a
peek @ImageLayout (("pBlitImageInfo" ::: Ptr BlitImageInfo2
p ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr ImageLayout))
    Word32
regionCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pBlitImageInfo" ::: Ptr BlitImageInfo2
p ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Word32))
    Ptr (ImageBlit2 Any)
pRegions <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr (ImageBlit2 _)) (("pBlitImageInfo" ::: Ptr BlitImageInfo2
p ("pBlitImageInfo" ::: Ptr BlitImageInfo2)
-> Int -> Ptr (Ptr (ImageBlit2 w))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr (Ptr (ImageBlit2 _))))
    Vector (SomeStruct ImageBlit2)
pRegions' <- Int
-> (Int -> IO (SomeStruct ImageBlit2))
-> IO (Vector (SomeStruct ImageBlit2))
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
regionCount) (\Int
i -> Ptr (SomeStruct ImageBlit2) -> IO (SomeStruct ImageBlit2)
forall (a :: [*] -> *).
(Extensible a,
 forall (es :: [*]).
 (Extendss a es, PeekChain es) =>
 FromCStruct (a es)) =>
Ptr (SomeStruct a) -> IO (SomeStruct a)
peekSomeCStruct (Ptr (ImageBlit2 Any) -> Ptr (SomeStruct ImageBlit2)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions ((Ptr (ImageBlit2 Any)
pRegions Ptr (ImageBlit2 Any) -> Int -> Ptr (ImageBlit2 Any)
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
96 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (ImageBlit2 _)))))
    Filter
filter' <- forall a. Storable a => Ptr a -> IO a
peek @Filter (("pBlitImageInfo" ::: Ptr BlitImageInfo2
p ("pBlitImageInfo" ::: Ptr BlitImageInfo2) -> Int -> Ptr Filter
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr Filter))
    BlitImageInfo2 -> IO BlitImageInfo2
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BlitImageInfo2 -> IO BlitImageInfo2)
-> BlitImageInfo2 -> IO BlitImageInfo2
forall a b. (a -> b) -> a -> b
$ Image
-> ImageLayout
-> Image
-> ImageLayout
-> Vector (SomeStruct ImageBlit2)
-> Filter
-> BlitImageInfo2
BlitImageInfo2
             Image
srcImage ImageLayout
srcImageLayout Image
dstImage ImageLayout
dstImageLayout Vector (SomeStruct ImageBlit2)
pRegions' Filter
filter'

instance Zero BlitImageInfo2 where
  zero :: BlitImageInfo2
zero = Image
-> ImageLayout
-> Image
-> ImageLayout
-> Vector (SomeStruct ImageBlit2)
-> Filter
-> BlitImageInfo2
BlitImageInfo2
           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 (SomeStruct ImageBlit2)
forall a. Monoid a => a
mempty
           Filter
forall a. Zero a => a
zero


-- | VkCopyBufferToImageInfo2 - Structure specifying parameters of a buffer
-- to image copy command
--
-- == Valid Usage
--
-- -   #VUID-VkCopyBufferToImageInfo2-pRegions-04565# If the image region
--     specified by each element of @pRegions@ does not contain
--     'Vulkan.Extensions.VK_QCOM_rotated_copy_commands.CopyCommandTransformInfoQCOM'
--     in its @pNext@ chain, it /must/ be a region that is contained within
--     the specified @imageSubresource@ of @dstImage@
--
-- -   #VUID-VkCopyBufferToImageInfo2KHR-pRegions-04554# If the image
--     region specified by each element of @pRegions@ contains
--     'Vulkan.Extensions.VK_QCOM_rotated_copy_commands.CopyCommandTransformInfoQCOM'
--     in its @pNext@ chain, the rotated destination region as described in
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#copies-buffers-images-rotation-addressing>
--     /must/ be contained within @dstImage@
--
-- -   #VUID-VkCopyBufferToImageInfo2KHR-pRegions-04555# If any element of
--     @pRegions@ contains
--     'Vulkan.Extensions.VK_QCOM_rotated_copy_commands.CopyCommandTransformInfoQCOM'
--     in its @pNext@ chain, then @dstImage@ /must/ have a 1x1x1
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#formats-compatibility-classes texel block extent>
--
-- -   #VUID-VkCopyBufferToImageInfo2KHR-pRegions-06203# If any element of
--     @pRegions@ contains
--     'Vulkan.Extensions.VK_QCOM_rotated_copy_commands.CopyCommandTransformInfoQCOM'
--     in its @pNext@ chain, then @dstImage@ /must/ be of type
--     'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_2D'
--
-- -   #VUID-VkCopyBufferToImageInfo2KHR-pRegions-06204# If any element of
--     @pRegions@ contains
--     'Vulkan.Extensions.VK_QCOM_rotated_copy_commands.CopyCommandTransformInfoQCOM'
--     in its @pNext@ chain, then @dstImage@ /must/ not have a
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion multi-planar format>
--
-- -   #VUID-VkCopyBufferToImageInfo2-pRegions-00171# @srcBuffer@ /must/ be
--     large enough to contain all buffer locations that are accessed
--     according to
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#copies-buffers-images-addressing Buffer and Image Addressing>,
--     for each element of @pRegions@
--
-- -   #VUID-VkCopyBufferToImageInfo2-pRegions-00173# 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-VkCopyBufferToImageInfo2-srcBuffer-00174# @srcBuffer@ /must/
--     have been created with
--     'Vulkan.Core10.Enums.BufferUsageFlagBits.BUFFER_USAGE_TRANSFER_SRC_BIT'
--     usage flag
--
-- -   #VUID-VkCopyBufferToImageInfo2-dstImage-01997# The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-format-features format features>
--     of @dstImage@ /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_TRANSFER_DST_BIT'
--
-- -   #VUID-VkCopyBufferToImageInfo2-srcBuffer-00176# If @srcBuffer@ is
--     non-sparse then it /must/ be bound completely and contiguously to a
--     single 'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   #VUID-VkCopyBufferToImageInfo2-dstImage-00177# @dstImage@ /must/
--     have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_TRANSFER_DST_BIT'
--     usage flag
--
-- -   #VUID-VkCopyBufferToImageInfo2-dstImage-00178# If @dstImage@ is
--     non-sparse then it /must/ be bound completely and contiguously to a
--     single 'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   #VUID-VkCopyBufferToImageInfo2-dstImage-00179# @dstImage@ /must/
--     have a sample count equal to
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SAMPLE_COUNT_1_BIT'
--
-- -   #VUID-VkCopyBufferToImageInfo2-dstImageLayout-00180#
--     @dstImageLayout@ /must/ specify the layout of the image subresources
--     of @dstImage@ specified in @pRegions@ at the time this command is
--     executed on a 'Vulkan.Core10.Handles.Device'
--
-- -   #VUID-VkCopyBufferToImageInfo2-dstImageLayout-01396#
--     @dstImageLayout@ /must/ be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_GENERAL', or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_SHARED_PRESENT_KHR'
--
-- -   #VUID-VkCopyBufferToImageInfo2-imageSubresource-01701# 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-VkCopyBufferToImageInfo2-imageSubresource-01702# The
--     @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-VkCopyBufferToImageInfo2-imageOffset-01793# The @imageOffset@
--     and @imageExtent@ members of each element of @pRegions@ /must/
--     respect the image transfer granularity requirements of
--     @commandBuffer@’s command pool’s queue family, as described in
--     'Vulkan.Core10.DeviceInitialization.QueueFamilyProperties'
--
-- -   #VUID-VkCopyBufferToImageInfo2-dstImage-02543# @dstImage@ /must/ not
--     have been created with @flags@ containing
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SUBSAMPLED_BIT_EXT'
--
-- -   #VUID-VkCopyBufferToImageInfo2-commandBuffer-04477# If the queue
--     family used to create the 'Vulkan.Core10.Handles.CommandPool' which
--     @commandBuffer@ was allocated from does not support
--     'Vulkan.Core10.Enums.QueueFlagBits.QUEUE_GRAPHICS_BIT', for each
--     element of @pRegions@, the @aspectMask@ member of @imageSubresource@
--     /must/ not be
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_DEPTH_BIT' or
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_STENCIL_BIT'
--
-- -   #VUID-VkCopyBufferToImageInfo2-pRegions-06223# For each element of
--     @pRegions@ not containing
--     'Vulkan.Extensions.VK_QCOM_rotated_copy_commands.CopyCommandTransformInfoQCOM'
--     in its @pNext@ chain, @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-VkCopyBufferToImageInfo2-pRegions-06224# For each element of
--     @pRegions@ not containing
--     'Vulkan.Extensions.VK_QCOM_rotated_copy_commands.CopyCommandTransformInfoQCOM'
--     in its @pNext@ chain, @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-VkCopyBufferToImageInfo2-bufferOffset-01558# If @dstImage@
--     does not have either a depth\/stencil or a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion multi-planar format>,
--     then for each element of @pRegions@, @bufferOffset@ /must/ be a
--     multiple of the format’s texel block size
--
-- -   #VUID-VkCopyBufferToImageInfo2-bufferOffset-01559# If @dstImage@ has
--     a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion multi-planar format>,
--     then for each element of @pRegions@, @bufferOffset@ /must/ be a
--     multiple of the element size of the compatible format for the format
--     and the @aspectMask@ of the @imageSubresource@ as defined in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatible-planes ???>
--
-- -   #VUID-VkCopyBufferToImageInfo2-srcImage-00199# 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-VkCopyBufferToImageInfo2-imageOffset-00200# 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-VkCopyBufferToImageInfo2-srcImage-00201# 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-VkCopyBufferToImageInfo2-bufferRowLength-00203# For each
--     element of @pRegions@, @bufferRowLength@ /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-VkCopyBufferToImageInfo2-bufferImageHeight-00204# For each
--     element of @pRegions@, @bufferImageHeight@ /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-VkCopyBufferToImageInfo2-pRegions-07273# For each element of
--     @pRegions@, @bufferOffset@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block size>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @dstImage@
--
-- -   #VUID-VkCopyBufferToImageInfo2-pRegions-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-VkCopyBufferToImageInfo2-pRegions-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-VkCopyBufferToImageInfo2-pRegions-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-VkCopyBufferToImageInfo2-imageExtent-00207# For each element
--     of @pRegions@, if the sum of @imageOffset.x@ and @extent.width@ does
--     not equal the width of the 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-VkCopyBufferToImageInfo2-imageExtent-00208# For each element
--     of @pRegions@, if the sum of @imageOffset.y@ and @extent.height@
--     does not equal the height of the 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-VkCopyBufferToImageInfo2-imageExtent-00209# For each element
--     of @pRegions@, if the sum of @imageOffset.z@ and @extent.depth@ does
--     not equal the depth of the 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-VkCopyBufferToImageInfo2-aspectMask-00211# For each element of
--     @pRegions@, @imageSubresource.aspectMask@ /must/ specify aspects
--     present in @dstImage@
--
-- -   #VUID-VkCopyBufferToImageInfo2-aspectMask-01560# If @dstImage@ has a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion multi-planar format>,
--     then for each element of @pRegions@, @imageSubresource.aspectMask@
--     /must/ be
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_0_BIT',
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_1_BIT',
--     or
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_2_BIT'
--     (with
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_2_BIT'
--     valid only for image formats with three planes)
--
-- -   #VUID-VkCopyBufferToImageInfo2-baseArrayLayer-00213# 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-VkCopyBufferToImageInfo2-pRegions-07277# For each element of
--     @pRegions@, @bufferRowLength@ 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-VkCopyBufferToImageInfo2-commandBuffer-04052# If the queue
--     family used to create the 'Vulkan.Core10.Handles.CommandPool' which
--     @commandBuffer@ was allocated from does not support
--     'Vulkan.Core10.Enums.QueueFlagBits.QUEUE_GRAPHICS_BIT' or
--     'Vulkan.Core10.Enums.QueueFlagBits.QUEUE_COMPUTE_BIT', the
--     @bufferOffset@ member of any element of @pRegions@ /must/ be a
--     multiple of @4@
--
-- -   #VUID-VkCopyBufferToImageInfo2-srcImage-04053# If @dstImage@ has a
--     depth\/stencil format, the @bufferOffset@ member of any element of
--     @pRegions@ /must/ be a multiple of @4@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkCopyBufferToImageInfo2-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_COPY_BUFFER_TO_IMAGE_INFO_2'
--
-- -   #VUID-VkCopyBufferToImageInfo2-pNext-pNext# @pNext@ /must/ be @NULL@
--
-- -   #VUID-VkCopyBufferToImageInfo2-srcBuffer-parameter# @srcBuffer@
--     /must/ be a valid 'Vulkan.Core10.Handles.Buffer' handle
--
-- -   #VUID-VkCopyBufferToImageInfo2-dstImage-parameter# @dstImage@ /must/
--     be a valid 'Vulkan.Core10.Handles.Image' handle
--
-- -   #VUID-VkCopyBufferToImageInfo2-dstImageLayout-parameter#
--     @dstImageLayout@ /must/ be a valid
--     'Vulkan.Core10.Enums.ImageLayout.ImageLayout' value
--
-- -   #VUID-VkCopyBufferToImageInfo2-pRegions-parameter# @pRegions@ /must/
--     be a valid pointer to an array of @regionCount@ valid
--     'BufferImageCopy2' structures
--
-- -   #VUID-VkCopyBufferToImageInfo2-regionCount-arraylength#
--     @regionCount@ /must/ be greater than @0@
--
-- -   #VUID-VkCopyBufferToImageInfo2-commonparent# Both of @dstImage@, and
--     @srcBuffer@ /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_KHR_copy_commands2 VK_KHR_copy_commands2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.Handles.Buffer', 'BufferImageCopy2',
-- 'Vulkan.Core10.Handles.Image',
-- 'Vulkan.Core10.Enums.ImageLayout.ImageLayout',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'cmdCopyBufferToImage2',
-- 'Vulkan.Extensions.VK_KHR_copy_commands2.cmdCopyBufferToImage2KHR'
data CopyBufferToImageInfo2 = CopyBufferToImageInfo2
  { -- | @srcBuffer@ is the source buffer.
    CopyBufferToImageInfo2 -> Buffer
srcBuffer :: Buffer
  , -- | @dstImage@ is the destination image.
    CopyBufferToImageInfo2 -> Image
dstImage :: Image
  , -- | @dstImageLayout@ is the layout of the destination image subresources for
    -- the copy.
    CopyBufferToImageInfo2 -> ImageLayout
dstImageLayout :: ImageLayout
  , -- | @pRegions@ is a pointer to an array of 'BufferImageCopy2' structures
    -- specifying the regions to copy.
    CopyBufferToImageInfo2 -> Vector (SomeStruct BufferImageCopy2)
regions :: Vector (SomeStruct BufferImageCopy2)
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CopyBufferToImageInfo2)
#endif
deriving instance Show CopyBufferToImageInfo2

instance ToCStruct CopyBufferToImageInfo2 where
  withCStruct :: forall b.
CopyBufferToImageInfo2
-> (("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
    -> IO b)
-> IO b
withCStruct CopyBufferToImageInfo2
x ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2) -> IO b
f = Int
-> (("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
    -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
48 ((("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
  -> IO b)
 -> IO b)
-> (("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
    -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \"pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2
p -> ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
-> CopyBufferToImageInfo2 -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2
p CopyBufferToImageInfo2
x (("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2) -> IO b
f "pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2
p)
  pokeCStruct :: forall b.
("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
-> CopyBufferToImageInfo2 -> IO b -> IO b
pokeCStruct "pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2
p CopyBufferToImageInfo2{Vector (SomeStruct BufferImageCopy2)
ImageLayout
Image
Buffer
regions :: Vector (SomeStruct BufferImageCopy2)
dstImageLayout :: ImageLayout
dstImage :: Image
srcBuffer :: Buffer
$sel:regions:CopyBufferToImageInfo2 :: CopyBufferToImageInfo2 -> Vector (SomeStruct BufferImageCopy2)
$sel:dstImageLayout:CopyBufferToImageInfo2 :: CopyBufferToImageInfo2 -> ImageLayout
$sel:dstImage:CopyBufferToImageInfo2 :: CopyBufferToImageInfo2 -> Image
$sel:srcBuffer:CopyBufferToImageInfo2 :: CopyBufferToImageInfo2 -> Buffer
..} 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 (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 (("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2
p ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COPY_BUFFER_TO_IMAGE_INFO_2)
    IO () -> ContT b IO ()
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 (("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2
p ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
-> 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 (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 Buffer -> Buffer -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2
p ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
-> Int -> Ptr Buffer
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Buffer)) (Buffer
srcBuffer)
    IO () -> ContT b IO ()
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 (("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2
p ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
-> Int -> Ptr Image
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Image)) (Image
dstImage)
    IO () -> ContT b IO ()
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 (("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2
p ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
-> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageLayout)) (ImageLayout
dstImageLayout)
    IO () -> ContT b IO ()
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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2
p ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector (SomeStruct BufferImageCopy2) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (SomeStruct BufferImageCopy2) -> Int)
-> Vector (SomeStruct BufferImageCopy2) -> Int
forall a b. (a -> b) -> a -> b
$ (Vector (SomeStruct BufferImageCopy2)
regions)) :: Word32))
    Ptr (BufferImageCopy2 Any)
pPRegions' <- ((Ptr (BufferImageCopy2 Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (BufferImageCopy2 Any))
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (BufferImageCopy2 Any) -> IO b) -> IO b)
 -> ContT b IO (Ptr (BufferImageCopy2 Any)))
-> ((Ptr (BufferImageCopy2 Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (BufferImageCopy2 Any))
forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @(BufferImageCopy2 _) ((Vector (SomeStruct BufferImageCopy2) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (SomeStruct BufferImageCopy2)
regions)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
72)
    (Int -> SomeStruct BufferImageCopy2 -> ContT b IO ())
-> Vector (SomeStruct BufferImageCopy2) -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i SomeStruct BufferImageCopy2
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (SomeStruct BufferImageCopy2)
-> SomeStruct BufferImageCopy2 -> IO b -> IO b
forall (a :: [*] -> *) b.
(forall (es :: [*]).
 (Extendss a es, PokeChain es) =>
 ToCStruct (a es)) =>
Ptr (SomeStruct a) -> SomeStruct a -> IO b -> IO b
pokeSomeCStruct (Ptr (BufferImageCopy2 Any) -> Ptr (SomeStruct BufferImageCopy2)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (BufferImageCopy2 Any)
pPRegions' Ptr (BufferImageCopy2 Any) -> Int -> Ptr (BufferImageCopy2 w)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
72 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (BufferImageCopy2 _))) (SomeStruct BufferImageCopy2
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector (SomeStruct BufferImageCopy2)
regions)
    IO () -> ContT b IO ()
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 (BufferImageCopy2 Any))
-> Ptr (BufferImageCopy2 Any) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2
p ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
-> Int -> Ptr (Ptr (BufferImageCopy2 w))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr (BufferImageCopy2 _)))) (Ptr (BufferImageCopy2 Any)
pPRegions')
    IO b -> ContT b IO b
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.
("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
-> IO b -> IO b
pokeZeroCStruct "pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2
p ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COPY_BUFFER_TO_IMAGE_INFO_2)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2
p ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Buffer -> Buffer -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2
p ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
-> Int -> Ptr Buffer
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Buffer)) (Buffer
forall a. Zero a => a
zero)
    Ptr Image -> Image -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2
p ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
-> 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 (("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2
p ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
-> 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 CopyBufferToImageInfo2 where
  peekCStruct :: ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
-> IO CopyBufferToImageInfo2
peekCStruct "pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2
p = do
    Buffer
srcBuffer <- forall a. Storable a => Ptr a -> IO a
peek @Buffer (("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2
p ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
-> Int -> Ptr Buffer
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Buffer))
    Image
dstImage <- forall a. Storable a => Ptr a -> IO a
peek @Image (("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2
p ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
-> 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 (("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2
p ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
-> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageLayout))
    Word32
regionCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2
p ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32))
    Ptr (BufferImageCopy2 Any)
pRegions <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr (BufferImageCopy2 _)) (("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2
p ("pCopyBufferToImageInfo" ::: Ptr CopyBufferToImageInfo2)
-> Int -> Ptr (Ptr (BufferImageCopy2 w))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr (BufferImageCopy2 _))))
    Vector (SomeStruct BufferImageCopy2)
pRegions' <- Int
-> (Int -> IO (SomeStruct BufferImageCopy2))
-> IO (Vector (SomeStruct BufferImageCopy2))
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
regionCount) (\Int
i -> Ptr (SomeStruct BufferImageCopy2)
-> IO (SomeStruct BufferImageCopy2)
forall (a :: [*] -> *).
(Extensible a,
 forall (es :: [*]).
 (Extendss a es, PeekChain es) =>
 FromCStruct (a es)) =>
Ptr (SomeStruct a) -> IO (SomeStruct a)
peekSomeCStruct (Ptr (BufferImageCopy2 Any) -> Ptr (SomeStruct BufferImageCopy2)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions ((Ptr (BufferImageCopy2 Any)
pRegions Ptr (BufferImageCopy2 Any) -> Int -> Ptr (BufferImageCopy2 Any)
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
72 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (BufferImageCopy2 _)))))
    CopyBufferToImageInfo2 -> IO CopyBufferToImageInfo2
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CopyBufferToImageInfo2 -> IO CopyBufferToImageInfo2)
-> CopyBufferToImageInfo2 -> IO CopyBufferToImageInfo2
forall a b. (a -> b) -> a -> b
$ Buffer
-> Image
-> ImageLayout
-> Vector (SomeStruct BufferImageCopy2)
-> CopyBufferToImageInfo2
CopyBufferToImageInfo2
             Buffer
srcBuffer Image
dstImage ImageLayout
dstImageLayout Vector (SomeStruct BufferImageCopy2)
pRegions'

instance Zero CopyBufferToImageInfo2 where
  zero :: CopyBufferToImageInfo2
zero = Buffer
-> Image
-> ImageLayout
-> Vector (SomeStruct BufferImageCopy2)
-> CopyBufferToImageInfo2
CopyBufferToImageInfo2
           Buffer
forall a. Zero a => a
zero
           Image
forall a. Zero a => a
zero
           ImageLayout
forall a. Zero a => a
zero
           Vector (SomeStruct BufferImageCopy2)
forall a. Monoid a => a
mempty


-- | VkCopyImageToBufferInfo2 - Structure specifying parameters of an image
-- to buffer copy command
--
-- == Valid Usage
--
-- -   #VUID-VkCopyImageToBufferInfo2-pRegions-04566# If the image region
--     specified by each element of @pRegions@ does not contain
--     'Vulkan.Extensions.VK_QCOM_rotated_copy_commands.CopyCommandTransformInfoQCOM'
--     in its @pNext@ chain, it /must/ be contained within the specified
--     @imageSubresource@ of @srcImage@
--
-- -   #VUID-VkCopyImageToBufferInfo2KHR-pRegions-04557# If the image
--     region specified by each element of @pRegions@ contains
--     'Vulkan.Extensions.VK_QCOM_rotated_copy_commands.CopyCommandTransformInfoQCOM'
--     in its @pNext@ chain, the rotated source region as described in
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#copies-buffers-images-rotation-addressing>
--     /must/ be contained within @srcImage@
--
-- -   #VUID-VkCopyImageToBufferInfo2KHR-pRegions-04558# If any element of
--     @pRegions@ contains
--     'Vulkan.Extensions.VK_QCOM_rotated_copy_commands.CopyCommandTransformInfoQCOM'
--     in its @pNext@ chain, then @srcImage@ /must/ have a 1x1x1
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#formats-compatibility-classes texel block extent>
--
-- -   #VUID-VkCopyImageToBufferInfo2KHR-pRegions-06205# If any element of
--     @pRegions@ contains
--     'Vulkan.Extensions.VK_QCOM_rotated_copy_commands.CopyCommandTransformInfoQCOM'
--     in its @pNext@ chain, then @srcImage@ /must/ be of type
--     'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_2D'
--
-- -   #VUID-VkCopyImageToBufferInfo2KHR-pRegions-06206# If any element of
--     @pRegions@ contains
--     'Vulkan.Extensions.VK_QCOM_rotated_copy_commands.CopyCommandTransformInfoQCOM'
--     in its @pNext@ chain, then @srcImage@ /must/ not have a
--     <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion multi-planar format>
--
-- -   #VUID-VkCopyImageToBufferInfo2-pRegions-00183# @dstBuffer@ /must/ be
--     large enough to contain all buffer locations that are accessed
--     according to
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#copies-buffers-images-addressing Buffer and Image Addressing>,
--     for each element of @pRegions@
--
-- -   #VUID-VkCopyImageToBufferInfo2-pRegions-00184# 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-VkCopyImageToBufferInfo2-srcImage-00186# @srcImage@ /must/
--     have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_TRANSFER_SRC_BIT'
--     usage flag
--
-- -   #VUID-VkCopyImageToBufferInfo2-srcImage-01998# The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-format-features format features>
--     of @srcImage@ /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_TRANSFER_SRC_BIT'
--
-- -   #VUID-VkCopyImageToBufferInfo2-srcImage-00187# If @srcImage@ is
--     non-sparse then it /must/ be bound completely and contiguously to a
--     single 'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   #VUID-VkCopyImageToBufferInfo2-dstBuffer-00191# @dstBuffer@ /must/
--     have been created with
--     'Vulkan.Core10.Enums.BufferUsageFlagBits.BUFFER_USAGE_TRANSFER_DST_BIT'
--     usage flag
--
-- -   #VUID-VkCopyImageToBufferInfo2-dstBuffer-00192# If @dstBuffer@ is
--     non-sparse then it /must/ be bound completely and contiguously to a
--     single 'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   #VUID-VkCopyImageToBufferInfo2-srcImage-00188# @srcImage@ /must/
--     have a sample count equal to
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SAMPLE_COUNT_1_BIT'
--
-- -   #VUID-VkCopyImageToBufferInfo2-srcImageLayout-00189#
--     @srcImageLayout@ /must/ specify the layout of the image subresources
--     of @srcImage@ specified in @pRegions@ at the time this command is
--     executed on a 'Vulkan.Core10.Handles.Device'
--
-- -   #VUID-VkCopyImageToBufferInfo2-srcImageLayout-01397#
--     @srcImageLayout@ /must/ be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_TRANSFER_SRC_OPTIMAL',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_GENERAL', or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_SHARED_PRESENT_KHR'
--
-- -   #VUID-VkCopyImageToBufferInfo2-imageSubresource-01703# 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-VkCopyImageToBufferInfo2-imageSubresource-01704# The
--     @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-VkCopyImageToBufferInfo2-imageOffset-01794# The @imageOffset@
--     and @imageExtent@ members of each element of @pRegions@ /must/
--     respect the image transfer granularity requirements of
--     @commandBuffer@’s command pool’s queue family, as described in
--     'Vulkan.Core10.DeviceInitialization.QueueFamilyProperties'
--
-- -   #VUID-VkCopyImageToBufferInfo2-srcImage-02544# @srcImage@ /must/ not
--     have been created with @flags@ containing
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SUBSAMPLED_BIT_EXT'
--
-- -   #VUID-VkCopyImageToBufferInfo2-imageOffset-00197# For each element
--     of @pRegions@ not containing
--     'Vulkan.Extensions.VK_QCOM_rotated_copy_commands.CopyCommandTransformInfoQCOM'
--     in its @pNext@ chain, @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-VkCopyImageToBufferInfo2-imageOffset-00198# For each element
--     of @pRegions@ not containing
--     'Vulkan.Extensions.VK_QCOM_rotated_copy_commands.CopyCommandTransformInfoQCOM'
--     in its @pNext@ chain, @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-VkCopyImageToBufferInfo2-bufferOffset-01558# If @srcImage@
--     does not have either a depth\/stencil or a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion multi-planar format>,
--     then for each element of @pRegions@, @bufferOffset@ /must/ be a
--     multiple of the format’s texel block size
--
-- -   #VUID-VkCopyImageToBufferInfo2-bufferOffset-01559# If @srcImage@ has
--     a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion multi-planar format>,
--     then for each element of @pRegions@, @bufferOffset@ /must/ be a
--     multiple of the element size of the compatible format for the format
--     and the @aspectMask@ of the @imageSubresource@ as defined in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatible-planes ???>
--
-- -   #VUID-VkCopyImageToBufferInfo2-srcImage-00199# 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-VkCopyImageToBufferInfo2-imageOffset-00200# 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-VkCopyImageToBufferInfo2-srcImage-00201# 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-VkCopyImageToBufferInfo2-bufferRowLength-00203# For each
--     element of @pRegions@, @bufferRowLength@ /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-VkCopyImageToBufferInfo2-bufferImageHeight-00204# For each
--     element of @pRegions@, @bufferImageHeight@ /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-VkCopyImageToBufferInfo2-pRegions-07273# For each element of
--     @pRegions@, @bufferOffset@ /must/ be a multiple of the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-compatibility-classes texel block size>
--     of the 'Vulkan.Core10.Enums.Format.Format' of @srcImage@
--
-- -   #VUID-VkCopyImageToBufferInfo2-pRegions-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-VkCopyImageToBufferInfo2-pRegions-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-VkCopyImageToBufferInfo2-pRegions-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-VkCopyImageToBufferInfo2-imageExtent-00207# For each element
--     of @pRegions@, if the sum of @imageOffset.x@ and @extent.width@ does
--     not equal the width of the 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-VkCopyImageToBufferInfo2-imageExtent-00208# For each element
--     of @pRegions@, if the sum of @imageOffset.y@ and @extent.height@
--     does not equal the height of the 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-VkCopyImageToBufferInfo2-imageExtent-00209# For each element
--     of @pRegions@, if the sum of @imageOffset.z@ and @extent.depth@ does
--     not equal the depth of the 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-VkCopyImageToBufferInfo2-aspectMask-00211# For each element of
--     @pRegions@, @imageSubresource.aspectMask@ /must/ specify aspects
--     present in @srcImage@
--
-- -   #VUID-VkCopyImageToBufferInfo2-aspectMask-01560# If @srcImage@ has a
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#formats-requiring-sampler-ycbcr-conversion multi-planar format>,
--     then for each element of @pRegions@, @imageSubresource.aspectMask@
--     /must/ be
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_0_BIT',
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_1_BIT',
--     or
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_2_BIT'
--     (with
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_PLANE_2_BIT'
--     valid only for image formats with three planes)
--
-- -   #VUID-VkCopyImageToBufferInfo2-baseArrayLayer-00213# 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-VkCopyImageToBufferInfo2-pRegions-07277# For each element of
--     @pRegions@, @bufferRowLength@ 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-VkCopyImageToBufferInfo2-commandBuffer-04052# If the queue
--     family used to create the 'Vulkan.Core10.Handles.CommandPool' which
--     @commandBuffer@ was allocated from does not support
--     'Vulkan.Core10.Enums.QueueFlagBits.QUEUE_GRAPHICS_BIT' or
--     'Vulkan.Core10.Enums.QueueFlagBits.QUEUE_COMPUTE_BIT', the
--     @bufferOffset@ member of any element of @pRegions@ /must/ be a
--     multiple of @4@
--
-- -   #VUID-VkCopyImageToBufferInfo2-srcImage-04053# If @srcImage@ has a
--     depth\/stencil format, the @bufferOffset@ member of any element of
--     @pRegions@ /must/ be a multiple of @4@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkCopyImageToBufferInfo2-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_COPY_IMAGE_TO_BUFFER_INFO_2'
--
-- -   #VUID-VkCopyImageToBufferInfo2-pNext-pNext# @pNext@ /must/ be @NULL@
--
-- -   #VUID-VkCopyImageToBufferInfo2-srcImage-parameter# @srcImage@ /must/
--     be a valid 'Vulkan.Core10.Handles.Image' handle
--
-- -   #VUID-VkCopyImageToBufferInfo2-srcImageLayout-parameter#
--     @srcImageLayout@ /must/ be a valid
--     'Vulkan.Core10.Enums.ImageLayout.ImageLayout' value
--
-- -   #VUID-VkCopyImageToBufferInfo2-dstBuffer-parameter# @dstBuffer@
--     /must/ be a valid 'Vulkan.Core10.Handles.Buffer' handle
--
-- -   #VUID-VkCopyImageToBufferInfo2-pRegions-parameter# @pRegions@ /must/
--     be a valid pointer to an array of @regionCount@ valid
--     'BufferImageCopy2' structures
--
-- -   #VUID-VkCopyImageToBufferInfo2-regionCount-arraylength#
--     @regionCount@ /must/ be greater than @0@
--
-- -   #VUID-VkCopyImageToBufferInfo2-commonparent# Both of @dstBuffer@,
--     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_KHR_copy_commands2 VK_KHR_copy_commands2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.Handles.Buffer', 'BufferImageCopy2',
-- 'Vulkan.Core10.Handles.Image',
-- 'Vulkan.Core10.Enums.ImageLayout.ImageLayout',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'cmdCopyImageToBuffer2',
-- 'Vulkan.Extensions.VK_KHR_copy_commands2.cmdCopyImageToBuffer2KHR'
data CopyImageToBufferInfo2 = CopyImageToBufferInfo2
  { -- | @srcImage@ is the source image.
    CopyImageToBufferInfo2 -> Image
srcImage :: Image
  , -- | @srcImageLayout@ is the layout of the source image subresources for the
    -- copy.
    CopyImageToBufferInfo2 -> ImageLayout
srcImageLayout :: ImageLayout
  , -- | @dstBuffer@ is the destination buffer.
    CopyImageToBufferInfo2 -> Buffer
dstBuffer :: Buffer
  , -- | @pRegions@ is a pointer to an array of 'BufferImageCopy2' structures
    -- specifying the regions to copy.
    CopyImageToBufferInfo2 -> Vector (SomeStruct BufferImageCopy2)
regions :: Vector (SomeStruct BufferImageCopy2)
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CopyImageToBufferInfo2)
#endif
deriving instance Show CopyImageToBufferInfo2

instance ToCStruct CopyImageToBufferInfo2 where
  withCStruct :: forall b.
CopyImageToBufferInfo2
-> (("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
    -> IO b)
-> IO b
withCStruct CopyImageToBufferInfo2
x ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2) -> IO b
f = Int
-> (("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
    -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
56 ((("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
  -> IO b)
 -> IO b)
-> (("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
    -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \"pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2
p -> ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
-> CopyImageToBufferInfo2 -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2
p CopyImageToBufferInfo2
x (("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2) -> IO b
f "pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2
p)
  pokeCStruct :: forall b.
("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
-> CopyImageToBufferInfo2 -> IO b -> IO b
pokeCStruct "pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2
p CopyImageToBufferInfo2{Vector (SomeStruct BufferImageCopy2)
ImageLayout
Image
Buffer
regions :: Vector (SomeStruct BufferImageCopy2)
dstBuffer :: Buffer
srcImageLayout :: ImageLayout
srcImage :: Image
$sel:regions:CopyImageToBufferInfo2 :: CopyImageToBufferInfo2 -> Vector (SomeStruct BufferImageCopy2)
$sel:dstBuffer:CopyImageToBufferInfo2 :: CopyImageToBufferInfo2 -> Buffer
$sel:srcImageLayout:CopyImageToBufferInfo2 :: CopyImageToBufferInfo2 -> ImageLayout
$sel:srcImage:CopyImageToBufferInfo2 :: CopyImageToBufferInfo2 -> Image
..} 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 (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 (("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2
p ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COPY_IMAGE_TO_BUFFER_INFO_2)
    IO () -> ContT b IO ()
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 (("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2
p ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
-> 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 (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 (("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2
p ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
-> Int -> Ptr Image
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Image)) (Image
srcImage)
    IO () -> ContT b IO ()
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 (("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2
p ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
-> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout)) (ImageLayout
srcImageLayout)
    IO () -> ContT b IO ()
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 Buffer -> Buffer -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2
p ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
-> Int -> Ptr Buffer
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Buffer)) (Buffer
dstBuffer)
    IO () -> ContT b IO ()
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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2
p ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector (SomeStruct BufferImageCopy2) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (SomeStruct BufferImageCopy2) -> Int)
-> Vector (SomeStruct BufferImageCopy2) -> Int
forall a b. (a -> b) -> a -> b
$ (Vector (SomeStruct BufferImageCopy2)
regions)) :: Word32))
    Ptr (BufferImageCopy2 Any)
pPRegions' <- ((Ptr (BufferImageCopy2 Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (BufferImageCopy2 Any))
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (BufferImageCopy2 Any) -> IO b) -> IO b)
 -> ContT b IO (Ptr (BufferImageCopy2 Any)))
-> ((Ptr (BufferImageCopy2 Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (BufferImageCopy2 Any))
forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @(BufferImageCopy2 _) ((Vector (SomeStruct BufferImageCopy2) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (SomeStruct BufferImageCopy2)
regions)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
72)
    (Int -> SomeStruct BufferImageCopy2 -> ContT b IO ())
-> Vector (SomeStruct BufferImageCopy2) -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i SomeStruct BufferImageCopy2
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (SomeStruct BufferImageCopy2)
-> SomeStruct BufferImageCopy2 -> IO b -> IO b
forall (a :: [*] -> *) b.
(forall (es :: [*]).
 (Extendss a es, PokeChain es) =>
 ToCStruct (a es)) =>
Ptr (SomeStruct a) -> SomeStruct a -> IO b -> IO b
pokeSomeCStruct (Ptr (BufferImageCopy2 Any) -> Ptr (SomeStruct BufferImageCopy2)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (BufferImageCopy2 Any)
pPRegions' Ptr (BufferImageCopy2 Any) -> Int -> Ptr (BufferImageCopy2 w)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
72 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (BufferImageCopy2 _))) (SomeStruct BufferImageCopy2
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector (SomeStruct BufferImageCopy2)
regions)
    IO () -> ContT b IO ()
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 (BufferImageCopy2 Any))
-> Ptr (BufferImageCopy2 Any) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2
p ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
-> Int -> Ptr (Ptr (BufferImageCopy2 w))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr (Ptr (BufferImageCopy2 _)))) (Ptr (BufferImageCopy2 Any)
pPRegions')
    IO b -> ContT b IO b
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
56
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
-> IO b -> IO b
pokeZeroCStruct "pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2
p ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COPY_IMAGE_TO_BUFFER_INFO_2)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2
p ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
-> 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 (("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2
p ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
-> 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 (("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2
p ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
-> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout)) (ImageLayout
forall a. Zero a => a
zero)
    Ptr Buffer -> Buffer -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2
p ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
-> Int -> Ptr Buffer
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Buffer)) (Buffer
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct CopyImageToBufferInfo2 where
  peekCStruct :: ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
-> IO CopyImageToBufferInfo2
peekCStruct "pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2
p = do
    Image
srcImage <- forall a. Storable a => Ptr a -> IO a
peek @Image (("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2
p ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
-> Int -> Ptr Image
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Image))
    ImageLayout
srcImageLayout <- forall a. Storable a => Ptr a -> IO a
peek @ImageLayout (("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2
p ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
-> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout))
    Buffer
dstBuffer <- forall a. Storable a => Ptr a -> IO a
peek @Buffer (("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2
p ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
-> Int -> Ptr Buffer
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Buffer))
    Word32
regionCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2
p ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word32))
    Ptr (BufferImageCopy2 Any)
pRegions <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr (BufferImageCopy2 _)) (("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2
p ("pCopyImageToBufferInfo" ::: Ptr CopyImageToBufferInfo2)
-> Int -> Ptr (Ptr (BufferImageCopy2 w))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr (Ptr (BufferImageCopy2 _))))
    Vector (SomeStruct BufferImageCopy2)
pRegions' <- Int
-> (Int -> IO (SomeStruct BufferImageCopy2))
-> IO (Vector (SomeStruct BufferImageCopy2))
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
regionCount) (\Int
i -> Ptr (SomeStruct BufferImageCopy2)
-> IO (SomeStruct BufferImageCopy2)
forall (a :: [*] -> *).
(Extensible a,
 forall (es :: [*]).
 (Extendss a es, PeekChain es) =>
 FromCStruct (a es)) =>
Ptr (SomeStruct a) -> IO (SomeStruct a)
peekSomeCStruct (Ptr (BufferImageCopy2 Any) -> Ptr (SomeStruct BufferImageCopy2)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions ((Ptr (BufferImageCopy2 Any)
pRegions Ptr (BufferImageCopy2 Any) -> Int -> Ptr (BufferImageCopy2 Any)
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
72 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (BufferImageCopy2 _)))))
    CopyImageToBufferInfo2 -> IO CopyImageToBufferInfo2
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CopyImageToBufferInfo2 -> IO CopyImageToBufferInfo2)
-> CopyImageToBufferInfo2 -> IO CopyImageToBufferInfo2
forall a b. (a -> b) -> a -> b
$ Image
-> ImageLayout
-> Buffer
-> Vector (SomeStruct BufferImageCopy2)
-> CopyImageToBufferInfo2
CopyImageToBufferInfo2
             Image
srcImage ImageLayout
srcImageLayout Buffer
dstBuffer Vector (SomeStruct BufferImageCopy2)
pRegions'

instance Zero CopyImageToBufferInfo2 where
  zero :: CopyImageToBufferInfo2
zero = Image
-> ImageLayout
-> Buffer
-> Vector (SomeStruct BufferImageCopy2)
-> CopyImageToBufferInfo2
CopyImageToBufferInfo2
           Image
forall a. Zero a => a
zero
           ImageLayout
forall a. Zero a => a
zero
           Buffer
forall a. Zero a => a
zero
           Vector (SomeStruct BufferImageCopy2)
forall a. Monoid a => a
mempty


-- | VkResolveImageInfo2 - Structure specifying parameters of resolve image
-- command
--
-- == Valid Usage
--
-- -   #VUID-VkResolveImageInfo2-pRegions-00255# 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-VkResolveImageInfo2-srcImage-00256# If @srcImage@ is
--     non-sparse then it /must/ be bound completely and contiguously to a
--     single 'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   #VUID-VkResolveImageInfo2-srcImage-00257# @srcImage@ /must/ have a
--     sample count equal to any valid sample count value other than
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SAMPLE_COUNT_1_BIT'
--
-- -   #VUID-VkResolveImageInfo2-dstImage-00258# If @dstImage@ is
--     non-sparse then it /must/ be bound completely and contiguously to a
--     single 'Vulkan.Core10.Handles.DeviceMemory' object
--
-- -   #VUID-VkResolveImageInfo2-dstImage-00259# @dstImage@ /must/ have a
--     sample count equal to
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SAMPLE_COUNT_1_BIT'
--
-- -   #VUID-VkResolveImageInfo2-srcImageLayout-00260# @srcImageLayout@
--     /must/ specify the layout of the image subresources of @srcImage@
--     specified in @pRegions@ at the time this command is executed on a
--     'Vulkan.Core10.Handles.Device'
--
-- -   #VUID-VkResolveImageInfo2-srcImageLayout-01400# @srcImageLayout@
--     /must/ be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_SHARED_PRESENT_KHR',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_TRANSFER_SRC_OPTIMAL'
--     or 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_GENERAL'
--
-- -   #VUID-VkResolveImageInfo2-dstImageLayout-00262# @dstImageLayout@
--     /must/ specify the layout of the image subresources of @dstImage@
--     specified in @pRegions@ at the time this command is executed on a
--     'Vulkan.Core10.Handles.Device'
--
-- -   #VUID-VkResolveImageInfo2-dstImageLayout-01401# @dstImageLayout@
--     /must/ be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_SHARED_PRESENT_KHR',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL'
--     or 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_GENERAL'
--
-- -   #VUID-VkResolveImageInfo2-dstImage-02003# The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-format-features format features>
--     of @dstImage@ /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_COLOR_ATTACHMENT_BIT'
--
-- -   #VUID-VkResolveImageInfo2-linearColorAttachment-06519# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-linearColorAttachment linearColorAttachment>
--     feature is enabled and the image is created with
--     'Vulkan.Core10.Enums.ImageTiling.IMAGE_TILING_LINEAR', the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-format-features format features>
--     of @dstImage@ /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_LINEAR_COLOR_ATTACHMENT_BIT_NV'
--
-- -   #VUID-VkResolveImageInfo2-srcImage-01386# @srcImage@ and @dstImage@
--     /must/ have been created with the same image format
--
-- -   #VUID-VkResolveImageInfo2-srcSubresource-01709# 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-VkResolveImageInfo2-dstSubresource-01710# 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-VkResolveImageInfo2-srcSubresource-01711# The
--     @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-VkResolveImageInfo2-dstSubresource-01712# The
--     @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-VkResolveImageInfo2-dstImage-02546# @dstImage@ and @srcImage@
--     /must/ not have been created with @flags@ containing
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SUBSAMPLED_BIT_EXT'
--
-- -   #VUID-VkResolveImageInfo2-srcImage-04446# If either @srcImage@ or
--     @dstImage@ are of type
--     'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_3D', then for each element
--     of @pRegions@, @srcSubresource.baseArrayLayer@ /must/ be @0@ and
--     @srcSubresource.layerCount@ /must/ be @1@
--
-- -   #VUID-VkResolveImageInfo2-srcImage-04447# If either @srcImage@ or
--     @dstImage@ are of type
--     'Vulkan.Core10.Enums.ImageType.IMAGE_TYPE_3D', then for each element
--     of @pRegions@, @dstSubresource.baseArrayLayer@ /must/ be @0@ and
--     @dstSubresource.layerCount@ /must/ be @1@
--
-- -   #VUID-VkResolveImageInfo2-srcOffset-00269# 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-VkResolveImageInfo2-srcOffset-00270# 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-VkResolveImageInfo2-srcImage-00271# 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-VkResolveImageInfo2-srcOffset-00272# 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-VkResolveImageInfo2-srcImage-00273# 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-VkResolveImageInfo2-dstOffset-00274# 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-VkResolveImageInfo2-dstOffset-00275# 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-VkResolveImageInfo2-dstImage-00276# 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-VkResolveImageInfo2-dstOffset-00277# 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-VkResolveImageInfo2-dstImage-00278# 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-VkResolveImageInfo2-srcImage-06762# @srcImage@ /must/ have
--     been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_TRANSFER_SRC_BIT'
--     usage flag
--
-- -   #VUID-VkResolveImageInfo2-srcImage-06763# The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-format-features format features>
--     of @srcImage@ /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_TRANSFER_SRC_BIT'
--
-- -   #VUID-VkResolveImageInfo2-dstImage-06764# @dstImage@ /must/ have
--     been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_TRANSFER_DST_BIT'
--     usage flag
--
-- -   #VUID-VkResolveImageInfo2-dstImage-06765# The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-format-features format features>
--     of @dstImage@ /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_TRANSFER_DST_BIT'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkResolveImageInfo2-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_RESOLVE_IMAGE_INFO_2'
--
-- -   #VUID-VkResolveImageInfo2-pNext-pNext# @pNext@ /must/ be @NULL@
--
-- -   #VUID-VkResolveImageInfo2-srcImage-parameter# @srcImage@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Image' handle
--
-- -   #VUID-VkResolveImageInfo2-srcImageLayout-parameter# @srcImageLayout@
--     /must/ be a valid 'Vulkan.Core10.Enums.ImageLayout.ImageLayout'
--     value
--
-- -   #VUID-VkResolveImageInfo2-dstImage-parameter# @dstImage@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Image' handle
--
-- -   #VUID-VkResolveImageInfo2-dstImageLayout-parameter# @dstImageLayout@
--     /must/ be a valid 'Vulkan.Core10.Enums.ImageLayout.ImageLayout'
--     value
--
-- -   #VUID-VkResolveImageInfo2-pRegions-parameter# @pRegions@ /must/ be a
--     valid pointer to an array of @regionCount@ valid 'ImageResolve2'
--     structures
--
-- -   #VUID-VkResolveImageInfo2-regionCount-arraylength# @regionCount@
--     /must/ be greater than @0@
--
-- -   #VUID-VkResolveImageInfo2-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_KHR_copy_commands2 VK_KHR_copy_commands2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.Handles.Image',
-- 'Vulkan.Core10.Enums.ImageLayout.ImageLayout', 'ImageResolve2',
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'cmdResolveImage2',
-- 'Vulkan.Extensions.VK_KHR_copy_commands2.cmdResolveImage2KHR'
data ResolveImageInfo2 = ResolveImageInfo2
  { -- | @srcImage@ is the source image.
    ResolveImageInfo2 -> Image
srcImage :: Image
  , -- | @srcImageLayout@ is the layout of the source image subresources for the
    -- resolve.
    ResolveImageInfo2 -> ImageLayout
srcImageLayout :: ImageLayout
  , -- | @dstImage@ is the destination image.
    ResolveImageInfo2 -> Image
dstImage :: Image
  , -- | @dstImageLayout@ is the layout of the destination image subresources for
    -- the resolve.
    ResolveImageInfo2 -> ImageLayout
dstImageLayout :: ImageLayout
  , -- | @pRegions@ is a pointer to an array of 'ImageResolve2' structures
    -- specifying the regions to resolve.
    ResolveImageInfo2 -> Vector ImageResolve2
regions :: Vector ImageResolve2
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ResolveImageInfo2)
#endif
deriving instance Show ResolveImageInfo2

instance ToCStruct ResolveImageInfo2 where
  withCStruct :: forall b.
ResolveImageInfo2
-> (("pResolveImageInfo" ::: Ptr ResolveImageInfo2) -> IO b)
-> IO b
withCStruct ResolveImageInfo2
x ("pResolveImageInfo" ::: Ptr ResolveImageInfo2) -> IO b
f = Int
-> (("pResolveImageInfo" ::: Ptr ResolveImageInfo2) -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
56 ((("pResolveImageInfo" ::: Ptr ResolveImageInfo2) -> IO b) -> IO b)
-> (("pResolveImageInfo" ::: Ptr ResolveImageInfo2) -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \"pResolveImageInfo" ::: Ptr ResolveImageInfo2
p -> ("pResolveImageInfo" ::: Ptr ResolveImageInfo2)
-> ResolveImageInfo2 -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pResolveImageInfo" ::: Ptr ResolveImageInfo2
p ResolveImageInfo2
x (("pResolveImageInfo" ::: Ptr ResolveImageInfo2) -> IO b
f "pResolveImageInfo" ::: Ptr ResolveImageInfo2
p)
  pokeCStruct :: forall b.
("pResolveImageInfo" ::: Ptr ResolveImageInfo2)
-> ResolveImageInfo2 -> IO b -> IO b
pokeCStruct "pResolveImageInfo" ::: Ptr ResolveImageInfo2
p ResolveImageInfo2{Vector ImageResolve2
ImageLayout
Image
regions :: Vector ImageResolve2
dstImageLayout :: ImageLayout
dstImage :: Image
srcImageLayout :: ImageLayout
srcImage :: Image
$sel:regions:ResolveImageInfo2 :: ResolveImageInfo2 -> Vector ImageResolve2
$sel:dstImageLayout:ResolveImageInfo2 :: ResolveImageInfo2 -> ImageLayout
$sel:dstImage:ResolveImageInfo2 :: ResolveImageInfo2 -> Image
$sel:srcImageLayout:ResolveImageInfo2 :: ResolveImageInfo2 -> ImageLayout
$sel:srcImage:ResolveImageInfo2 :: ResolveImageInfo2 -> Image
..} 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 (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 (("pResolveImageInfo" ::: Ptr ResolveImageInfo2
p ("pResolveImageInfo" ::: Ptr ResolveImageInfo2)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_RESOLVE_IMAGE_INFO_2)
    IO () -> ContT b IO ()
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 (("pResolveImageInfo" ::: Ptr ResolveImageInfo2
p ("pResolveImageInfo" ::: Ptr ResolveImageInfo2)
-> 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 (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 (("pResolveImageInfo" ::: Ptr ResolveImageInfo2
p ("pResolveImageInfo" ::: Ptr ResolveImageInfo2) -> Int -> Ptr Image
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Image)) (Image
srcImage)
    IO () -> ContT b IO ()
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 (("pResolveImageInfo" ::: Ptr ResolveImageInfo2
p ("pResolveImageInfo" ::: Ptr ResolveImageInfo2)
-> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout)) (ImageLayout
srcImageLayout)
    IO () -> ContT b IO ()
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 (("pResolveImageInfo" ::: Ptr ResolveImageInfo2
p ("pResolveImageInfo" ::: Ptr ResolveImageInfo2) -> Int -> Ptr Image
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Image)) (Image
dstImage)
    IO () -> ContT b IO ()
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 (("pResolveImageInfo" ::: Ptr ResolveImageInfo2
p ("pResolveImageInfo" ::: Ptr ResolveImageInfo2)
-> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr ImageLayout)) (ImageLayout
dstImageLayout)
    IO () -> ContT b IO ()
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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pResolveImageInfo" ::: Ptr ResolveImageInfo2
p ("pResolveImageInfo" ::: Ptr ResolveImageInfo2)
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector ImageResolve2 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector ImageResolve2 -> Int) -> Vector ImageResolve2 -> Int
forall a b. (a -> b) -> a -> b
$ (Vector ImageResolve2
regions)) :: Word32))
    Ptr ImageResolve2
pPRegions' <- ((Ptr ImageResolve2 -> IO b) -> IO b)
-> ContT b IO (Ptr ImageResolve2)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ImageResolve2 -> IO b) -> IO b)
 -> ContT b IO (Ptr ImageResolve2))
-> ((Ptr ImageResolve2 -> IO b) -> IO b)
-> ContT b IO (Ptr ImageResolve2)
forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @ImageResolve2 ((Vector ImageResolve2 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector ImageResolve2
regions)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
88)
    IO () -> ContT b IO ()
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 -> ImageResolve2 -> IO ()) -> Vector ImageResolve2 -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i ImageResolve2
e -> Ptr ImageResolve2 -> ImageResolve2 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ImageResolve2
pPRegions' Ptr ImageResolve2 -> Int -> Ptr ImageResolve2
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
88 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr ImageResolve2) (ImageResolve2
e)) (Vector ImageResolve2
regions)
    IO () -> ContT b IO ()
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 ImageResolve2) -> Ptr ImageResolve2 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pResolveImageInfo" ::: Ptr ResolveImageInfo2
p ("pResolveImageInfo" ::: Ptr ResolveImageInfo2)
-> Int -> Ptr (Ptr ImageResolve2)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr (Ptr ImageResolve2))) (Ptr ImageResolve2
pPRegions')
    IO b -> ContT b IO b
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
56
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
("pResolveImageInfo" ::: Ptr ResolveImageInfo2) -> IO b -> IO b
pokeZeroCStruct "pResolveImageInfo" ::: Ptr ResolveImageInfo2
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pResolveImageInfo" ::: Ptr ResolveImageInfo2
p ("pResolveImageInfo" ::: Ptr ResolveImageInfo2)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_RESOLVE_IMAGE_INFO_2)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pResolveImageInfo" ::: Ptr ResolveImageInfo2
p ("pResolveImageInfo" ::: Ptr ResolveImageInfo2)
-> 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 (("pResolveImageInfo" ::: Ptr ResolveImageInfo2
p ("pResolveImageInfo" ::: Ptr ResolveImageInfo2) -> 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 (("pResolveImageInfo" ::: Ptr ResolveImageInfo2
p ("pResolveImageInfo" ::: Ptr ResolveImageInfo2)
-> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout)) (ImageLayout
forall a. Zero a => a
zero)
    Ptr Image -> Image -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pResolveImageInfo" ::: Ptr ResolveImageInfo2
p ("pResolveImageInfo" ::: Ptr ResolveImageInfo2) -> Int -> Ptr Image
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Image)) (Image
forall a. Zero a => a
zero)
    Ptr ImageLayout -> ImageLayout -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pResolveImageInfo" ::: Ptr ResolveImageInfo2
p ("pResolveImageInfo" ::: Ptr ResolveImageInfo2)
-> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr ImageLayout)) (ImageLayout
forall a. Zero a => a
zero)
    IO b
f

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

instance Zero ResolveImageInfo2 where
  zero :: ResolveImageInfo2
zero = Image
-> ImageLayout
-> Image
-> ImageLayout
-> Vector ImageResolve2
-> ResolveImageInfo2
ResolveImageInfo2
           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 ImageResolve2
forall a. Monoid a => a
mempty