{-# language CPP #-}
-- No documentation found for Chapter "Promoted_From_VK_KHR_dynamic_rendering"
module Vulkan.Core13.Promoted_From_VK_KHR_dynamic_rendering  ( cmdBeginRendering
                                                             , cmdUseRendering
                                                             , cmdEndRendering
                                                             , PipelineRenderingCreateInfo(..)
                                                             , RenderingInfo(..)
                                                             , RenderingAttachmentInfo(..)
                                                             , PhysicalDeviceDynamicRenderingFeatures(..)
                                                             , CommandBufferInheritanceRenderingInfo(..)
                                                             , AttachmentStoreOp(..)
                                                             , StructureType(..)
                                                             , RenderingFlagBits(..)
                                                             , RenderingFlags
                                                             ) where

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.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.CStruct.Extends (forgetExtensions)
import Vulkan.Core10.Enums.AttachmentLoadOp (AttachmentLoadOp)
import Vulkan.Core10.Enums.AttachmentStoreOp (AttachmentStoreOp)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.CStruct.Extends (Chain)
import Vulkan.Core10.CommandBufferBuilding (ClearValue)
import Vulkan.Core10.Handles (CommandBuffer)
import Vulkan.Core10.Handles (CommandBuffer(..))
import Vulkan.Core10.Handles (CommandBuffer(CommandBuffer))
import Vulkan.Core10.Handles (CommandBuffer_T)
import Vulkan.Dynamic (DeviceCmds(pVkCmdBeginRendering))
import Vulkan.Dynamic (DeviceCmds(pVkCmdEndRendering))
import {-# SOURCE #-} Vulkan.Core11.Promoted_From_VK_KHR_device_group (DeviceGroupRenderPassBeginInfo)
import Vulkan.CStruct.Extends (Extends)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (Extensible(..))
import Vulkan.Core10.Enums.Format (Format)
import Vulkan.Core10.Enums.ImageLayout (ImageLayout)
import Vulkan.Core10.Handles (ImageView)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_dynamic_rendering (MultiviewPerViewAttributesInfoNVX)
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (PokeChain(..))
import Vulkan.Core10.FundamentalTypes (Rect2D)
import Vulkan.Core13.Enums.RenderingFlagBits (RenderingFlags)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_dynamic_rendering (RenderingFragmentDensityMapAttachmentInfoEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_dynamic_rendering (RenderingFragmentShadingRateAttachmentInfoKHR)
import Vulkan.Core12.Enums.ResolveModeFlagBits (ResolveModeFlagBits)
import Vulkan.Core10.Enums.SampleCountFlagBits (SampleCountFlagBits)
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_COMMAND_BUFFER_INHERITANCE_RENDERING_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_DYNAMIC_RENDERING_FEATURES))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_RENDERING_CREATE_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_RENDERING_ATTACHMENT_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_RENDERING_INFO))
import Vulkan.Core10.Enums.AttachmentStoreOp (AttachmentStoreOp(..))
import Vulkan.Core13.Enums.RenderingFlagBits (RenderingFlagBits(..))
import Vulkan.Core13.Enums.RenderingFlagBits (RenderingFlags)
import Vulkan.Core10.Enums.StructureType (StructureType(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdBeginRendering
  :: FunPtr (Ptr CommandBuffer_T -> Ptr (SomeStruct RenderingInfo) -> IO ()) -> Ptr CommandBuffer_T -> Ptr (SomeStruct RenderingInfo) -> IO ()

-- | vkCmdBeginRendering - Begin a dynamic render pass instance
--
-- = Description
--
-- After beginning a render pass instance, the command buffer is ready to
-- record
-- <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#drawing draw commands>.
--
-- If @pRenderingInfo->flags@ includes
-- 'Vulkan.Core13.Enums.RenderingFlagBits.RENDERING_RESUMING_BIT' then this
-- render pass is resumed from a render pass instance that has been
-- suspended earlier in
-- <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-submission-order submission order>.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdBeginRendering-dynamicRendering-06446# The
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#features-dynamicRendering dynamicRendering>
--     feature /must/ be enabled
--
-- -   #VUID-vkCmdBeginRendering-commandBuffer-06068# If @commandBuffer@ is
--     a secondary command buffer, @pRenderingInfo->flags@ /must/ not
--     include
--     'Vulkan.Core13.Enums.RenderingFlagBits.RENDERING_CONTENTS_SECONDARY_COMMAND_BUFFERS_BIT'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdBeginRendering-commandBuffer-parameter# @commandBuffer@
--     /must/ be a valid 'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdBeginRendering-pRenderingInfo-parameter# @pRenderingInfo@
--     /must/ be a valid pointer to a valid 'RenderingInfo' structure
--
-- -   #VUID-vkCmdBeginRendering-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-vkCmdBeginRendering-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- -   #VUID-vkCmdBeginRendering-renderpass# This command /must/ only be
--     called outside of a render pass instance
--
-- == 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#VkQueueFlagBits Supported Queue Types> |
-- +============================================================================================================================+========================================================================================================================+=======================================================================================================================+
-- | Primary                                                                                                                    | Outside                                                                                                                | Graphics                                                                                                              |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                       |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_dynamic_rendering VK_KHR_dynamic_rendering>,
-- <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', 'RenderingInfo'
cmdBeginRendering :: forall a io
                   . (Extendss RenderingInfo a, PokeChain a, MonadIO io)
                  => -- | @commandBuffer@ is the command buffer in which to record the command.
                     CommandBuffer
                  -> -- | @pRenderingInfo@ is a pointer to a 'RenderingInfo' structure specifying
                     -- details of the render pass instance to begin.
                     (RenderingInfo a)
                  -> io ()
cmdBeginRendering :: CommandBuffer -> RenderingInfo a -> io ()
cmdBeginRendering CommandBuffer
commandBuffer RenderingInfo a
renderingInfo = 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 vkCmdBeginRenderingPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfo)) -> IO ())
vkCmdBeginRenderingPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfo)) -> IO ())
pVkCmdBeginRendering (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
   -> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfo)) -> IO ())
vkCmdBeginRenderingPtr FunPtr
  (Ptr CommandBuffer_T
   -> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfo)) -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfo)) -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfo)) -> 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 vkCmdBeginRendering is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdBeginRendering' :: Ptr CommandBuffer_T
-> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfo)) -> IO ()
vkCmdBeginRendering' = FunPtr
  (Ptr CommandBuffer_T
   -> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfo)) -> IO ())
-> Ptr CommandBuffer_T
-> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfo))
-> IO ()
mkVkCmdBeginRendering FunPtr
  (Ptr CommandBuffer_T
   -> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfo)) -> IO ())
vkCmdBeginRenderingPtr
  Ptr (RenderingInfo a)
pRenderingInfo <- ((Ptr (RenderingInfo a) -> IO ()) -> IO ())
-> ContT () IO (Ptr (RenderingInfo a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (RenderingInfo a) -> IO ()) -> IO ())
 -> ContT () IO (Ptr (RenderingInfo a)))
-> ((Ptr (RenderingInfo a) -> IO ()) -> IO ())
-> ContT () IO (Ptr (RenderingInfo a))
forall a b. (a -> b) -> a -> b
$ RenderingInfo a -> (Ptr (RenderingInfo a) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (RenderingInfo a
renderingInfo)
  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
"vkCmdBeginRendering" (Ptr CommandBuffer_T
-> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfo)) -> IO ()
vkCmdBeginRendering' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) (Ptr (RenderingInfo a)
-> "pRenderingInfo" ::: Ptr (SomeStruct RenderingInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (RenderingInfo a)
pRenderingInfo))
  () -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()

-- | This function will call the supplied action between calls to
-- 'cmdBeginRendering' and 'cmdEndRendering'
--
-- Note that 'cmdEndRendering' is *not* called if an exception is thrown by
-- the inner action.
cmdUseRendering :: forall a io r . (Extendss RenderingInfo a, PokeChain a, MonadIO io) => CommandBuffer -> RenderingInfo a -> io r -> io r
cmdUseRendering :: CommandBuffer -> RenderingInfo a -> io r -> io r
cmdUseRendering CommandBuffer
commandBuffer RenderingInfo a
pRenderingInfo io r
a =
  (CommandBuffer -> RenderingInfo a -> io ()
forall (a :: [*]) (io :: * -> *).
(Extendss RenderingInfo a, PokeChain a, MonadIO io) =>
CommandBuffer -> RenderingInfo a -> io ()
cmdBeginRendering CommandBuffer
commandBuffer RenderingInfo a
pRenderingInfo) io () -> io r -> io r
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> io r
a io r -> io () -> io r
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (CommandBuffer -> io ()
forall (io :: * -> *). MonadIO io => CommandBuffer -> io ()
cmdEndRendering CommandBuffer
commandBuffer)


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

-- | vkCmdEndRendering - End a dynamic render pass instance
--
-- = Description
--
-- If the value of @pRenderingInfo->flags@ used to begin this render pass
-- instance included
-- 'Vulkan.Core13.Enums.RenderingFlagBits.RENDERING_SUSPENDING_BIT', then
-- this render pass is suspended and will be resumed later in
-- <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-submission-order submission order>.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdEndRendering-None-06161# The current render pass instance
--     /must/ have been begun with 'cmdBeginRendering'
--
-- -   #VUID-vkCmdEndRendering-commandBuffer-06162# The current render pass
--     instance /must/ have been begun in @commandBuffer@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdEndRendering-commandBuffer-parameter# @commandBuffer@
--     /must/ be a valid 'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdEndRendering-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-vkCmdEndRendering-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- -   #VUID-vkCmdEndRendering-renderpass# This command /must/ only be
--     called inside of a render pass instance
--
-- == 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#VkQueueFlagBits Supported Queue Types> |
-- +============================================================================================================================+========================================================================================================================+=======================================================================================================================+
-- | Primary                                                                                                                    | Inside                                                                                                                 | Graphics                                                                                                              |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                       |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_dynamic_rendering VK_KHR_dynamic_rendering>,
-- <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'
cmdEndRendering :: forall io
                 . (MonadIO io)
                => -- | @commandBuffer@ is the command buffer in which to record the command.
                   CommandBuffer
                -> io ()
cmdEndRendering :: CommandBuffer -> io ()
cmdEndRendering CommandBuffer
commandBuffer = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let vkCmdEndRenderingPtr :: FunPtr (Ptr CommandBuffer_T -> IO ())
vkCmdEndRenderingPtr = DeviceCmds -> FunPtr (Ptr CommandBuffer_T -> IO ())
pVkCmdEndRendering (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr (Ptr CommandBuffer_T -> IO ())
vkCmdEndRenderingPtr FunPtr (Ptr CommandBuffer_T -> IO ())
-> FunPtr (Ptr CommandBuffer_T -> IO ()) -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr (Ptr CommandBuffer_T -> 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 vkCmdEndRendering is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdEndRendering' :: Ptr CommandBuffer_T -> IO ()
vkCmdEndRendering' = FunPtr (Ptr CommandBuffer_T -> IO ())
-> Ptr CommandBuffer_T -> IO ()
mkVkCmdEndRendering FunPtr (Ptr CommandBuffer_T -> IO ())
vkCmdEndRenderingPtr
  String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdEndRendering" (Ptr CommandBuffer_T -> IO ()
vkCmdEndRendering' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)))
  () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ ()


-- | VkPipelineRenderingCreateInfo - Structure specifying attachment formats
--
-- = Description
--
-- When a pipeline is created without a 'Vulkan.Core10.Handles.RenderPass',
-- if this structure is present in the @pNext@ chain of
-- 'Vulkan.Core10.Pipeline.GraphicsPipelineCreateInfo', it specifies the
-- view mask and format of attachments used for rendering. If this
-- structure is not specified, and the pipeline does not include a
-- 'Vulkan.Core10.Handles.RenderPass', @viewMask@ and
-- @colorAttachmentCount@ are @0@, and @depthAttachmentFormat@ and
-- @stencilAttachmentFormat@ are
-- 'Vulkan.Core10.Enums.Format.FORMAT_UNDEFINED'. If a graphics pipeline is
-- created with a valid 'Vulkan.Core10.Handles.RenderPass', parameters of
-- this structure are ignored.
--
-- If @depthAttachmentFormat@, @stencilAttachmentFormat@, or any element of
-- @pColorAttachmentFormats@ is
-- 'Vulkan.Core10.Enums.Format.FORMAT_UNDEFINED', it indicates that the
-- corresponding attachment is unused within the render pass. Valid formats
-- indicate that an attachment /can/ be used - but it is still valid to set
-- the attachment to @NULL@ when beginning rendering.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_dynamic_rendering VK_KHR_dynamic_rendering>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.Enums.Format.Format',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PipelineRenderingCreateInfo = PipelineRenderingCreateInfo
  { -- | @viewMask@ is the viewMask used for rendering.
    PipelineRenderingCreateInfo -> Word32
viewMask :: Word32
  , -- | @pColorAttachmentFormats@ is a pointer to an array of
    -- 'Vulkan.Core10.Enums.Format.Format' values defining the format of color
    -- attachments used in this pipeline.
    PipelineRenderingCreateInfo -> Vector Format
colorAttachmentFormats :: Vector Format
  , -- | @depthAttachmentFormat@ is a 'Vulkan.Core10.Enums.Format.Format' value
    -- defining the format of the depth attachment used in this pipeline.
    PipelineRenderingCreateInfo -> Format
depthAttachmentFormat :: Format
  , -- | @stencilAttachmentFormat@ is a 'Vulkan.Core10.Enums.Format.Format' value
    -- defining the format of the stencil attachment used in this pipeline.
    PipelineRenderingCreateInfo -> Format
stencilAttachmentFormat :: Format
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineRenderingCreateInfo)
#endif
deriving instance Show PipelineRenderingCreateInfo

instance ToCStruct PipelineRenderingCreateInfo where
  withCStruct :: PipelineRenderingCreateInfo
-> (Ptr PipelineRenderingCreateInfo -> IO b) -> IO b
withCStruct PipelineRenderingCreateInfo
x Ptr PipelineRenderingCreateInfo -> IO b
f = Int -> (Ptr PipelineRenderingCreateInfo -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 ((Ptr PipelineRenderingCreateInfo -> IO b) -> IO b)
-> (Ptr PipelineRenderingCreateInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PipelineRenderingCreateInfo
p -> Ptr PipelineRenderingCreateInfo
-> PipelineRenderingCreateInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PipelineRenderingCreateInfo
p PipelineRenderingCreateInfo
x (Ptr PipelineRenderingCreateInfo -> IO b
f Ptr PipelineRenderingCreateInfo
p)
  pokeCStruct :: Ptr PipelineRenderingCreateInfo
-> PipelineRenderingCreateInfo -> IO b -> IO b
pokeCStruct Ptr PipelineRenderingCreateInfo
p PipelineRenderingCreateInfo{Word32
Vector Format
Format
stencilAttachmentFormat :: Format
depthAttachmentFormat :: Format
colorAttachmentFormats :: Vector Format
viewMask :: Word32
$sel:stencilAttachmentFormat:PipelineRenderingCreateInfo :: PipelineRenderingCreateInfo -> Format
$sel:depthAttachmentFormat:PipelineRenderingCreateInfo :: PipelineRenderingCreateInfo -> Format
$sel:colorAttachmentFormats:PipelineRenderingCreateInfo :: PipelineRenderingCreateInfo -> Vector Format
$sel:viewMask:PipelineRenderingCreateInfo :: PipelineRenderingCreateInfo -> Word32
..} 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 PipelineRenderingCreateInfo
p Ptr PipelineRenderingCreateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_RENDERING_CREATE_INFO)
    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 PipelineRenderingCreateInfo
p Ptr PipelineRenderingCreateInfo -> 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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineRenderingCreateInfo
p Ptr PipelineRenderingCreateInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
viewMask)
    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 PipelineRenderingCreateInfo
p Ptr PipelineRenderingCreateInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Format -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Format -> Int) -> Vector Format -> Int
forall a b. (a -> b) -> a -> b
$ (Vector Format
colorAttachmentFormats)) :: Word32))
    Ptr Format
pPColorAttachmentFormats' <- ((Ptr Format -> IO b) -> IO b) -> ContT b IO (Ptr Format)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Format -> IO b) -> IO b) -> ContT b IO (Ptr Format))
-> ((Ptr Format -> IO b) -> IO b) -> ContT b IO (Ptr Format)
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr Format -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @Format ((Vector Format -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Format
colorAttachmentFormats)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4)
    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 -> Format -> IO ()) -> Vector Format -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Format
e -> Ptr Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Format
pPColorAttachmentFormats' Ptr Format -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Format) (Format
e)) (Vector Format
colorAttachmentFormats)
    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 Format) -> Ptr Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineRenderingCreateInfo
p Ptr PipelineRenderingCreateInfo -> Int -> Ptr (Ptr Format)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr Format))) (Ptr Format
pPColorAttachmentFormats')
    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 Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineRenderingCreateInfo
p Ptr PipelineRenderingCreateInfo -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Format)) (Format
depthAttachmentFormat)
    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 Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineRenderingCreateInfo
p Ptr PipelineRenderingCreateInfo -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Format)) (Format
stencilAttachmentFormat)
    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
40
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr PipelineRenderingCreateInfo -> IO b -> IO b
pokeZeroCStruct Ptr PipelineRenderingCreateInfo
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineRenderingCreateInfo
p Ptr PipelineRenderingCreateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_RENDERING_CREATE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineRenderingCreateInfo
p Ptr PipelineRenderingCreateInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineRenderingCreateInfo
p Ptr PipelineRenderingCreateInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineRenderingCreateInfo
p Ptr PipelineRenderingCreateInfo -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Format)) (Format
forall a. Zero a => a
zero)
    Ptr Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineRenderingCreateInfo
p Ptr PipelineRenderingCreateInfo -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Format)) (Format
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct PipelineRenderingCreateInfo where
  peekCStruct :: Ptr PipelineRenderingCreateInfo -> IO PipelineRenderingCreateInfo
peekCStruct Ptr PipelineRenderingCreateInfo
p = do
    Word32
viewMask <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PipelineRenderingCreateInfo
p Ptr PipelineRenderingCreateInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    Word32
colorAttachmentCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PipelineRenderingCreateInfo
p Ptr PipelineRenderingCreateInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
    Ptr Format
pColorAttachmentFormats <- Ptr (Ptr Format) -> IO (Ptr Format)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Format) ((Ptr PipelineRenderingCreateInfo
p Ptr PipelineRenderingCreateInfo -> Int -> Ptr (Ptr Format)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr Format)))
    Vector Format
pColorAttachmentFormats' <- Int -> (Int -> IO Format) -> IO (Vector Format)
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
colorAttachmentCount) (\Int
i -> Ptr Format -> IO Format
forall a. Storable a => Ptr a -> IO a
peek @Format ((Ptr Format
pColorAttachmentFormats Ptr Format -> Int -> Ptr Format
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Format)))
    Format
depthAttachmentFormat <- Ptr Format -> IO Format
forall a. Storable a => Ptr a -> IO a
peek @Format ((Ptr PipelineRenderingCreateInfo
p Ptr PipelineRenderingCreateInfo -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Format))
    Format
stencilAttachmentFormat <- Ptr Format -> IO Format
forall a. Storable a => Ptr a -> IO a
peek @Format ((Ptr PipelineRenderingCreateInfo
p Ptr PipelineRenderingCreateInfo -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Format))
    PipelineRenderingCreateInfo -> IO PipelineRenderingCreateInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PipelineRenderingCreateInfo -> IO PipelineRenderingCreateInfo)
-> PipelineRenderingCreateInfo -> IO PipelineRenderingCreateInfo
forall a b. (a -> b) -> a -> b
$ Word32
-> Vector Format -> Format -> Format -> PipelineRenderingCreateInfo
PipelineRenderingCreateInfo
             Word32
viewMask Vector Format
pColorAttachmentFormats' Format
depthAttachmentFormat Format
stencilAttachmentFormat

instance Zero PipelineRenderingCreateInfo where
  zero :: PipelineRenderingCreateInfo
zero = Word32
-> Vector Format -> Format -> Format -> PipelineRenderingCreateInfo
PipelineRenderingCreateInfo
           Word32
forall a. Zero a => a
zero
           Vector Format
forall a. Monoid a => a
mempty
           Format
forall a. Zero a => a
zero
           Format
forall a. Zero a => a
zero


-- | VkRenderingInfo - Structure specifying render pass instance begin info
--
-- = Description
--
-- If @viewMask@ is not @0@, multiview is enabled.
--
-- If there is an instance of
-- 'Vulkan.Core11.Promoted_From_VK_KHR_device_group.DeviceGroupRenderPassBeginInfo'
-- included in the @pNext@ chain and its @deviceCount@ member is not @0@,
-- then @renderArea@ is ignored, and the render area is defined per-device
-- by that structure.
--
-- Each element of the @pColorAttachments@ array corresponds to an output
-- location in the shader, i.e. if the shader declares an output variable
-- decorated with a @Location@ value of __X__, then it uses the attachment
-- provided in @pColorAttachments@[__X__]. If the @imageView@ member of any
-- element of @pColorAttachments@ is
-- 'Vulkan.Core10.APIConstants.NULL_HANDLE', writes to the corresponding
-- location by a fragment are discarded.
--
-- == Valid Usage
--
-- -   #VUID-VkRenderingInfo-viewMask-06069# If @viewMask@ is @0@,
--     @layerCount@ /must/ not be @0@
--
-- -   #VUID-VkRenderingInfo-imageView-06070# If neither the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_AMD_mixed_attachment_samples VK_AMD_mixed_attachment_samples>
--     nor the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_framebuffer_mixed_samples VK_NV_framebuffer_mixed_samples>
--     extensions are enabled, @imageView@ members of @pDepthAttachment@,
--     @pStencilAttachment@, and elements of @pColorAttachments@ that are
--     not 'Vulkan.Core10.APIConstants.NULL_HANDLE' /must/ have been
--     created with the same @sampleCount@
--
-- -   #VUID-VkRenderingInfo-pNext-06077# If the @pNext@ chain does not
--     contain
--     'Vulkan.Core11.Promoted_From_VK_KHR_device_group.DeviceGroupRenderPassBeginInfo'
--     or its @deviceRenderAreaCount@ member is equal to 0,
--     @renderArea.offset.x@ /must/ be greater than or equal to 0
--
-- -   #VUID-VkRenderingInfo-pNext-06078# If the @pNext@ chain does not
--     contain
--     'Vulkan.Core11.Promoted_From_VK_KHR_device_group.DeviceGroupRenderPassBeginInfo'
--     or its @deviceRenderAreaCount@ member is equal to 0,
--     @renderArea.offset.y@ /must/ be greater than or equal to 0
--
-- -   #VUID-VkRenderingInfo-pNext-06079# If the @pNext@ chain does not
--     contain
--     'Vulkan.Core11.Promoted_From_VK_KHR_device_group.DeviceGroupRenderPassBeginInfo'
--     or its @deviceRenderAreaCount@ member is equal to 0, the width of
--     the @imageView@ member of any element of @pColorAttachments@,
--     @pDepthAttachment@, or @pStencilAttachment@ that is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE' /must/ be greater than or
--     equal to @renderArea.offset.x@ + @renderArea.extent.width@
--
-- -   #VUID-VkRenderingInfo-pNext-06080# If the @pNext@ chain does not
--     contain
--     'Vulkan.Core11.Promoted_From_VK_KHR_device_group.DeviceGroupRenderPassBeginInfo'
--     or its @deviceRenderAreaCount@ member is equal to 0, the height of
--     the @imageView@ member of any element of @pColorAttachments@,
--     @pDepthAttachment@, or @pStencilAttachment@ that is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE' /must/ be greater than or
--     equal to @renderArea.offset.y@ + @renderArea.extent.height@
--
-- -   #VUID-VkRenderingInfo-pNext-06083# If the @pNext@ chain contains
--     'Vulkan.Core11.Promoted_From_VK_KHR_device_group.DeviceGroupRenderPassBeginInfo',
--     the width of the @imageView@ member of any element of
--     @pColorAttachments@, @pDepthAttachment@, or @pStencilAttachment@
--     that is not 'Vulkan.Core10.APIConstants.NULL_HANDLE' /must/ be
--     greater than or equal to the sum of the @offset.x@ and
--     @extent.width@ members of each element of @pDeviceRenderAreas@
--
-- -   #VUID-VkRenderingInfo-pNext-06084# If the @pNext@ chain contains
--     'Vulkan.Core11.Promoted_From_VK_KHR_device_group.DeviceGroupRenderPassBeginInfo',
--     the height of the @imageView@ member of any element of
--     @pColorAttachments@, @pDepthAttachment@, or @pStencilAttachment@
--     that is not 'Vulkan.Core10.APIConstants.NULL_HANDLE' /must/ be
--     greater than or equal to the sum of the @offset.y@ and
--     @extent.height@ members of each element of @pDeviceRenderAreas@
--
-- -   #VUID-VkRenderingInfo-pDepthAttachment-06085# If neither
--     @pDepthAttachment@ or @pStencilAttachment@ are @NULL@ and the
--     @imageView@ member of either structure is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', the @imageView@ member of
--     each structure /must/ be the same
--
-- -   #VUID-VkRenderingInfo-pDepthAttachment-06086# If neither
--     @pDepthAttachment@ or @pStencilAttachment@ are @NULL@, and the
--     @resolveMode@ member of each is not
--     'Vulkan.Core12.Enums.ResolveModeFlagBits.RESOLVE_MODE_NONE', the
--     @resolveImageView@ member of each structure /must/ be the same
--
-- -   #VUID-VkRenderingInfo-colorAttachmentCount-06087# If
--     @colorAttachmentCount@ is not @0@ and the @imageView@ member of an
--     element of @pColorAttachments@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', that @imageView@ /must/
--     have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_COLOR_ATTACHMENT_BIT'
--
-- -   #VUID-VkRenderingInfo-pDepthAttachment-06547# If @pDepthAttachment@
--     is not @NULL@ and @pDepthAttachment->imageView@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @pDepthAttachment->imageView@ /must/ have been created with a format
--     that includes a depth aspect
--
-- -   #VUID-VkRenderingInfo-pDepthAttachment-06088# If @pDepthAttachment@
--     is not @NULL@ and @pDepthAttachment->imageView@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @pDepthAttachment->imageView@ /must/ have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT'
--
-- -   #VUID-VkRenderingInfo-pStencilAttachment-06548# If
--     @pStencilAttachment@ is not @NULL@ and
--     @pStencilAttachment->imageView@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @pStencilAttachment->imageView@ /must/ have been created with a
--     format that includes a stencil aspect
--
-- -   #VUID-VkRenderingInfo-pStencilAttachment-06089# If
--     @pStencilAttachment@ is not @NULL@ and
--     @pStencilAttachment->imageView@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @pStencilAttachment->imageView@ /must/ have been created with a
--     stencil usage including
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT'
--
-- -   #VUID-VkRenderingInfo-colorAttachmentCount-06090# If
--     @colorAttachmentCount@ is not @0@ and the @imageView@ member of an
--     element of @pColorAttachments@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', the @layout@ member of
--     that element of @pColorAttachments@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL'
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_STENCIL_READ_ONLY_OPTIMAL'
--
-- -   #VUID-VkRenderingInfo-colorAttachmentCount-06091# If
--     @colorAttachmentCount@ is not @0@ and the @imageView@ member of an
--     element of @pColorAttachments@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', if the @resolveMode@
--     member of that element of @pColorAttachments@ is not
--     'Vulkan.Core12.Enums.ResolveModeFlagBits.RESOLVE_MODE_NONE', its
--     @resolveImageLayout@ member /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL'
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_STENCIL_READ_ONLY_OPTIMAL'
--
-- -   #VUID-VkRenderingInfo-pDepthAttachment-06092# If @pDepthAttachment@
--     is not @NULL@ and @pDepthAttachment->imageView@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', @pDepthAttachment->layout@
--     /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL'
--
-- -   #VUID-VkRenderingInfo-pDepthAttachment-06093# If @pDepthAttachment@
--     is not @NULL@, @pDepthAttachment->imageView@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', and
--     @pDepthAttachment->resolveMode@ is not
--     'Vulkan.Core12.Enums.ResolveModeFlagBits.RESOLVE_MODE_NONE',
--     @pDepthAttachment->resolveImageLayout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL'
--
-- -   #VUID-VkRenderingInfo-pStencilAttachment-06094# If
--     @pStencilAttachment@ is not @NULL@ and
--     @pStencilAttachment->imageView@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @pStencilAttachment->layout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL'
--
-- -   #VUID-VkRenderingInfo-pStencilAttachment-06095# If
--     @pStencilAttachment@ is not @NULL@, @pStencilAttachment->imageView@
--     is not 'Vulkan.Core10.APIConstants.NULL_HANDLE', and
--     @pStencilAttachment->resolveMode@ is not
--     'Vulkan.Core12.Enums.ResolveModeFlagBits.RESOLVE_MODE_NONE',
--     @pStencilAttachment->resolveImageLayout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL'
--
-- -   #VUID-VkRenderingInfo-colorAttachmentCount-06096# If
--     @colorAttachmentCount@ is not @0@ and the @imageView@ member of an
--     element of @pColorAttachments@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', the @layout@ member of
--     that element of @pColorAttachments@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_STENCIL_ATTACHMENT_OPTIMAL'
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_STENCIL_READ_ONLY_OPTIMAL'
--
-- -   #VUID-VkRenderingInfo-colorAttachmentCount-06097# If
--     @colorAttachmentCount@ is not @0@ and the @imageView@ member of an
--     element of @pColorAttachments@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', if the @resolveMode@
--     member of that element of @pColorAttachments@ is not
--     'Vulkan.Core12.Enums.ResolveModeFlagBits.RESOLVE_MODE_NONE', its
--     @resolveImageLayout@ member /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_STENCIL_ATTACHMENT_OPTIMAL'
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_STENCIL_READ_ONLY_OPTIMAL'
--
-- -   #VUID-VkRenderingInfo-pDepthAttachment-06098# If @pDepthAttachment@
--     is not @NULL@, @pDepthAttachment->imageView@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', and
--     @pDepthAttachment->resolveMode@ is not
--     'Vulkan.Core12.Enums.ResolveModeFlagBits.RESOLVE_MODE_NONE',
--     @pDepthAttachment->resolveImageLayout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_STENCIL_ATTACHMENT_OPTIMAL'
--
-- -   #VUID-VkRenderingInfo-pStencilAttachment-06099# If
--     @pStencilAttachment@ is not @NULL@, @pStencilAttachment->imageView@
--     is not 'Vulkan.Core10.APIConstants.NULL_HANDLE', and
--     @pStencilAttachment->resolveMode@ is not
--     'Vulkan.Core12.Enums.ResolveModeFlagBits.RESOLVE_MODE_NONE',
--     @pStencilAttachment->resolveImageLayout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_STENCIL_READ_ONLY_OPTIMAL'
--
-- -   #VUID-VkRenderingInfo-colorAttachmentCount-06100# If
--     @colorAttachmentCount@ is not @0@ and the @imageView@ member of an
--     element of @pColorAttachments@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', the @layout@ member of
--     that element of @pColorAttachments@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_OPTIMAL',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_OPTIMAL',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_STENCIL_ATTACHMENT_OPTIMAL',
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_STENCIL_READ_ONLY_OPTIMAL'
--
-- -   #VUID-VkRenderingInfo-colorAttachmentCount-06101# If
--     @colorAttachmentCount@ is not @0@ and the @imageView@ member of an
--     element of @pColorAttachments@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', if the @resolveMode@
--     member of that element of @pColorAttachments@ is not
--     'Vulkan.Core12.Enums.ResolveModeFlagBits.RESOLVE_MODE_NONE', its
--     @resolveImageLayout@ member /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_OPTIMAL',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_OPTIMAL',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_STENCIL_ATTACHMENT_OPTIMAL',
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_STENCIL_READ_ONLY_OPTIMAL'
--
-- -   #VUID-VkRenderingInfo-pDepthAttachment-06102# If @pDepthAttachment@
--     is not @NULL@ and @pDepthAttachment->imageView@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @pDepthAttachment->resolveMode@ /must/ be one of the bits set in
--     'Vulkan.Core12.Promoted_From_VK_KHR_depth_stencil_resolve.PhysicalDeviceDepthStencilResolveProperties'::@supportedDepthResolveModes@
--
-- -   #VUID-VkRenderingInfo-pStencilAttachment-06103# If
--     @pStencilAttachment@ is not @NULL@ and
--     @pStencilAttachment->imageView@ is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @pStencilAttachment->resolveMode@ /must/ be one of the bits set in
--     'Vulkan.Core12.Promoted_From_VK_KHR_depth_stencil_resolve.PhysicalDeviceDepthStencilResolveProperties'::@supportedStencilResolveModes@
--
-- -   #VUID-VkRenderingInfo-pDepthAttachment-06104# If @pDepthAttachment@
--     or @pStencilAttachment@ are both not @NULL@,
--     @pDepthAttachment->imageView@ and @pStencilAttachment->imageView@
--     are both not 'Vulkan.Core10.APIConstants.NULL_HANDLE', and
--     'Vulkan.Core12.Promoted_From_VK_KHR_depth_stencil_resolve.PhysicalDeviceDepthStencilResolveProperties'::@independentResolveNone@
--     is 'Vulkan.Core10.FundamentalTypes.FALSE', the @resolveMode@ of both
--     structures /must/ be the same value
--
-- -   #VUID-VkRenderingInfo-pDepthAttachment-06105# If @pDepthAttachment@
--     or @pStencilAttachment@ are both not @NULL@,
--     @pDepthAttachment->imageView@ and @pStencilAttachment->imageView@
--     are both not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     'Vulkan.Core12.Promoted_From_VK_KHR_depth_stencil_resolve.PhysicalDeviceDepthStencilResolveProperties'::@independentResolve@
--     is 'Vulkan.Core10.FundamentalTypes.FALSE', and the @resolveMode@ of
--     neither structure is
--     'Vulkan.Core12.Enums.ResolveModeFlagBits.RESOLVE_MODE_NONE', the
--     @resolveMode@ of both structures /must/ be the same value
--
-- -   #VUID-VkRenderingInfo-colorAttachmentCount-06106#
--     @colorAttachmentCount@ /must/ be less than or equal to
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxColorAttachments@
--
-- -   #VUID-VkRenderingInfo-imageView-06107# If the @imageView@ member of
--     a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingFragmentDensityMapAttachmentInfoEXT'
--     structure included in the @pNext@ chain is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', and
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#features-fragmentDensityMapNonSubsampledImages non-subsample image feature>
--     is not enabled, valid @imageView@ and @resolveImageView@ members of
--     @pDepthAttachment@, @pStencilAttachment@, and each element of
--     @pColorAttachments@ /must/ be a 'Vulkan.Core10.Handles.ImageView'
--     created with
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SUBSAMPLED_BIT_EXT'
--
-- -   #VUID-VkRenderingInfo-imageView-06108# If the @imageView@ member of
--     a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingFragmentDensityMapAttachmentInfoEXT'
--     structure included in the @pNext@ chain is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', and @viewMask@ is not @0@,
--     @imageView@ /must/ have a @layerCount@ greater than or equal to the
--     index of the most significant bit in @viewMask@
--
-- -   #VUID-VkRenderingInfo-imageView-06109# If the @imageView@ member of
--     a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingFragmentDensityMapAttachmentInfoEXT'
--     structure included in the @pNext@ chain is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', and @viewMask@ is @0@,
--     @imageView@ /must/ have a @layerCount@ equal to @1@
--
-- -   #VUID-VkRenderingInfo-pNext-06112# If the @pNext@ chain does not
--     contain
--     'Vulkan.Core11.Promoted_From_VK_KHR_device_group.DeviceGroupRenderPassBeginInfo'
--     or its @deviceRenderAreaCount@ member is equal to 0 and the
--     @imageView@ member of a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingFragmentDensityMapAttachmentInfoEXT'
--     structure included in the @pNext@ chain is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', @imageView@ /must/ have a
--     width greater than or equal to
--     \(\left\lceil{\frac{renderArea_{x}+renderArea_{width}}{maxFragmentDensityTexelSize_{width}}}\right\rceil\)
--
-- -   #VUID-VkRenderingInfo-pNext-06113# If the @pNext@ chain contains a
--     'Vulkan.Core11.Promoted_From_VK_KHR_device_group.DeviceGroupRenderPassBeginInfo'
--     structure, its @deviceRenderAreaCount@ member is not 0, and the
--     @imageView@ member of a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingFragmentDensityMapAttachmentInfoEXT'
--     structure included in the @pNext@ chain is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', @imageView@ /must/ have a
--     width greater than or equal to
--     \(\left\lceil{\frac{pDeviceRenderAreas_{x}+pDeviceRenderAreas_{width}}{maxFragmentDensityTexelSize_{width}}}\right\rceil\)
--     for each element of @pDeviceRenderAreas@
--
-- -   #VUID-VkRenderingInfo-pNext-06114# If the @pNext@ chain does not
--     contain
--     'Vulkan.Core11.Promoted_From_VK_KHR_device_group.DeviceGroupRenderPassBeginInfo'
--     or its @deviceRenderAreaCount@ member is equal to 0 and the
--     @imageView@ member of a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingFragmentDensityMapAttachmentInfoEXT'
--     structure included in the @pNext@ chain is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', @imageView@ /must/ have a
--     height greater than or equal to
--     \(\left\lceil{\frac{renderArea_{y}+renderArea_{height}}{maxFragmentDensityTexelSize_{height}}}\right\rceil\)
--
-- -   #VUID-VkRenderingInfo-pNext-06115# If the @pNext@ chain contains a
--     'Vulkan.Core11.Promoted_From_VK_KHR_device_group.DeviceGroupRenderPassBeginInfo'
--     structure, its @deviceRenderAreaCount@ member is not 0, and the
--     @imageView@ member of a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingFragmentDensityMapAttachmentInfoEXT'
--     structure included in the @pNext@ chain is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', @imageView@ /must/ have a
--     height greater than or equal to
--     \(\left\lceil{\frac{pDeviceRenderAreas_{y}+pDeviceRenderAreas_{height}}{maxFragmentDensityTexelSize_{height}}}\right\rceil\)
--     for each element of @pDeviceRenderAreas@
--
-- -   #VUID-VkRenderingInfo-imageView-06116# If the @imageView@ member of
--     a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingFragmentDensityMapAttachmentInfoEXT'
--     structure included in the @pNext@ chain is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', it /must/ not be equal to
--     the @imageView@ or @resolveImageView@ member of @pDepthAttachment@,
--     @pStencilAttachment@, or any element of @pColorAttachments@
--
-- -   #VUID-VkRenderingInfo-pNext-06119# If the @pNext@ chain does not
--     contain
--     'Vulkan.Core11.Promoted_From_VK_KHR_device_group.DeviceGroupRenderPassBeginInfo'
--     or its @deviceRenderAreaCount@ member is equal to 0 and the
--     @imageView@ member of a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingFragmentShadingRateAttachmentInfoKHR'
--     structure included in the @pNext@ chain is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', @imageView@ /must/ have a
--     width greater than or equal to
--     \(\left\lceil{\frac{renderArea_{x}+renderArea_{width}}{shadingRateAttachmentTexelSize_{width}}}\right\rceil\)
--
-- -   #VUID-VkRenderingInfo-pNext-06120# If the @pNext@ chain contains a
--     'Vulkan.Core11.Promoted_From_VK_KHR_device_group.DeviceGroupRenderPassBeginInfo'
--     structure, its @deviceRenderAreaCount@ member is not 0, and the
--     @imageView@ member of a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingFragmentShadingRateAttachmentInfoKHR'
--     structure included in the @pNext@ chain is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', @imageView@ /must/ have a
--     width greater than or equal to
--     \(\left\lceil{\frac{pDeviceRenderAreas_{x}+pDeviceRenderAreas_{width}}{shadingRateAttachmentTexelSize_{width}}}\right\rceil\)
--     for each element of @pDeviceRenderAreas@
--
-- -   #VUID-VkRenderingInfo-pNext-06121# If the @pNext@ chain does not
--     contain
--     'Vulkan.Core11.Promoted_From_VK_KHR_device_group.DeviceGroupRenderPassBeginInfo'
--     or its @deviceRenderAreaCount@ member is equal to 0 and the
--     @imageView@ member of a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingFragmentShadingRateAttachmentInfoKHR'
--     structure included in the @pNext@ chain is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', @imageView@ /must/ have a
--     height greater than or equal to
--     \(\left\lceil{\frac{renderArea_{y}+renderArea_{height}}{shadingRateAttachmentTexelSize_{height}}}\right\rceil\)
--
-- -   #VUID-VkRenderingInfo-pNext-06122# If the @pNext@ chain contains a
--     'Vulkan.Core11.Promoted_From_VK_KHR_device_group.DeviceGroupRenderPassBeginInfo'
--     structure, its @deviceRenderAreaCount@ member is not 0, and the
--     @imageView@ member of a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingFragmentShadingRateAttachmentInfoKHR'
--     structure included in the @pNext@ chain is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', @imageView@ /must/ have a
--     height greater than or equal to
--     \(\left\lceil{\frac{pDeviceRenderAreas_{y}+pDeviceRenderAreas_{height}}{shadingRateAttachmentTexelSize_{height}}}\right\rceil\)
--     for each element of @pDeviceRenderAreas@
--
-- -   #VUID-VkRenderingInfo-imageView-06123# If the @imageView@ member of
--     a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingFragmentShadingRateAttachmentInfoKHR'
--     structure included in the @pNext@ chain is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', and @viewMask@ is @0@,
--     @imageView@ /must/ have a @layerCount@ that is either equal to @1@
--     or greater than or equal to @layerCount@
--
-- -   #VUID-VkRenderingInfo-imageView-06124# If the @imageView@ member of
--     a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingFragmentShadingRateAttachmentInfoKHR'
--     structure included in the @pNext@ chain is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', and @viewMask@ is not @0@,
--     @imageView@ /must/ have a @layerCount@ that either equal to @1@ or
--     greater than or equal to the index of the most significant bit in
--     @viewMask@
--
-- -   #VUID-VkRenderingInfo-imageView-06125# If the @imageView@ member of
--     a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingFragmentShadingRateAttachmentInfoKHR'
--     structure included in the @pNext@ chain is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', it /must/ not be equal to
--     the @imageView@ or @resolveImageView@ member of @pDepthAttachment@,
--     @pStencilAttachment@, or any element of @pColorAttachments@
--
-- -   #VUID-VkRenderingInfo-imageView-06126# If the @imageView@ member of
--     a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingFragmentShadingRateAttachmentInfoKHR'
--     structure included in the @pNext@ chain is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', it /must/ not be equal to
--     the @imageView@ member of a
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingFragmentDensityMapAttachmentInfoEXT'
--     structure included in the @pNext@ chain
--
-- -   #VUID-VkRenderingInfo-multiview-06127# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#features-multiview multiview>
--     feature is not enabled, @viewMask@ /must/ be @0@
--
-- -   #VUID-VkRenderingInfo-viewMask-06128# The index of the most
--     significant bit in @viewMask@ /must/ be less than
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#limits-maxMultiviewViewCount maxMultiviewViewCount>
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkRenderingInfo-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_RENDERING_INFO'
--
-- -   #VUID-VkRenderingInfo-pNext-pNext# Each @pNext@ member of any
--     structure (including this one) in the @pNext@ chain /must/ be either
--     @NULL@ or a pointer to a valid instance of
--     'Vulkan.Core11.Promoted_From_VK_KHR_device_group.DeviceGroupRenderPassBeginInfo',
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.MultiviewPerViewAttributesInfoNVX',
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingFragmentDensityMapAttachmentInfoEXT',
--     or
--     'Vulkan.Extensions.VK_KHR_dynamic_rendering.RenderingFragmentShadingRateAttachmentInfoKHR'
--
-- -   #VUID-VkRenderingInfo-sType-unique# The @sType@ value of each struct
--     in the @pNext@ chain /must/ be unique
--
-- -   #VUID-VkRenderingInfo-flags-parameter# @flags@ /must/ be a valid
--     combination of
--     'Vulkan.Core13.Enums.RenderingFlagBits.RenderingFlagBits' values
--
-- -   #VUID-VkRenderingInfo-pColorAttachments-parameter# If
--     @colorAttachmentCount@ is not @0@, @pColorAttachments@ /must/ be a
--     valid pointer to an array of @colorAttachmentCount@ valid
--     'RenderingAttachmentInfo' structures
--
-- -   #VUID-VkRenderingInfo-pDepthAttachment-parameter# If
--     @pDepthAttachment@ is not @NULL@, @pDepthAttachment@ /must/ be a
--     valid pointer to a valid 'RenderingAttachmentInfo' structure
--
-- -   #VUID-VkRenderingInfo-pStencilAttachment-parameter# If
--     @pStencilAttachment@ is not @NULL@, @pStencilAttachment@ /must/ be a
--     valid pointer to a valid 'RenderingAttachmentInfo' structure
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_dynamic_rendering VK_KHR_dynamic_rendering>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.FundamentalTypes.Rect2D', 'RenderingAttachmentInfo',
-- 'Vulkan.Core13.Enums.RenderingFlagBits.RenderingFlags',
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'cmdBeginRendering',
-- 'Vulkan.Extensions.VK_KHR_dynamic_rendering.cmdBeginRenderingKHR'
data RenderingInfo (es :: [Type]) = RenderingInfo
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    RenderingInfo es -> Chain es
next :: Chain es
  , -- | @flags@ is a bitmask of
    -- 'Vulkan.Core13.Enums.RenderingFlagBits.RenderingFlagBits'.
    RenderingInfo es -> RenderingFlags
flags :: RenderingFlags
  , -- | @renderArea@ is the render area that is affected by the render pass
    -- instance.
    RenderingInfo es -> Rect2D
renderArea :: Rect2D
  , -- | @layerCount@ is the number of layers rendered to in each attachment when
    -- @viewMask@ is @0@.
    RenderingInfo es -> Word32
layerCount :: Word32
  , -- | @viewMask@ is the view mask indicating the indices of attachment layers
    -- that will be rendered when it is not @0@.
    RenderingInfo es -> Word32
viewMask :: Word32
  , -- | @pColorAttachments@ is a pointer to an array of @colorAttachmentCount@
    -- 'RenderingAttachmentInfo' structures describing any color attachments
    -- used.
    RenderingInfo es -> Vector RenderingAttachmentInfo
colorAttachments :: Vector RenderingAttachmentInfo
  , -- | @pDepthAttachment@ is a pointer to a 'RenderingAttachmentInfo' structure
    -- describing a depth attachment.
    RenderingInfo es -> Maybe RenderingAttachmentInfo
depthAttachment :: Maybe RenderingAttachmentInfo
  , -- | @pStencilAttachment@ is a pointer to a 'RenderingAttachmentInfo'
    -- structure describing a stencil attachment.
    RenderingInfo es -> Maybe RenderingAttachmentInfo
stencilAttachment :: Maybe RenderingAttachmentInfo
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (RenderingInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (RenderingInfo es)

instance Extensible RenderingInfo where
  extensibleTypeName :: String
extensibleTypeName = String
"RenderingInfo"
  setNext :: RenderingInfo ds -> Chain es -> RenderingInfo es
setNext RenderingInfo{Maybe RenderingAttachmentInfo
Word32
Vector RenderingAttachmentInfo
Chain ds
Rect2D
RenderingFlags
stencilAttachment :: Maybe RenderingAttachmentInfo
depthAttachment :: Maybe RenderingAttachmentInfo
colorAttachments :: Vector RenderingAttachmentInfo
viewMask :: Word32
layerCount :: Word32
renderArea :: Rect2D
flags :: RenderingFlags
next :: Chain ds
$sel:stencilAttachment:RenderingInfo :: forall (es :: [*]).
RenderingInfo es -> Maybe RenderingAttachmentInfo
$sel:depthAttachment:RenderingInfo :: forall (es :: [*]).
RenderingInfo es -> Maybe RenderingAttachmentInfo
$sel:colorAttachments:RenderingInfo :: forall (es :: [*]).
RenderingInfo es -> Vector RenderingAttachmentInfo
$sel:viewMask:RenderingInfo :: forall (es :: [*]). RenderingInfo es -> Word32
$sel:layerCount:RenderingInfo :: forall (es :: [*]). RenderingInfo es -> Word32
$sel:renderArea:RenderingInfo :: forall (es :: [*]). RenderingInfo es -> Rect2D
$sel:flags:RenderingInfo :: forall (es :: [*]). RenderingInfo es -> RenderingFlags
$sel:next:RenderingInfo :: forall (es :: [*]). RenderingInfo es -> Chain es
..} Chain es
next' = RenderingInfo :: forall (es :: [*]).
Chain es
-> RenderingFlags
-> Rect2D
-> Word32
-> Word32
-> Vector RenderingAttachmentInfo
-> Maybe RenderingAttachmentInfo
-> Maybe RenderingAttachmentInfo
-> RenderingInfo es
RenderingInfo{$sel:next:RenderingInfo :: Chain es
next = Chain es
next', Maybe RenderingAttachmentInfo
Word32
Vector RenderingAttachmentInfo
Rect2D
RenderingFlags
stencilAttachment :: Maybe RenderingAttachmentInfo
depthAttachment :: Maybe RenderingAttachmentInfo
colorAttachments :: Vector RenderingAttachmentInfo
viewMask :: Word32
layerCount :: Word32
renderArea :: Rect2D
flags :: RenderingFlags
$sel:stencilAttachment:RenderingInfo :: Maybe RenderingAttachmentInfo
$sel:depthAttachment:RenderingInfo :: Maybe RenderingAttachmentInfo
$sel:colorAttachments:RenderingInfo :: Vector RenderingAttachmentInfo
$sel:viewMask:RenderingInfo :: Word32
$sel:layerCount:RenderingInfo :: Word32
$sel:renderArea:RenderingInfo :: Rect2D
$sel:flags:RenderingInfo :: RenderingFlags
..}
  getNext :: RenderingInfo es -> Chain es
getNext RenderingInfo{Maybe RenderingAttachmentInfo
Word32
Vector RenderingAttachmentInfo
Chain es
Rect2D
RenderingFlags
stencilAttachment :: Maybe RenderingAttachmentInfo
depthAttachment :: Maybe RenderingAttachmentInfo
colorAttachments :: Vector RenderingAttachmentInfo
viewMask :: Word32
layerCount :: Word32
renderArea :: Rect2D
flags :: RenderingFlags
next :: Chain es
$sel:stencilAttachment:RenderingInfo :: forall (es :: [*]).
RenderingInfo es -> Maybe RenderingAttachmentInfo
$sel:depthAttachment:RenderingInfo :: forall (es :: [*]).
RenderingInfo es -> Maybe RenderingAttachmentInfo
$sel:colorAttachments:RenderingInfo :: forall (es :: [*]).
RenderingInfo es -> Vector RenderingAttachmentInfo
$sel:viewMask:RenderingInfo :: forall (es :: [*]). RenderingInfo es -> Word32
$sel:layerCount:RenderingInfo :: forall (es :: [*]). RenderingInfo es -> Word32
$sel:renderArea:RenderingInfo :: forall (es :: [*]). RenderingInfo es -> Rect2D
$sel:flags:RenderingInfo :: forall (es :: [*]). RenderingInfo es -> RenderingFlags
$sel:next:RenderingInfo :: forall (es :: [*]). RenderingInfo es -> Chain es
..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends RenderingInfo e => b) -> Maybe b
  extends :: proxy e -> (Extends RenderingInfo e => b) -> Maybe b
extends proxy e
_ Extends RenderingInfo e => b
f
    | Just e :~: MultiviewPerViewAttributesInfoNVX
Refl <- (Typeable e, Typeable MultiviewPerViewAttributesInfoNVX) =>
Maybe (e :~: MultiviewPerViewAttributesInfoNVX)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @MultiviewPerViewAttributesInfoNVX = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends RenderingInfo e => b
f
    | Just e :~: RenderingFragmentDensityMapAttachmentInfoEXT
Refl <- (Typeable e,
 Typeable RenderingFragmentDensityMapAttachmentInfoEXT) =>
Maybe (e :~: RenderingFragmentDensityMapAttachmentInfoEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @RenderingFragmentDensityMapAttachmentInfoEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends RenderingInfo e => b
f
    | Just e :~: RenderingFragmentShadingRateAttachmentInfoKHR
Refl <- (Typeable e,
 Typeable RenderingFragmentShadingRateAttachmentInfoKHR) =>
Maybe (e :~: RenderingFragmentShadingRateAttachmentInfoKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @RenderingFragmentShadingRateAttachmentInfoKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends RenderingInfo e => b
f
    | Just e :~: DeviceGroupRenderPassBeginInfo
Refl <- (Typeable e, Typeable DeviceGroupRenderPassBeginInfo) =>
Maybe (e :~: DeviceGroupRenderPassBeginInfo)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @DeviceGroupRenderPassBeginInfo = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends RenderingInfo e => b
f
    | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing

instance (Extendss RenderingInfo es, PokeChain es) => ToCStruct (RenderingInfo es) where
  withCStruct :: RenderingInfo es -> (Ptr (RenderingInfo es) -> IO b) -> IO b
withCStruct RenderingInfo es
x Ptr (RenderingInfo es) -> IO b
f = Int -> (Ptr (RenderingInfo es) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
72 ((Ptr (RenderingInfo es) -> IO b) -> IO b)
-> (Ptr (RenderingInfo es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr (RenderingInfo es)
p -> Ptr (RenderingInfo es) -> RenderingInfo es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (RenderingInfo es)
p RenderingInfo es
x (Ptr (RenderingInfo es) -> IO b
f Ptr (RenderingInfo es)
p)
  pokeCStruct :: Ptr (RenderingInfo es) -> RenderingInfo es -> IO b -> IO b
pokeCStruct Ptr (RenderingInfo es)
p RenderingInfo{Maybe RenderingAttachmentInfo
Word32
Vector RenderingAttachmentInfo
Chain es
Rect2D
RenderingFlags
stencilAttachment :: Maybe RenderingAttachmentInfo
depthAttachment :: Maybe RenderingAttachmentInfo
colorAttachments :: Vector RenderingAttachmentInfo
viewMask :: Word32
layerCount :: Word32
renderArea :: Rect2D
flags :: RenderingFlags
next :: Chain es
$sel:stencilAttachment:RenderingInfo :: forall (es :: [*]).
RenderingInfo es -> Maybe RenderingAttachmentInfo
$sel:depthAttachment:RenderingInfo :: forall (es :: [*]).
RenderingInfo es -> Maybe RenderingAttachmentInfo
$sel:colorAttachments:RenderingInfo :: forall (es :: [*]).
RenderingInfo es -> Vector RenderingAttachmentInfo
$sel:viewMask:RenderingInfo :: forall (es :: [*]). RenderingInfo es -> Word32
$sel:layerCount:RenderingInfo :: forall (es :: [*]). RenderingInfo es -> Word32
$sel:renderArea:RenderingInfo :: forall (es :: [*]). RenderingInfo es -> Rect2D
$sel:flags:RenderingInfo :: forall (es :: [*]). RenderingInfo es -> RenderingFlags
$sel:next:RenderingInfo :: forall (es :: [*]). RenderingInfo 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 (RenderingInfo es)
p Ptr (RenderingInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_RENDERING_INFO)
    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 (RenderingInfo es)
p Ptr (RenderingInfo 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 RenderingFlags -> RenderingFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (RenderingInfo es)
p Ptr (RenderingInfo es) -> Int -> Ptr RenderingFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr RenderingFlags)) (RenderingFlags
flags)
    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 Rect2D -> Rect2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (RenderingInfo es)
p Ptr (RenderingInfo es) -> Int -> Ptr Rect2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Rect2D)) (Rect2D
renderArea)
    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 (RenderingInfo es)
p Ptr (RenderingInfo es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32)) (Word32
layerCount)
    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 (RenderingInfo es)
p Ptr (RenderingInfo es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word32)) (Word32
viewMask)
    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 (RenderingInfo es)
p Ptr (RenderingInfo es) -> 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 RenderingAttachmentInfo -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector RenderingAttachmentInfo -> Int)
-> Vector RenderingAttachmentInfo -> Int
forall a b. (a -> b) -> a -> b
$ (Vector RenderingAttachmentInfo
colorAttachments)) :: Word32))
    Ptr RenderingAttachmentInfo
pPColorAttachments' <- ((Ptr RenderingAttachmentInfo -> IO b) -> IO b)
-> ContT b IO (Ptr RenderingAttachmentInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr RenderingAttachmentInfo -> IO b) -> IO b)
 -> ContT b IO (Ptr RenderingAttachmentInfo))
-> ((Ptr RenderingAttachmentInfo -> IO b) -> IO b)
-> ContT b IO (Ptr RenderingAttachmentInfo)
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr RenderingAttachmentInfo -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @RenderingAttachmentInfo ((Vector RenderingAttachmentInfo -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector RenderingAttachmentInfo
colorAttachments)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
72)
    (Int -> RenderingAttachmentInfo -> ContT b IO ())
-> Vector RenderingAttachmentInfo -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i RenderingAttachmentInfo
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 RenderingAttachmentInfo
-> RenderingAttachmentInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (Ptr RenderingAttachmentInfo
pPColorAttachments' Ptr RenderingAttachmentInfo -> Int -> Ptr RenderingAttachmentInfo
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
72 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr RenderingAttachmentInfo) (RenderingAttachmentInfo
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 RenderingAttachmentInfo
colorAttachments)
    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 RenderingAttachmentInfo)
-> Ptr RenderingAttachmentInfo -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (RenderingInfo es)
p Ptr (RenderingInfo es) -> Int -> Ptr (Ptr RenderingAttachmentInfo)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr (Ptr RenderingAttachmentInfo))) (Ptr RenderingAttachmentInfo
pPColorAttachments')
    Ptr RenderingAttachmentInfo
pDepthAttachment'' <- case (Maybe RenderingAttachmentInfo
depthAttachment) of
      Maybe RenderingAttachmentInfo
Nothing -> Ptr RenderingAttachmentInfo
-> ContT b IO (Ptr RenderingAttachmentInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr RenderingAttachmentInfo
forall a. Ptr a
nullPtr
      Just RenderingAttachmentInfo
j -> ((Ptr RenderingAttachmentInfo -> IO b) -> IO b)
-> ContT b IO (Ptr RenderingAttachmentInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr RenderingAttachmentInfo -> IO b) -> IO b)
 -> ContT b IO (Ptr RenderingAttachmentInfo))
-> ((Ptr RenderingAttachmentInfo -> IO b) -> IO b)
-> ContT b IO (Ptr RenderingAttachmentInfo)
forall a b. (a -> b) -> a -> b
$ RenderingAttachmentInfo
-> (Ptr RenderingAttachmentInfo -> IO b) -> IO b
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (RenderingAttachmentInfo
j)
    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 RenderingAttachmentInfo)
-> Ptr RenderingAttachmentInfo -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (RenderingInfo es)
p Ptr (RenderingInfo es) -> Int -> Ptr (Ptr RenderingAttachmentInfo)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr (Ptr RenderingAttachmentInfo))) Ptr RenderingAttachmentInfo
pDepthAttachment''
    Ptr RenderingAttachmentInfo
pStencilAttachment'' <- case (Maybe RenderingAttachmentInfo
stencilAttachment) of
      Maybe RenderingAttachmentInfo
Nothing -> Ptr RenderingAttachmentInfo
-> ContT b IO (Ptr RenderingAttachmentInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr RenderingAttachmentInfo
forall a. Ptr a
nullPtr
      Just RenderingAttachmentInfo
j -> ((Ptr RenderingAttachmentInfo -> IO b) -> IO b)
-> ContT b IO (Ptr RenderingAttachmentInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr RenderingAttachmentInfo -> IO b) -> IO b)
 -> ContT b IO (Ptr RenderingAttachmentInfo))
-> ((Ptr RenderingAttachmentInfo -> IO b) -> IO b)
-> ContT b IO (Ptr RenderingAttachmentInfo)
forall a b. (a -> b) -> a -> b
$ RenderingAttachmentInfo
-> (Ptr RenderingAttachmentInfo -> IO b) -> IO b
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (RenderingAttachmentInfo
j)
    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 RenderingAttachmentInfo)
-> Ptr RenderingAttachmentInfo -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (RenderingInfo es)
p Ptr (RenderingInfo es) -> Int -> Ptr (Ptr RenderingAttachmentInfo)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr (Ptr RenderingAttachmentInfo))) Ptr RenderingAttachmentInfo
pStencilAttachment''
    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 :: Ptr (RenderingInfo es) -> IO b -> IO b
pokeZeroCStruct Ptr (RenderingInfo 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 (RenderingInfo es)
p Ptr (RenderingInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_RENDERING_INFO)
    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 a. PokeChain es => (Ptr (Chain es) -> IO a) -> IO a
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 (RenderingInfo es)
p Ptr (RenderingInfo 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 Rect2D -> Rect2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (RenderingInfo es)
p Ptr (RenderingInfo es) -> Int -> Ptr Rect2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Rect2D)) (Rect2D
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 (RenderingInfo es)
p Ptr (RenderingInfo es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: 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 (RenderingInfo es)
p Ptr (RenderingInfo es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word32)) (Word32
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 es ~ '[] => Zero (RenderingInfo es) where
  zero :: RenderingInfo es
zero = Chain es
-> RenderingFlags
-> Rect2D
-> Word32
-> Word32
-> Vector RenderingAttachmentInfo
-> Maybe RenderingAttachmentInfo
-> Maybe RenderingAttachmentInfo
-> RenderingInfo es
forall (es :: [*]).
Chain es
-> RenderingFlags
-> Rect2D
-> Word32
-> Word32
-> Vector RenderingAttachmentInfo
-> Maybe RenderingAttachmentInfo
-> Maybe RenderingAttachmentInfo
-> RenderingInfo es
RenderingInfo
           ()
           RenderingFlags
forall a. Zero a => a
zero
           Rect2D
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Vector RenderingAttachmentInfo
forall a. Monoid a => a
mempty
           Maybe RenderingAttachmentInfo
forall a. Maybe a
Nothing
           Maybe RenderingAttachmentInfo
forall a. Maybe a
Nothing


-- | VkRenderingAttachmentInfo - Structure specifying attachment information
--
-- = Description
--
-- Values in @imageView@ are loaded and stored according to the values of
-- @loadOp@ and @storeOp@, within the render area for each device specified
-- in 'RenderingInfo'. If @imageView@ is
-- 'Vulkan.Core10.APIConstants.NULL_HANDLE', other members of this
-- structure are ignored; writes to this attachment will be discarded, and
-- no load, store, or resolve operations will be performed.
--
-- If @resolveMode@ is
-- 'Vulkan.Core12.Enums.ResolveModeFlagBits.RESOLVE_MODE_NONE', then
-- @resolveImageView@ is ignored. If @resolveMode@ is not
-- 'Vulkan.Core12.Enums.ResolveModeFlagBits.RESOLVE_MODE_NONE', values in
-- @resolveImageView@ within the render area become undefined once
-- rendering begins. At the end of rendering, the color values written to
-- each pixel location in @imageView@ will be resolved according to
-- @resolveMode@ and stored into the the same location in
-- @resolveImageView@.
--
-- Note
--
-- The resolve mode and store operation are independent; it is valid to
-- write both resolved and unresolved values, and equally valid to discard
-- the unresolved values while writing the resolved ones.
--
-- Store and resolve operations are only performed at the end of a render
-- pass instance that does not specify the
-- 'Vulkan.Core13.Enums.RenderingFlagBits.RENDERING_SUSPENDING_BIT_KHR'
-- flag.
--
-- Load operations are only performed at the beginning of a render pass
-- instance that does not specify the
-- 'Vulkan.Core13.Enums.RenderingFlagBits.RENDERING_RESUMING_BIT_KHR' flag.
--
-- Image contents at the end of a suspended render pass instance remain
-- defined for access by a resuming render pass instance.
--
-- == Valid Usage
--
-- -   #VUID-VkRenderingAttachmentInfo-imageView-06129# If @imageView@ is
--     not 'Vulkan.Core10.APIConstants.NULL_HANDLE' and has a non-integer
--     color format, @resolveMode@ /must/ be
--     'Vulkan.Core12.Enums.ResolveModeFlagBits.RESOLVE_MODE_NONE' or
--     'Vulkan.Core12.Enums.ResolveModeFlagBits.RESOLVE_MODE_AVERAGE_BIT'
--
-- -   #VUID-VkRenderingAttachmentInfo-imageView-06130# If @imageView@ is
--     not 'Vulkan.Core10.APIConstants.NULL_HANDLE' and has an integer
--     color format, @resolveMode@ /must/ be
--     'Vulkan.Core12.Enums.ResolveModeFlagBits.RESOLVE_MODE_NONE' or
--     'Vulkan.Core12.Enums.ResolveModeFlagBits.RESOLVE_MODE_SAMPLE_ZERO_BIT'
--
-- -   #VUID-VkRenderingAttachmentInfo-imageView-06132# If @imageView@ is
--     not 'Vulkan.Core10.APIConstants.NULL_HANDLE' and @resolveMode@ is
--     not 'Vulkan.Core12.Enums.ResolveModeFlagBits.RESOLVE_MODE_NONE',
--     @imageView@ /must/ not have a sample count of
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SAMPLE_COUNT_1_BIT'
--
-- -   #VUID-VkRenderingAttachmentInfo-imageView-06133# If @imageView@ is
--     not 'Vulkan.Core10.APIConstants.NULL_HANDLE' and @resolveMode@ is
--     not 'Vulkan.Core12.Enums.ResolveModeFlagBits.RESOLVE_MODE_NONE',
--     @resolveImageView@ /must/ have a sample count of
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SAMPLE_COUNT_1_BIT'
--
-- -   #VUID-VkRenderingAttachmentInfo-imageView-06134# If @imageView@ is
--     not 'Vulkan.Core10.APIConstants.NULL_HANDLE' and @resolveMode@ is
--     not 'Vulkan.Core12.Enums.ResolveModeFlagBits.RESOLVE_MODE_NONE',
--     @imageView@ and @resolveImageView@ /must/ have the same
--     'Vulkan.Core10.Enums.Format.Format'
--
-- -   #VUID-VkRenderingAttachmentInfo-imageView-06135# If @imageView@ is
--     not 'Vulkan.Core10.APIConstants.NULL_HANDLE', @layout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_UNDEFINED',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_TRANSFER_SRC_OPTIMAL',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL',
--     or 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_PREINITIALIZED'
--
-- -   #VUID-VkRenderingAttachmentInfo-imageView-06136# If @imageView@ is
--     not 'Vulkan.Core10.APIConstants.NULL_HANDLE' and @resolveMode@ is
--     not 'Vulkan.Core12.Enums.ResolveModeFlagBits.RESOLVE_MODE_NONE',
--     @resolveImageLayout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_UNDEFINED',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_STENCIL_READ_ONLY_OPTIMAL',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_TRANSFER_SRC_OPTIMAL',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL',
--     or 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_PREINITIALIZED'
--
-- -   #VUID-VkRenderingAttachmentInfo-imageView-06137# If @imageView@ is
--     not 'Vulkan.Core10.APIConstants.NULL_HANDLE' and @resolveMode@ is
--     not 'Vulkan.Core12.Enums.ResolveModeFlagBits.RESOLVE_MODE_NONE',
--     @resolveImageLayout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_OPTIMAL'
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_STENCIL_READ_ONLY_OPTIMAL'
--
-- -   #VUID-VkRenderingAttachmentInfo-imageView-06138# If @imageView@ is
--     not 'Vulkan.Core10.APIConstants.NULL_HANDLE', @layout@ /must/ not be
--     'Vulkan.Extensions.VK_NV_shading_rate_image.IMAGE_LAYOUT_SHADING_RATE_OPTIMAL_NV'
--
-- -   #VUID-VkRenderingAttachmentInfo-imageView-06139# If @imageView@ is
--     not 'Vulkan.Core10.APIConstants.NULL_HANDLE' and @resolveMode@ is
--     not 'Vulkan.Core12.Enums.ResolveModeFlagBits.RESOLVE_MODE_NONE',
--     @resolveImageLayout@ /must/ not be
--     'Vulkan.Extensions.VK_NV_shading_rate_image.IMAGE_LAYOUT_SHADING_RATE_OPTIMAL_NV'
--
-- -   #VUID-VkRenderingAttachmentInfo-imageView-06140# If @imageView@ is
--     not 'Vulkan.Core10.APIConstants.NULL_HANDLE', @layout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_FRAGMENT_DENSITY_MAP_OPTIMAL_EXT'
--
-- -   #VUID-VkRenderingAttachmentInfo-imageView-06141# If @imageView@ is
--     not 'Vulkan.Core10.APIConstants.NULL_HANDLE' and @resolveMode@ is
--     not 'Vulkan.Core12.Enums.ResolveModeFlagBits.RESOLVE_MODE_NONE',
--     @resolveImageLayout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_FRAGMENT_DENSITY_MAP_OPTIMAL_EXT'
--
-- -   #VUID-VkRenderingAttachmentInfo-imageView-06142# If @imageView@ is
--     not 'Vulkan.Core10.APIConstants.NULL_HANDLE' and @resolveMode@ is
--     not 'Vulkan.Core12.Enums.ResolveModeFlagBits.RESOLVE_MODE_NONE',
--     @resolveImageLayout@ /must/ not be
--     'Vulkan.Extensions.VK_KHR_synchronization2.IMAGE_LAYOUT_READ_ONLY_OPTIMAL_KHR'
--
-- -   #VUID-VkRenderingAttachmentInfo-imageView-06143# If @imageView@ is
--     not 'Vulkan.Core10.APIConstants.NULL_HANDLE', @layout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_FRAGMENT_SHADING_RATE_ATTACHMENT_OPTIMAL_KHR'
--
-- -   #VUID-VkRenderingAttachmentInfo-imageView-06144# If @imageView@ is
--     not 'Vulkan.Core10.APIConstants.NULL_HANDLE' and @resolveMode@ is
--     not 'Vulkan.Core12.Enums.ResolveModeFlagBits.RESOLVE_MODE_NONE',
--     @resolveImageLayout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_FRAGMENT_SHADING_RATE_ATTACHMENT_OPTIMAL_KHR'
--
-- -   #VUID-VkRenderingAttachmentInfo-imageView-06145# If @imageView@ is
--     not 'Vulkan.Core10.APIConstants.NULL_HANDLE', @layout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_PRESENT_SRC_KHR'
--
-- -   #VUID-VkRenderingAttachmentInfo-imageView-06146# If @imageView@ is
--     not 'Vulkan.Core10.APIConstants.NULL_HANDLE' and @resolveMode@ is
--     not 'Vulkan.Core12.Enums.ResolveModeFlagBits.RESOLVE_MODE_NONE',
--     @resolveImageLayout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_PRESENT_SRC_KHR'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkRenderingAttachmentInfo-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_RENDERING_ATTACHMENT_INFO'
--
-- -   #VUID-VkRenderingAttachmentInfo-pNext-pNext# @pNext@ /must/ be
--     @NULL@
--
-- -   #VUID-VkRenderingAttachmentInfo-imageView-parameter# If @imageView@
--     is not 'Vulkan.Core10.APIConstants.NULL_HANDLE', @imageView@ /must/
--     be a valid 'Vulkan.Core10.Handles.ImageView' handle
--
-- -   #VUID-VkRenderingAttachmentInfo-imageLayout-parameter# @imageLayout@
--     /must/ be a valid 'Vulkan.Core10.Enums.ImageLayout.ImageLayout'
--     value
--
-- -   #VUID-VkRenderingAttachmentInfo-resolveMode-parameter# If
--     @resolveMode@ is not @0@, @resolveMode@ /must/ be a valid
--     'Vulkan.Core12.Enums.ResolveModeFlagBits.ResolveModeFlagBits' value
--
-- -   #VUID-VkRenderingAttachmentInfo-resolveImageView-parameter# If
--     @resolveImageView@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @resolveImageView@ /must/ be a valid
--     'Vulkan.Core10.Handles.ImageView' handle
--
-- -   #VUID-VkRenderingAttachmentInfo-resolveImageLayout-parameter#
--     @resolveImageLayout@ /must/ be a valid
--     'Vulkan.Core10.Enums.ImageLayout.ImageLayout' value
--
-- -   #VUID-VkRenderingAttachmentInfo-loadOp-parameter# @loadOp@ /must/ be
--     a valid 'Vulkan.Core10.Enums.AttachmentLoadOp.AttachmentLoadOp'
--     value
--
-- -   #VUID-VkRenderingAttachmentInfo-storeOp-parameter# @storeOp@ /must/
--     be a valid 'Vulkan.Core10.Enums.AttachmentStoreOp.AttachmentStoreOp'
--     value
--
-- -   #VUID-VkRenderingAttachmentInfo-clearValue-parameter# @clearValue@
--     /must/ be a valid 'Vulkan.Core10.CommandBufferBuilding.ClearValue'
--     union
--
-- -   #VUID-VkRenderingAttachmentInfo-commonparent# Both of @imageView@,
--     and @resolveImageView@ that are valid handles of non-ignored
--     parameters /must/ have been created, allocated, or retrieved from
--     the same 'Vulkan.Core10.Handles.Device'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_dynamic_rendering VK_KHR_dynamic_rendering>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.Enums.AttachmentLoadOp.AttachmentLoadOp',
-- 'Vulkan.Core10.Enums.AttachmentStoreOp.AttachmentStoreOp',
-- 'Vulkan.Core10.CommandBufferBuilding.ClearValue',
-- 'Vulkan.Core10.Enums.ImageLayout.ImageLayout',
-- 'Vulkan.Core10.Handles.ImageView', 'RenderingInfo',
-- 'Vulkan.Core12.Enums.ResolveModeFlagBits.ResolveModeFlagBits',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data RenderingAttachmentInfo = RenderingAttachmentInfo
  { -- | @imageView@ is the image view that will be used for rendering.
    RenderingAttachmentInfo -> ImageView
imageView :: ImageView
  , -- | @imageLayout@ is the layout that @imageView@ will be in during
    -- rendering.
    RenderingAttachmentInfo -> ImageLayout
imageLayout :: ImageLayout
  , -- | @resolveMode@ is a
    -- 'Vulkan.Core12.Enums.ResolveModeFlagBits.ResolveModeFlagBits' value
    -- defining how multisampled data written to @imageView@ will be resolved.
    RenderingAttachmentInfo -> ResolveModeFlagBits
resolveMode :: ResolveModeFlagBits
  , -- | @resolveImageView@ is an image view used to write resolved multisample
    -- data at the end of rendering.
    RenderingAttachmentInfo -> ImageView
resolveImageView :: ImageView
  , -- | @resolveImageLayout@ is the layout that @resolveImageView@ will be in
    -- during rendering.
    RenderingAttachmentInfo -> ImageLayout
resolveImageLayout :: ImageLayout
  , -- | @loadOp@ is a 'Vulkan.Core10.Enums.AttachmentLoadOp.AttachmentLoadOp'
    -- value specifying how the contents of @imageView@ are treated at the
    -- start of the render pass instance.
    RenderingAttachmentInfo -> AttachmentLoadOp
loadOp :: AttachmentLoadOp
  , -- | @storeOp@ is a 'Vulkan.Core10.Enums.AttachmentStoreOp.AttachmentStoreOp'
    -- value specifying how the contents of @imageView@ are treated at the end
    -- of the render pass instance.
    RenderingAttachmentInfo -> AttachmentStoreOp
storeOp :: AttachmentStoreOp
  , -- | @clearValue@ is a 'Vulkan.Core10.CommandBufferBuilding.ClearValue'
    -- structure defining values used to clear @imageView@ when @loadOp@ is
    -- 'Vulkan.Core10.Enums.AttachmentLoadOp.ATTACHMENT_LOAD_OP_CLEAR'.
    RenderingAttachmentInfo -> ClearValue
clearValue :: ClearValue
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (RenderingAttachmentInfo)
#endif
deriving instance Show RenderingAttachmentInfo

instance ToCStruct RenderingAttachmentInfo where
  withCStruct :: RenderingAttachmentInfo
-> (Ptr RenderingAttachmentInfo -> IO b) -> IO b
withCStruct RenderingAttachmentInfo
x Ptr RenderingAttachmentInfo -> IO b
f = Int -> (Ptr RenderingAttachmentInfo -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
72 ((Ptr RenderingAttachmentInfo -> IO b) -> IO b)
-> (Ptr RenderingAttachmentInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr RenderingAttachmentInfo
p -> Ptr RenderingAttachmentInfo
-> RenderingAttachmentInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr RenderingAttachmentInfo
p RenderingAttachmentInfo
x (Ptr RenderingAttachmentInfo -> IO b
f Ptr RenderingAttachmentInfo
p)
  pokeCStruct :: Ptr RenderingAttachmentInfo
-> RenderingAttachmentInfo -> IO b -> IO b
pokeCStruct Ptr RenderingAttachmentInfo
p RenderingAttachmentInfo{ImageLayout
ImageView
ResolveModeFlagBits
AttachmentStoreOp
AttachmentLoadOp
ClearValue
clearValue :: ClearValue
storeOp :: AttachmentStoreOp
loadOp :: AttachmentLoadOp
resolveImageLayout :: ImageLayout
resolveImageView :: ImageView
resolveMode :: ResolveModeFlagBits
imageLayout :: ImageLayout
imageView :: ImageView
$sel:clearValue:RenderingAttachmentInfo :: RenderingAttachmentInfo -> ClearValue
$sel:storeOp:RenderingAttachmentInfo :: RenderingAttachmentInfo -> AttachmentStoreOp
$sel:loadOp:RenderingAttachmentInfo :: RenderingAttachmentInfo -> AttachmentLoadOp
$sel:resolveImageLayout:RenderingAttachmentInfo :: RenderingAttachmentInfo -> ImageLayout
$sel:resolveImageView:RenderingAttachmentInfo :: RenderingAttachmentInfo -> ImageView
$sel:resolveMode:RenderingAttachmentInfo :: RenderingAttachmentInfo -> ResolveModeFlagBits
$sel:imageLayout:RenderingAttachmentInfo :: RenderingAttachmentInfo -> ImageLayout
$sel:imageView:RenderingAttachmentInfo :: RenderingAttachmentInfo -> ImageView
..} 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 RenderingAttachmentInfo
p Ptr RenderingAttachmentInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_RENDERING_ATTACHMENT_INFO)
    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 RenderingAttachmentInfo
p Ptr RenderingAttachmentInfo -> 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 ImageView -> ImageView -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingAttachmentInfo
p Ptr RenderingAttachmentInfo -> Int -> Ptr ImageView
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageView)) (ImageView
imageView)
    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 ((Ptr RenderingAttachmentInfo
p Ptr RenderingAttachmentInfo -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout)) (ImageLayout
imageLayout)
    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 ResolveModeFlagBits -> ResolveModeFlagBits -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingAttachmentInfo
p Ptr RenderingAttachmentInfo -> Int -> Ptr ResolveModeFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr ResolveModeFlagBits)) (ResolveModeFlagBits
resolveMode)
    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 ImageView -> ImageView -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingAttachmentInfo
p Ptr RenderingAttachmentInfo -> Int -> Ptr ImageView
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr ImageView)) (ImageView
resolveImageView)
    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 ((Ptr RenderingAttachmentInfo
p Ptr RenderingAttachmentInfo -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr ImageLayout)) (ImageLayout
resolveImageLayout)
    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 AttachmentLoadOp -> AttachmentLoadOp -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingAttachmentInfo
p Ptr RenderingAttachmentInfo -> Int -> Ptr AttachmentLoadOp
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr AttachmentLoadOp)) (AttachmentLoadOp
loadOp)
    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 AttachmentStoreOp -> AttachmentStoreOp -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingAttachmentInfo
p Ptr RenderingAttachmentInfo -> Int -> Ptr AttachmentStoreOp
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr AttachmentStoreOp)) (AttachmentStoreOp
storeOp)
    ((() -> 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 ClearValue -> ClearValue -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr RenderingAttachmentInfo
p Ptr RenderingAttachmentInfo -> Int -> Ptr ClearValue
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
52 :: Ptr ClearValue)) (ClearValue
clearValue) (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
$ ())
    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 :: Ptr RenderingAttachmentInfo -> IO b -> IO b
pokeZeroCStruct Ptr RenderingAttachmentInfo
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 RenderingAttachmentInfo
p Ptr RenderingAttachmentInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_RENDERING_ATTACHMENT_INFO)
    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 RenderingAttachmentInfo
p Ptr RenderingAttachmentInfo -> 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 ImageLayout -> ImageLayout -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingAttachmentInfo
p Ptr RenderingAttachmentInfo -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout)) (ImageLayout
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 ImageLayout -> ImageLayout -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingAttachmentInfo
p Ptr RenderingAttachmentInfo -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr ImageLayout)) (ImageLayout
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 AttachmentLoadOp -> AttachmentLoadOp -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingAttachmentInfo
p Ptr RenderingAttachmentInfo -> Int -> Ptr AttachmentLoadOp
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr AttachmentLoadOp)) (AttachmentLoadOp
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 AttachmentStoreOp -> AttachmentStoreOp -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingAttachmentInfo
p Ptr RenderingAttachmentInfo -> Int -> Ptr AttachmentStoreOp
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr AttachmentStoreOp)) (AttachmentStoreOp
forall a. Zero a => a
zero)
    ((() -> 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 ClearValue -> ClearValue -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr RenderingAttachmentInfo
p Ptr RenderingAttachmentInfo -> Int -> Ptr ClearValue
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
52 :: Ptr ClearValue)) (ClearValue
forall a. Zero a => a
zero) (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
$ ())
    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 Zero RenderingAttachmentInfo where
  zero :: RenderingAttachmentInfo
zero = ImageView
-> ImageLayout
-> ResolveModeFlagBits
-> ImageView
-> ImageLayout
-> AttachmentLoadOp
-> AttachmentStoreOp
-> ClearValue
-> RenderingAttachmentInfo
RenderingAttachmentInfo
           ImageView
forall a. Zero a => a
zero
           ImageLayout
forall a. Zero a => a
zero
           ResolveModeFlagBits
forall a. Zero a => a
zero
           ImageView
forall a. Zero a => a
zero
           ImageLayout
forall a. Zero a => a
zero
           AttachmentLoadOp
forall a. Zero a => a
zero
           AttachmentStoreOp
forall a. Zero a => a
zero
           ClearValue
forall a. Zero a => a
zero


-- | VkPhysicalDeviceDynamicRenderingFeatures - Structure indicating support
-- for dynamic render pass instances
--
-- = Members
--
-- The members of the 'PhysicalDeviceDynamicRenderingFeatures' structure
-- describe the following features:
--
-- = Description
--
-- If the 'PhysicalDeviceDynamicRenderingFeatures' structure is included in
-- the @pNext@ chain of the
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2'
-- structure passed to
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceFeatures2',
-- it is filled in to indicate whether each corresponding feature is
-- supported. 'PhysicalDeviceDynamicRenderingFeatures' /can/ also be used
-- in the @pNext@ chain of 'Vulkan.Core10.Device.DeviceCreateInfo' to
-- selectively enable these features.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_dynamic_rendering VK_KHR_dynamic_rendering>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceDynamicRenderingFeatures = PhysicalDeviceDynamicRenderingFeatures
  { -- | #extension-features-dynamicRendering# @dynamicRendering@ specifies that
    -- the implementation supports dynamic render pass instances using the
    -- 'cmdBeginRendering' command.
    PhysicalDeviceDynamicRenderingFeatures -> Bool
dynamicRendering :: Bool }
  deriving (Typeable, PhysicalDeviceDynamicRenderingFeatures
-> PhysicalDeviceDynamicRenderingFeatures -> Bool
(PhysicalDeviceDynamicRenderingFeatures
 -> PhysicalDeviceDynamicRenderingFeatures -> Bool)
-> (PhysicalDeviceDynamicRenderingFeatures
    -> PhysicalDeviceDynamicRenderingFeatures -> Bool)
-> Eq PhysicalDeviceDynamicRenderingFeatures
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceDynamicRenderingFeatures
-> PhysicalDeviceDynamicRenderingFeatures -> Bool
$c/= :: PhysicalDeviceDynamicRenderingFeatures
-> PhysicalDeviceDynamicRenderingFeatures -> Bool
== :: PhysicalDeviceDynamicRenderingFeatures
-> PhysicalDeviceDynamicRenderingFeatures -> Bool
$c== :: PhysicalDeviceDynamicRenderingFeatures
-> PhysicalDeviceDynamicRenderingFeatures -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceDynamicRenderingFeatures)
#endif
deriving instance Show PhysicalDeviceDynamicRenderingFeatures

instance ToCStruct PhysicalDeviceDynamicRenderingFeatures where
  withCStruct :: PhysicalDeviceDynamicRenderingFeatures
-> (Ptr PhysicalDeviceDynamicRenderingFeatures -> IO b) -> IO b
withCStruct PhysicalDeviceDynamicRenderingFeatures
x Ptr PhysicalDeviceDynamicRenderingFeatures -> IO b
f = Int -> (Ptr PhysicalDeviceDynamicRenderingFeatures -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr PhysicalDeviceDynamicRenderingFeatures -> IO b) -> IO b)
-> (Ptr PhysicalDeviceDynamicRenderingFeatures -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceDynamicRenderingFeatures
p -> Ptr PhysicalDeviceDynamicRenderingFeatures
-> PhysicalDeviceDynamicRenderingFeatures -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceDynamicRenderingFeatures
p PhysicalDeviceDynamicRenderingFeatures
x (Ptr PhysicalDeviceDynamicRenderingFeatures -> IO b
f Ptr PhysicalDeviceDynamicRenderingFeatures
p)
  pokeCStruct :: Ptr PhysicalDeviceDynamicRenderingFeatures
-> PhysicalDeviceDynamicRenderingFeatures -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceDynamicRenderingFeatures
p PhysicalDeviceDynamicRenderingFeatures{Bool
dynamicRendering :: Bool
$sel:dynamicRendering:PhysicalDeviceDynamicRenderingFeatures :: PhysicalDeviceDynamicRenderingFeatures -> Bool
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDynamicRenderingFeatures
p Ptr PhysicalDeviceDynamicRenderingFeatures
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_DYNAMIC_RENDERING_FEATURES)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDynamicRenderingFeatures
p Ptr PhysicalDeviceDynamicRenderingFeatures -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDynamicRenderingFeatures
p Ptr PhysicalDeviceDynamicRenderingFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
dynamicRendering))
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr PhysicalDeviceDynamicRenderingFeatures -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceDynamicRenderingFeatures
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDynamicRenderingFeatures
p Ptr PhysicalDeviceDynamicRenderingFeatures
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_DYNAMIC_RENDERING_FEATURES)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDynamicRenderingFeatures
p Ptr PhysicalDeviceDynamicRenderingFeatures -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDynamicRenderingFeatures
p Ptr PhysicalDeviceDynamicRenderingFeatures -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO b
f

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

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

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


-- | VkCommandBufferInheritanceRenderingInfo - Structure specifying command
-- buffer inheritance info for dynamic render pass instances
--
-- = Description
--
-- If the @pNext@ chain of
-- 'Vulkan.Core10.CommandBuffer.CommandBufferInheritanceInfo' includes a
-- 'CommandBufferInheritanceRenderingInfo' structure, then that structure
-- controls parameters of dynamic render pass instances that the
-- 'Vulkan.Core10.Handles.CommandBuffer' /can/ be executed within. If
-- 'Vulkan.Core10.CommandBuffer.CommandBufferInheritanceInfo'::@renderPass@
-- is not 'Vulkan.Core10.APIConstants.NULL_HANDLE', or
-- 'Vulkan.Core10.Enums.CommandBufferUsageFlagBits.COMMAND_BUFFER_USAGE_RENDER_PASS_CONTINUE_BIT'
-- is not specified in
-- 'Vulkan.Core10.CommandBuffer.CommandBufferBeginInfo'::@flags@,
-- parameters of this structure are ignored.
--
-- If @colorAttachmentCount@ is @0@ and the
-- <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#features-variableMultisampleRate variableMultisampleRate>
-- feature is enabled, @rasterizationSamples@ is ignored.
--
-- If @depthAttachmentFormat@, @stencilAttachmentFormat@, or any element of
-- @pColorAttachmentFormats@ is
-- 'Vulkan.Core10.Enums.Format.FORMAT_UNDEFINED', it indicates that the
-- corresponding attachment is unused within the render pass.
--
-- == Valid Usage
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfo-colorAttachmentCount-06004#
--     If @colorAttachmentCount@ is not @0@, @rasterizationSamples@ /must/
--     be a valid
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits' value
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfo-variableMultisampleRate-06005#
--     If the
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#features-variableMultisampleRate variableMultisampleRate>
--     feature is not enabled, @rasterizationSamples@ /must/ be a valid
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits' value
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfo-pColorAttachmentFormats-06006#
--     If any element of @pColorAttachmentFormats@ is not
--     'Vulkan.Core10.Enums.Format.FORMAT_UNDEFINED', it /must/ be a format
--     with
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#potential-format-features potential format features>
--     that include
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_COLOR_ATTACHMENT_BIT'
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfo-depthAttachmentFormat-06540#
--     If @depthAttachmentFormat@ is not
--     'Vulkan.Core10.Enums.Format.FORMAT_UNDEFINED', it /must/ be a format
--     that includes a depth aspect
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfo-depthAttachmentFormat-06007#
--     If @depthAttachmentFormat@ is not
--     'Vulkan.Core10.Enums.Format.FORMAT_UNDEFINED', it /must/ be a format
--     with
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#potential-format-features potential format features>
--     that include
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_DEPTH_STENCIL_ATTACHMENT_BIT'
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfoKHR-pColorAttachmentFormats-06492#
--     When rendering to a
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#glossary Linear Color attachment>,
--     if any element of @pColorAttachmentFormats@ is not
--     'Vulkan.Core10.Enums.Format.FORMAT_UNDEFINED', it /must/ be a format
--     with
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#potential-format-features potential format features>
--     that include
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_LINEAR_COLOR_ATTACHMENT_BIT_NV'
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfo-stencilAttachmentFormat-06541#
--     If @stencilAttachmentFormat@ is not
--     'Vulkan.Core10.Enums.Format.FORMAT_UNDEFINED', it /must/ be a format
--     that includes a stencil aspect
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfo-stencilAttachmentFormat-06199#
--     If @stencilAttachmentFormat@ is not
--     'Vulkan.Core10.Enums.Format.FORMAT_UNDEFINED', it /must/ be a format
--     with
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#potential-format-features potential format features>
--     that include
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_DEPTH_STENCIL_ATTACHMENT_BIT'
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfo-depthAttachmentFormat-06200#
--     If @depthAttachmentFormat@ is not
--     'Vulkan.Core10.Enums.Format.FORMAT_UNDEFINED' and
--     @stencilAttachmentFormat@ is not
--     'Vulkan.Core10.Enums.Format.FORMAT_UNDEFINED',
--     @depthAttachmentFormat@ /must/ equal @stencilAttachmentFormat@
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfo-multiview-06008# If
--     the
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#features-multiview multiview>
--     feature is not enabled, @viewMask@ /must/ be @0@
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfo-viewMask-06009# The
--     index of the most significant bit in @viewMask@ /must/ be less than
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#limits-maxMultiviewViewCount maxMultiviewViewCount>
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfo-sType-sType# @sType@
--     /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_COMMAND_BUFFER_INHERITANCE_RENDERING_INFO'
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfo-flags-parameter#
--     @flags@ /must/ be a valid combination of
--     'Vulkan.Core13.Enums.RenderingFlagBits.RenderingFlagBits' values
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfo-pColorAttachmentFormats-parameter#
--     If @colorAttachmentCount@ is not @0@, @pColorAttachmentFormats@
--     /must/ be a valid pointer to an array of @colorAttachmentCount@
--     valid 'Vulkan.Core10.Enums.Format.Format' values
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfo-depthAttachmentFormat-parameter#
--     @depthAttachmentFormat@ /must/ be a valid
--     'Vulkan.Core10.Enums.Format.Format' value
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfo-stencilAttachmentFormat-parameter#
--     @stencilAttachmentFormat@ /must/ be a valid
--     'Vulkan.Core10.Enums.Format.Format' value
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfo-rasterizationSamples-parameter#
--     If @rasterizationSamples@ is not @0@, @rasterizationSamples@ /must/
--     be a valid
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits' value
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_dynamic_rendering VK_KHR_dynamic_rendering>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core10.Enums.Format.Format',
-- 'Vulkan.Core13.Enums.RenderingFlagBits.RenderingFlags',
-- 'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data CommandBufferInheritanceRenderingInfo = CommandBufferInheritanceRenderingInfo
  { -- | @flags@ is a bitmask of
    -- 'Vulkan.Core13.Enums.RenderingFlagBits.RenderingFlagBits' used by the
    -- render pass instance.
    CommandBufferInheritanceRenderingInfo -> RenderingFlags
flags :: RenderingFlags
  , -- | @viewMask@ is the view mask used for rendering.
    CommandBufferInheritanceRenderingInfo -> Word32
viewMask :: Word32
  , -- | @pColorAttachmentFormats@ is a pointer to an array of
    -- 'Vulkan.Core10.Enums.Format.Format' values defining the format of color
    -- attachments.
    CommandBufferInheritanceRenderingInfo -> Vector Format
colorAttachmentFormats :: Vector Format
  , -- | @depthAttachmentFormat@ is a 'Vulkan.Core10.Enums.Format.Format' value
    -- defining the format of the depth attachment.
    CommandBufferInheritanceRenderingInfo -> Format
depthAttachmentFormat :: Format
  , -- | @stencilAttachmentFormat@ is a 'Vulkan.Core10.Enums.Format.Format' value
    -- defining the format of the stencil attachment.
    CommandBufferInheritanceRenderingInfo -> Format
stencilAttachmentFormat :: Format
  , -- | @rasterizationSamples@ is a
    -- 'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits' specifying
    -- the number of samples used in rasterization.
    CommandBufferInheritanceRenderingInfo -> SampleCountFlagBits
rasterizationSamples :: SampleCountFlagBits
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CommandBufferInheritanceRenderingInfo)
#endif
deriving instance Show CommandBufferInheritanceRenderingInfo

instance ToCStruct CommandBufferInheritanceRenderingInfo where
  withCStruct :: CommandBufferInheritanceRenderingInfo
-> (Ptr CommandBufferInheritanceRenderingInfo -> IO b) -> IO b
withCStruct CommandBufferInheritanceRenderingInfo
x Ptr CommandBufferInheritanceRenderingInfo -> IO b
f = Int -> (Ptr CommandBufferInheritanceRenderingInfo -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
56 ((Ptr CommandBufferInheritanceRenderingInfo -> IO b) -> IO b)
-> (Ptr CommandBufferInheritanceRenderingInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr CommandBufferInheritanceRenderingInfo
p -> Ptr CommandBufferInheritanceRenderingInfo
-> CommandBufferInheritanceRenderingInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr CommandBufferInheritanceRenderingInfo
p CommandBufferInheritanceRenderingInfo
x (Ptr CommandBufferInheritanceRenderingInfo -> IO b
f Ptr CommandBufferInheritanceRenderingInfo
p)
  pokeCStruct :: Ptr CommandBufferInheritanceRenderingInfo
-> CommandBufferInheritanceRenderingInfo -> IO b -> IO b
pokeCStruct Ptr CommandBufferInheritanceRenderingInfo
p CommandBufferInheritanceRenderingInfo{Word32
Vector Format
Format
SampleCountFlagBits
RenderingFlags
rasterizationSamples :: SampleCountFlagBits
stencilAttachmentFormat :: Format
depthAttachmentFormat :: Format
colorAttachmentFormats :: Vector Format
viewMask :: Word32
flags :: RenderingFlags
$sel:rasterizationSamples:CommandBufferInheritanceRenderingInfo :: CommandBufferInheritanceRenderingInfo -> SampleCountFlagBits
$sel:stencilAttachmentFormat:CommandBufferInheritanceRenderingInfo :: CommandBufferInheritanceRenderingInfo -> Format
$sel:depthAttachmentFormat:CommandBufferInheritanceRenderingInfo :: CommandBufferInheritanceRenderingInfo -> Format
$sel:colorAttachmentFormats:CommandBufferInheritanceRenderingInfo :: CommandBufferInheritanceRenderingInfo -> Vector Format
$sel:viewMask:CommandBufferInheritanceRenderingInfo :: CommandBufferInheritanceRenderingInfo -> Word32
$sel:flags:CommandBufferInheritanceRenderingInfo :: CommandBufferInheritanceRenderingInfo -> RenderingFlags
..} 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 CommandBufferInheritanceRenderingInfo
p Ptr CommandBufferInheritanceRenderingInfo
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COMMAND_BUFFER_INHERITANCE_RENDERING_INFO)
    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 CommandBufferInheritanceRenderingInfo
p Ptr CommandBufferInheritanceRenderingInfo -> 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 RenderingFlags -> RenderingFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CommandBufferInheritanceRenderingInfo
p Ptr CommandBufferInheritanceRenderingInfo
-> Int -> Ptr RenderingFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr RenderingFlags)) (RenderingFlags
flags)
    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 CommandBufferInheritanceRenderingInfo
p Ptr CommandBufferInheritanceRenderingInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (Word32
viewMask)
    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 CommandBufferInheritanceRenderingInfo
p Ptr CommandBufferInheritanceRenderingInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Format -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Format -> Int) -> Vector Format -> Int
forall a b. (a -> b) -> a -> b
$ (Vector Format
colorAttachmentFormats)) :: Word32))
    Ptr Format
pPColorAttachmentFormats' <- ((Ptr Format -> IO b) -> IO b) -> ContT b IO (Ptr Format)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Format -> IO b) -> IO b) -> ContT b IO (Ptr Format))
-> ((Ptr Format -> IO b) -> IO b) -> ContT b IO (Ptr Format)
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr Format -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @Format ((Vector Format -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Format
colorAttachmentFormats)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4)
    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 -> Format -> IO ()) -> Vector Format -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Format
e -> Ptr Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Format
pPColorAttachmentFormats' Ptr Format -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Format) (Format
e)) (Vector Format
colorAttachmentFormats)
    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 Format) -> Ptr Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CommandBufferInheritanceRenderingInfo
p Ptr CommandBufferInheritanceRenderingInfo
-> Int -> Ptr (Ptr Format)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr Format))) (Ptr Format
pPColorAttachmentFormats')
    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 Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CommandBufferInheritanceRenderingInfo
p Ptr CommandBufferInheritanceRenderingInfo -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Format)) (Format
depthAttachmentFormat)
    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 Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CommandBufferInheritanceRenderingInfo
p Ptr CommandBufferInheritanceRenderingInfo -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Format)) (Format
stencilAttachmentFormat)
    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 SampleCountFlagBits -> SampleCountFlagBits -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CommandBufferInheritanceRenderingInfo
p Ptr CommandBufferInheritanceRenderingInfo
-> Int -> Ptr SampleCountFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr SampleCountFlagBits)) (SampleCountFlagBits
rasterizationSamples)
    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 :: Ptr CommandBufferInheritanceRenderingInfo -> IO b -> IO b
pokeZeroCStruct Ptr CommandBufferInheritanceRenderingInfo
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CommandBufferInheritanceRenderingInfo
p Ptr CommandBufferInheritanceRenderingInfo
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COMMAND_BUFFER_INHERITANCE_RENDERING_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CommandBufferInheritanceRenderingInfo
p Ptr CommandBufferInheritanceRenderingInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CommandBufferInheritanceRenderingInfo
p Ptr CommandBufferInheritanceRenderingInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    Ptr Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CommandBufferInheritanceRenderingInfo
p Ptr CommandBufferInheritanceRenderingInfo -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Format)) (Format
forall a. Zero a => a
zero)
    Ptr Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CommandBufferInheritanceRenderingInfo
p Ptr CommandBufferInheritanceRenderingInfo -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Format)) (Format
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct CommandBufferInheritanceRenderingInfo where
  peekCStruct :: Ptr CommandBufferInheritanceRenderingInfo
-> IO CommandBufferInheritanceRenderingInfo
peekCStruct Ptr CommandBufferInheritanceRenderingInfo
p = do
    RenderingFlags
flags <- Ptr RenderingFlags -> IO RenderingFlags
forall a. Storable a => Ptr a -> IO a
peek @RenderingFlags ((Ptr CommandBufferInheritanceRenderingInfo
p Ptr CommandBufferInheritanceRenderingInfo
-> Int -> Ptr RenderingFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr RenderingFlags))
    Word32
viewMask <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr CommandBufferInheritanceRenderingInfo
p Ptr CommandBufferInheritanceRenderingInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
    Word32
colorAttachmentCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr CommandBufferInheritanceRenderingInfo
p Ptr CommandBufferInheritanceRenderingInfo -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32))
    Ptr Format
pColorAttachmentFormats <- Ptr (Ptr Format) -> IO (Ptr Format)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Format) ((Ptr CommandBufferInheritanceRenderingInfo
p Ptr CommandBufferInheritanceRenderingInfo
-> Int -> Ptr (Ptr Format)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr Format)))
    Vector Format
pColorAttachmentFormats' <- Int -> (Int -> IO Format) -> IO (Vector Format)
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
colorAttachmentCount) (\Int
i -> Ptr Format -> IO Format
forall a. Storable a => Ptr a -> IO a
peek @Format ((Ptr Format
pColorAttachmentFormats Ptr Format -> Int -> Ptr Format
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Format)))
    Format
depthAttachmentFormat <- Ptr Format -> IO Format
forall a. Storable a => Ptr a -> IO a
peek @Format ((Ptr CommandBufferInheritanceRenderingInfo
p Ptr CommandBufferInheritanceRenderingInfo -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Format))
    Format
stencilAttachmentFormat <- Ptr Format -> IO Format
forall a. Storable a => Ptr a -> IO a
peek @Format ((Ptr CommandBufferInheritanceRenderingInfo
p Ptr CommandBufferInheritanceRenderingInfo -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Format))
    SampleCountFlagBits
rasterizationSamples <- Ptr SampleCountFlagBits -> IO SampleCountFlagBits
forall a. Storable a => Ptr a -> IO a
peek @SampleCountFlagBits ((Ptr CommandBufferInheritanceRenderingInfo
p Ptr CommandBufferInheritanceRenderingInfo
-> Int -> Ptr SampleCountFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr SampleCountFlagBits))
    CommandBufferInheritanceRenderingInfo
-> IO CommandBufferInheritanceRenderingInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CommandBufferInheritanceRenderingInfo
 -> IO CommandBufferInheritanceRenderingInfo)
-> CommandBufferInheritanceRenderingInfo
-> IO CommandBufferInheritanceRenderingInfo
forall a b. (a -> b) -> a -> b
$ RenderingFlags
-> Word32
-> Vector Format
-> Format
-> Format
-> SampleCountFlagBits
-> CommandBufferInheritanceRenderingInfo
CommandBufferInheritanceRenderingInfo
             RenderingFlags
flags Word32
viewMask Vector Format
pColorAttachmentFormats' Format
depthAttachmentFormat Format
stencilAttachmentFormat SampleCountFlagBits
rasterizationSamples

instance Zero CommandBufferInheritanceRenderingInfo where
  zero :: CommandBufferInheritanceRenderingInfo
zero = RenderingFlags
-> Word32
-> Vector Format
-> Format
-> Format
-> SampleCountFlagBits
-> CommandBufferInheritanceRenderingInfo
CommandBufferInheritanceRenderingInfo
           RenderingFlags
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Vector Format
forall a. Monoid a => a
mempty
           Format
forall a. Zero a => a
zero
           Format
forall a. Zero a => a
zero
           SampleCountFlagBits
forall a. Zero a => a
zero