{-# language CPP #-}
-- | = Name
--
-- VK_KHR_dynamic_rendering - device extension
--
-- == VK_KHR_dynamic_rendering
--
-- [__Name String__]
--     @VK_KHR_dynamic_rendering@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     45
--
-- [__Revision__]
--     1
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires Vulkan 1.0
--
--     -   Requires @VK_KHR_get_physical_device_properties2@
--
-- [__Contact__]
--
--     -   Tobias Hector
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_KHR_dynamic_rendering] @tobski%0A<<Here describe the issue or question you have about the VK_KHR_dynamic_rendering extension>> >
--
-- [__Extension Proposal__]
--     <https://github.com/KhronosGroup/Vulkan-Docs/tree/main/proposals/VK_KHR_dynamic_rendering.asciidoc VK_KHR_dynamic_rendering>
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2021-10-06
--
-- [__Contributors__]
--
--     -   Tobias Hector, AMD
--
--     -   Arseny Kapoulkine, Roblox
--
--     -   François Duranleau, Gameloft
--
--     -   Stuart Smith, AMD
--
--     -   Hai Nguyen, Google
--
--     -   Jean-François Roy, Google
--
--     -   Jeff Leger, Qualcomm
--
--     -   Jan-Harald Fredriksen, Arm
--
--     -   Piers Daniell, Nvidia
--
--     -   James Fitzpatrick, Imagination
--
--     -   Piotr Byszewski, Mobica
--
--     -   Jesse Hall, Google
--
--     -   Mike Blumenkrantz, Valve
--
-- == Description
--
-- This extension allows applications to create single-pass render pass
-- instances without needing to create render pass objects or framebuffers.
-- Dynamic render passes can also span across multiple primary command
-- buffers, rather than relying on secondary command buffers.
--
-- This extension also incorporates
-- 'Vulkan.Core10.Enums.AttachmentStoreOp.ATTACHMENT_STORE_OP_NONE_KHR'
-- from <VK_QCOM_render_pass_store_ops.html VK_QCOM_render_pass_store_ops>,
-- enabling applications to avoid unnecessary synchronization when an
-- attachment is not written during a render pass.
--
-- == New Commands
--
-- -   'cmdBeginRenderingKHR'
--
-- -   'cmdEndRenderingKHR'
--
-- == New Structures
--
-- -   'RenderingAttachmentInfoKHR'
--
-- -   'RenderingInfoKHR'
--
-- -   Extending
--     'Vulkan.Core10.CommandBuffer.CommandBufferInheritanceInfo':
--
--     -   'CommandBufferInheritanceRenderingInfoKHR'
--
-- -   Extending 'Vulkan.Core10.Pipeline.GraphicsPipelineCreateInfo':
--
--     -   'PipelineRenderingCreateInfoKHR'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDeviceDynamicRenderingFeaturesKHR'
--
-- If
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_AMD_mixed_attachment_samples VK_AMD_mixed_attachment_samples>
-- is supported:
--
-- -   Extending
--     'Vulkan.Core10.CommandBuffer.CommandBufferInheritanceInfo',
--     'Vulkan.Core10.Pipeline.GraphicsPipelineCreateInfo':
--
--     -   'AttachmentSampleCountInfoAMD'
--
-- If
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_fragment_density_map VK_EXT_fragment_density_map>
-- is supported:
--
-- -   Extending 'RenderingInfoKHR':
--
--     -   'RenderingFragmentDensityMapAttachmentInfoEXT'
--
-- If
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_fragment_shading_rate VK_KHR_fragment_shading_rate>
-- is supported:
--
-- -   Extending 'RenderingInfoKHR':
--
--     -   'RenderingFragmentShadingRateAttachmentInfoKHR'
--
-- If
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_framebuffer_mixed_samples VK_NV_framebuffer_mixed_samples>
-- is supported:
--
-- -   Extending
--     'Vulkan.Core10.CommandBuffer.CommandBufferInheritanceInfo',
--     'Vulkan.Core10.Pipeline.GraphicsPipelineCreateInfo':
--
--     -   'AttachmentSampleCountInfoNV'
--
-- If
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NVX_multiview_per_view_attributes VK_NVX_multiview_per_view_attributes>
-- is supported:
--
-- -   Extending
--     'Vulkan.Core10.CommandBuffer.CommandBufferInheritanceInfo',
--     'Vulkan.Core10.Pipeline.GraphicsPipelineCreateInfo',
--     'RenderingInfoKHR':
--
--     -   'MultiviewPerViewAttributesInfoNVX'
--
-- == New Enums
--
-- -   'RenderingFlagBitsKHR'
--
-- == New Bitmasks
--
-- -   'RenderingFlagsKHR'
--
-- == New Enum Constants
--
-- -   'KHR_DYNAMIC_RENDERING_EXTENSION_NAME'
--
-- -   'KHR_DYNAMIC_RENDERING_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.AttachmentStoreOp.AttachmentStoreOp':
--
--     -   'Vulkan.Core10.Enums.AttachmentStoreOp.ATTACHMENT_STORE_OP_NONE_KHR'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_COMMAND_BUFFER_INHERITANCE_RENDERING_INFO_KHR'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_DYNAMIC_RENDERING_FEATURES_KHR'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PIPELINE_RENDERING_CREATE_INFO_KHR'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_RENDERING_ATTACHMENT_INFO_KHR'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_RENDERING_INFO_KHR'
--
-- If
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_AMD_mixed_attachment_samples VK_AMD_mixed_attachment_samples>
-- is supported:
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_ATTACHMENT_SAMPLE_COUNT_INFO_AMD'
--
-- If
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_fragment_density_map VK_EXT_fragment_density_map>
-- is supported:
--
-- -   Extending
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PipelineCreateFlagBits':
--
--     -   'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RENDERING_FRAGMENT_DENSITY_MAP_ATTACHMENT_BIT_EXT'
--
--     -   'PIPELINE_RASTERIZATION_STATE_CREATE_FRAGMENT_DENSITY_MAP_ATTACHMENT_BIT_EXT'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_RENDERING_FRAGMENT_DENSITY_MAP_ATTACHMENT_INFO_EXT'
--
-- If
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_fragment_shading_rate VK_KHR_fragment_shading_rate>
-- is supported:
--
-- -   Extending
--     'Vulkan.Core10.Enums.PipelineCreateFlagBits.PipelineCreateFlagBits':
--
--     -   'Vulkan.Core10.Enums.PipelineCreateFlagBits.PIPELINE_CREATE_RENDERING_FRAGMENT_SHADING_RATE_ATTACHMENT_BIT_KHR'
--
--     -   'PIPELINE_RASTERIZATION_STATE_CREATE_FRAGMENT_SHADING_RATE_ATTACHMENT_BIT_KHR'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_RENDERING_FRAGMENT_SHADING_RATE_ATTACHMENT_INFO_KHR'
--
-- If
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NV_framebuffer_mixed_samples VK_NV_framebuffer_mixed_samples>
-- is supported:
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'STRUCTURE_TYPE_ATTACHMENT_SAMPLE_COUNT_INFO_NV'
--
-- If
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_NVX_multiview_per_view_attributes VK_NVX_multiview_per_view_attributes>
-- is supported:
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_MULTIVIEW_PER_VIEW_ATTRIBUTES_INFO_NVX'
--
-- == Version History
--
-- -   Revision 1, 2021-10-06 (Tobias Hector)
--
--     -   Initial revision
--
-- == See Also
--
-- 'CommandBufferInheritanceRenderingInfoKHR',
-- 'PhysicalDeviceDynamicRenderingFeaturesKHR',
-- 'PipelineRenderingCreateInfoKHR', 'RenderingAttachmentInfoKHR',
-- 'RenderingFlagBitsKHR', 'RenderingFlagsKHR', 'RenderingInfoKHR',
-- 'cmdBeginRenderingKHR', 'cmdEndRenderingKHR'
--
-- == Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_dynamic_rendering Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_KHR_dynamic_rendering  ( cmdBeginRenderingKHR
                                                   , cmdUseRenderingKHR
                                                   , cmdEndRenderingKHR
                                                   , pattern PIPELINE_RASTERIZATION_STATE_CREATE_FRAGMENT_SHADING_RATE_ATTACHMENT_BIT_KHR
                                                   , pattern PIPELINE_RASTERIZATION_STATE_CREATE_FRAGMENT_DENSITY_MAP_ATTACHMENT_BIT_EXT
                                                   , pattern STRUCTURE_TYPE_ATTACHMENT_SAMPLE_COUNT_INFO_NV
                                                   , PipelineRenderingCreateInfoKHR(..)
                                                   , RenderingInfoKHR(..)
                                                   , RenderingAttachmentInfoKHR(..)
                                                   , RenderingFragmentShadingRateAttachmentInfoKHR(..)
                                                   , RenderingFragmentDensityMapAttachmentInfoEXT(..)
                                                   , PhysicalDeviceDynamicRenderingFeaturesKHR(..)
                                                   , CommandBufferInheritanceRenderingInfoKHR(..)
                                                   , AttachmentSampleCountInfoAMD(..)
                                                   , MultiviewPerViewAttributesInfoNVX(..)
                                                   , RenderingFlagsKHR
                                                   , RenderingFlagBitsKHR( RENDERING_CONTENTS_SECONDARY_COMMAND_BUFFERS_BIT_KHR
                                                                         , RENDERING_SUSPENDING_BIT_KHR
                                                                         , RENDERING_RESUMING_BIT_KHR
                                                                         , ..
                                                                         )
                                                   , AttachmentSampleCountInfoNV
                                                   , KHR_DYNAMIC_RENDERING_SPEC_VERSION
                                                   , pattern KHR_DYNAMIC_RENDERING_SPEC_VERSION
                                                   , KHR_DYNAMIC_RENDERING_EXTENSION_NAME
                                                   , pattern KHR_DYNAMIC_RENDERING_EXTENSION_NAME
                                                   ) where

import Vulkan.Internal.Utils (enumReadPrec)
import Vulkan.Internal.Utils (enumShowsPrec)
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import 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 GHC.Show (showString)
import Numeric (showHex)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero)
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.Bits (Bits)
import Data.Bits (FiniteBits)
import Data.String (IsString)
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 GHC.Read (Read(readPrec))
import GHC.Show (Show(showsPrec))
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(pVkCmdBeginRenderingKHR))
import Vulkan.Dynamic (DeviceCmds(pVkCmdEndRenderingKHR))
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.FundamentalTypes (Extent2D)
import Vulkan.Core10.FundamentalTypes (Flags)
import Vulkan.Core10.Enums.Format (Format)
import Vulkan.Core10.Enums.ImageLayout (ImageLayout)
import Vulkan.Core10.Handles (ImageView)
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (PokeChain(..))
import Vulkan.Core10.FundamentalTypes (Rect2D)
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.PipelineCreateFlagBits (PipelineCreateFlags)
import Vulkan.Core10.Enums.PipelineCreateFlagBits (PipelineCreateFlagBits(PIPELINE_CREATE_RENDERING_FRAGMENT_DENSITY_MAP_ATTACHMENT_BIT_EXT))
import Vulkan.Core10.Enums.PipelineCreateFlagBits (PipelineCreateFlags)
import Vulkan.Core10.Enums.PipelineCreateFlagBits (PipelineCreateFlagBits(PIPELINE_CREATE_RENDERING_FRAGMENT_SHADING_RATE_ATTACHMENT_BIT_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_ATTACHMENT_SAMPLE_COUNT_INFO_AMD))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_COMMAND_BUFFER_INHERITANCE_RENDERING_INFO_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_MULTIVIEW_PER_VIEW_ATTRIBUTES_INFO_NVX))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_DYNAMIC_RENDERING_FEATURES_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PIPELINE_RENDERING_CREATE_INFO_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_RENDERING_ATTACHMENT_INFO_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_RENDERING_FRAGMENT_DENSITY_MAP_ATTACHMENT_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_RENDERING_FRAGMENT_SHADING_RATE_ATTACHMENT_INFO_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_RENDERING_INFO_KHR))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCmdBeginRenderingKHR
  :: FunPtr (Ptr CommandBuffer_T -> Ptr (SomeStruct RenderingInfoKHR) -> IO ()) -> Ptr CommandBuffer_T -> Ptr (SomeStruct RenderingInfoKHR) -> IO ()

-- | vkCmdBeginRenderingKHR - 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.2-extensions/html/vkspec.html#drawing draw commands>.
--
-- If @pRenderingInfo->flags@ includes 'RENDERING_RESUMING_BIT_KHR' 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.2-extensions/html/vkspec.html#synchronization-submission-order submission order>.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdBeginRenderingKHR-dynamicRendering-06446# The
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-dynamicRendering dynamicRendering>
--     feature /must/ be enabled
--
-- -   #VUID-vkCmdBeginRenderingKHR-commandBuffer-06068# If @commandBuffer@
--     is a secondary command buffer, @pRenderingInfo->flags@ /must/ not
--     include 'RENDERING_CONTENTS_SECONDARY_COMMAND_BUFFERS_BIT_KHR'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdBeginRenderingKHR-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdBeginRenderingKHR-pRenderingInfo-parameter#
--     @pRenderingInfo@ /must/ be a valid pointer to a valid
--     'RenderingInfoKHR' structure
--
-- -   #VUID-vkCmdBeginRenderingKHR-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-vkCmdBeginRenderingKHR-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- -   #VUID-vkCmdBeginRenderingKHR-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>,
-- 'Vulkan.Core10.Handles.CommandBuffer', 'RenderingInfoKHR'
cmdBeginRenderingKHR :: forall a io
                      . (Extendss RenderingInfoKHR a, PokeChain a, MonadIO io)
                     => -- | @commandBuffer@ is the command buffer in which to record the command.
                        CommandBuffer
                     -> -- | @pRenderingInfo@ is a pointer to a 'RenderingInfoKHR' structure
                        -- specifying details of the render pass instance to begin.
                        (RenderingInfoKHR a)
                     -> io ()
cmdBeginRenderingKHR :: CommandBuffer -> RenderingInfoKHR a -> io ()
cmdBeginRenderingKHR CommandBuffer
commandBuffer RenderingInfoKHR 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 vkCmdBeginRenderingKHRPtr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfoKHR))
   -> IO ())
vkCmdBeginRenderingKHRPtr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfoKHR))
      -> IO ())
pVkCmdBeginRenderingKHR (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 RenderingInfoKHR))
   -> IO ())
vkCmdBeginRenderingKHRPtr FunPtr
  (Ptr CommandBuffer_T
   -> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfoKHR))
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfoKHR))
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfoKHR))
   -> 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 vkCmdBeginRenderingKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdBeginRenderingKHR' :: Ptr CommandBuffer_T
-> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfoKHR))
-> IO ()
vkCmdBeginRenderingKHR' = FunPtr
  (Ptr CommandBuffer_T
   -> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfoKHR))
   -> IO ())
-> Ptr CommandBuffer_T
-> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfoKHR))
-> IO ()
mkVkCmdBeginRenderingKHR FunPtr
  (Ptr CommandBuffer_T
   -> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfoKHR))
   -> IO ())
vkCmdBeginRenderingKHRPtr
  Ptr (RenderingInfoKHR a)
pRenderingInfo <- ((Ptr (RenderingInfoKHR a) -> IO ()) -> IO ())
-> ContT () IO (Ptr (RenderingInfoKHR a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (RenderingInfoKHR a) -> IO ()) -> IO ())
 -> ContT () IO (Ptr (RenderingInfoKHR a)))
-> ((Ptr (RenderingInfoKHR a) -> IO ()) -> IO ())
-> ContT () IO (Ptr (RenderingInfoKHR a))
forall a b. (a -> b) -> a -> b
$ RenderingInfoKHR a -> (Ptr (RenderingInfoKHR a) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (RenderingInfoKHR 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
"vkCmdBeginRenderingKHR" (Ptr CommandBuffer_T
-> ("pRenderingInfo" ::: Ptr (SomeStruct RenderingInfoKHR))
-> IO ()
vkCmdBeginRenderingKHR' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) (Ptr (RenderingInfoKHR a)
-> "pRenderingInfo" ::: Ptr (SomeStruct RenderingInfoKHR)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (RenderingInfoKHR 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
-- 'cmdBeginRenderingKHR' and 'cmdEndRenderingKHR'
--
-- Note that 'cmdEndRenderingKHR' is *not* called if an exception is thrown
-- by the inner action.
cmdUseRenderingKHR :: forall a io r . (Extendss RenderingInfoKHR a, PokeChain a, MonadIO io) => CommandBuffer -> RenderingInfoKHR a -> io r -> io r
cmdUseRenderingKHR :: CommandBuffer -> RenderingInfoKHR a -> io r -> io r
cmdUseRenderingKHR CommandBuffer
commandBuffer RenderingInfoKHR a
pRenderingInfo io r
a =
  (CommandBuffer -> RenderingInfoKHR a -> io ()
forall (a :: [*]) (io :: * -> *).
(Extendss RenderingInfoKHR a, PokeChain a, MonadIO io) =>
CommandBuffer -> RenderingInfoKHR a -> io ()
cmdBeginRenderingKHR CommandBuffer
commandBuffer RenderingInfoKHR 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 ()
cmdEndRenderingKHR CommandBuffer
commandBuffer)


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

-- | vkCmdEndRenderingKHR - End a dynamic render pass instance
--
-- = Description
--
-- If the value of @pRenderingInfo->flags@ used to begin this render pass
-- instance included 'RENDERING_SUSPENDING_BIT_KHR', then this render pass
-- is suspended and will be resumed later in
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-submission-order submission order>.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdEndRenderingKHR-None-06161# The current render pass
--     instance /must/ have been begun with 'cmdBeginRenderingKHR'
--
-- -   #VUID-vkCmdEndRenderingKHR-commandBuffer-06162# The current render
--     pass instance /must/ have been begun in @commandBuffer@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdEndRenderingKHR-commandBuffer-parameter# @commandBuffer@
--     /must/ be a valid 'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdEndRenderingKHR-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-vkCmdEndRenderingKHR-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- -   #VUID-vkCmdEndRenderingKHR-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>,
-- 'Vulkan.Core10.Handles.CommandBuffer'
cmdEndRenderingKHR :: forall io
                    . (MonadIO io)
                   => -- | @commandBuffer@ is the command buffer in which to record the command.
                      CommandBuffer
                   -> io ()
cmdEndRenderingKHR :: CommandBuffer -> io ()
cmdEndRenderingKHR 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 vkCmdEndRenderingKHRPtr :: FunPtr (Ptr CommandBuffer_T -> IO ())
vkCmdEndRenderingKHRPtr = DeviceCmds -> FunPtr (Ptr CommandBuffer_T -> IO ())
pVkCmdEndRenderingKHR (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 ())
vkCmdEndRenderingKHRPtr 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 vkCmdEndRenderingKHR is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdEndRenderingKHR' :: Ptr CommandBuffer_T -> IO ()
vkCmdEndRenderingKHR' = FunPtr (Ptr CommandBuffer_T -> IO ())
-> Ptr CommandBuffer_T -> IO ()
mkVkCmdEndRenderingKHR FunPtr (Ptr CommandBuffer_T -> IO ())
vkCmdEndRenderingKHRPtr
  String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdEndRenderingKHR" (Ptr CommandBuffer_T -> IO ()
vkCmdEndRenderingKHR' (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
$ ()


-- No documentation found for TopLevel "VK_PIPELINE_RASTERIZATION_STATE_CREATE_FRAGMENT_SHADING_RATE_ATTACHMENT_BIT_KHR"
pattern $bPIPELINE_RASTERIZATION_STATE_CREATE_FRAGMENT_SHADING_RATE_ATTACHMENT_BIT_KHR :: PipelineCreateFlagBits
$mPIPELINE_RASTERIZATION_STATE_CREATE_FRAGMENT_SHADING_RATE_ATTACHMENT_BIT_KHR :: forall r.
PipelineCreateFlagBits -> (Void# -> r) -> (Void# -> r) -> r
PIPELINE_RASTERIZATION_STATE_CREATE_FRAGMENT_SHADING_RATE_ATTACHMENT_BIT_KHR = PIPELINE_CREATE_RENDERING_FRAGMENT_SHADING_RATE_ATTACHMENT_BIT_KHR


-- No documentation found for TopLevel "VK_PIPELINE_RASTERIZATION_STATE_CREATE_FRAGMENT_DENSITY_MAP_ATTACHMENT_BIT_EXT"
pattern $bPIPELINE_RASTERIZATION_STATE_CREATE_FRAGMENT_DENSITY_MAP_ATTACHMENT_BIT_EXT :: PipelineCreateFlagBits
$mPIPELINE_RASTERIZATION_STATE_CREATE_FRAGMENT_DENSITY_MAP_ATTACHMENT_BIT_EXT :: forall r.
PipelineCreateFlagBits -> (Void# -> r) -> (Void# -> r) -> r
PIPELINE_RASTERIZATION_STATE_CREATE_FRAGMENT_DENSITY_MAP_ATTACHMENT_BIT_EXT = PIPELINE_CREATE_RENDERING_FRAGMENT_DENSITY_MAP_ATTACHMENT_BIT_EXT


-- No documentation found for TopLevel "VK_STRUCTURE_TYPE_ATTACHMENT_SAMPLE_COUNT_INFO_NV"
pattern $bSTRUCTURE_TYPE_ATTACHMENT_SAMPLE_COUNT_INFO_NV :: StructureType
$mSTRUCTURE_TYPE_ATTACHMENT_SAMPLE_COUNT_INFO_NV :: forall r. StructureType -> (Void# -> r) -> (Void# -> r) -> r
STRUCTURE_TYPE_ATTACHMENT_SAMPLE_COUNT_INFO_NV = STRUCTURE_TYPE_ATTACHMENT_SAMPLE_COUNT_INFO_AMD


-- | VkPipelineRenderingCreateInfoKHR - 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
--
-- -   #VUID-VkPipelineRenderingCreateInfoKHR-pColorAttachmentFormats-06064#
--     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.2-extensions/html/vkspec.html#potential-format-features potential format features>
--     that include
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_COLOR_ATTACHMENT_BIT'
--
-- -   #VUID-VkPipelineRenderingCreateInfoKHR-depthAttachmentFormat-06065#
--     If @depthAttachmentFormat@ is not
--     'Vulkan.Core10.Enums.Format.FORMAT_UNDEFINED', it /must/ be a format
--     with
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#potential-format-features potential format features>
--     that include
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_DEPTH_STENCIL_ATTACHMENT_BIT'
--
-- -   #VUID-VkPipelineRenderingCreateInfoKHR-stencilAttachmentFormat-06164#
--     If @stencilAttachmentFormat@ is not
--     'Vulkan.Core10.Enums.Format.FORMAT_UNDEFINED', it /must/ be a format
--     with
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#potential-format-features potential format features>
--     that include
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_DEPTH_STENCIL_ATTACHMENT_BIT'
--
-- -   #VUID-VkPipelineRenderingCreateInfoKHR-depthAttachmentFormat-06165#
--     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-VkPipelineRenderingCreateInfoKHR-multiview-06066# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-multiview multiview>
--     feature is not enabled, @viewMask@ /must/ be @0@
--
-- -   #VUID-VkPipelineRenderingCreateInfoKHR-viewMask-06067# The index of
--     the most significant bit in @viewMask@ /must/ be less than
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-maxMultiviewViewCount maxMultiviewViewCount>
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkPipelineRenderingCreateInfoKHR-sType-sType# @sType@ /must/
--     be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PIPELINE_RENDERING_CREATE_INFO_KHR'
--
-- -   #VUID-VkPipelineRenderingCreateInfoKHR-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-VkPipelineRenderingCreateInfoKHR-depthAttachmentFormat-parameter#
--     @depthAttachmentFormat@ /must/ be a valid
--     'Vulkan.Core10.Enums.Format.Format' value
--
-- -   #VUID-VkPipelineRenderingCreateInfoKHR-stencilAttachmentFormat-parameter#
--     @stencilAttachmentFormat@ /must/ be a valid
--     'Vulkan.Core10.Enums.Format.Format' value
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_dynamic_rendering VK_KHR_dynamic_rendering>,
-- 'Vulkan.Core10.Enums.Format.Format',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PipelineRenderingCreateInfoKHR = PipelineRenderingCreateInfoKHR
  { -- | @viewMask@ is the viewMask used for rendering.
    PipelineRenderingCreateInfoKHR -> 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.
    PipelineRenderingCreateInfoKHR -> 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.
    PipelineRenderingCreateInfoKHR -> Format
depthAttachmentFormat :: Format
  , -- | @stencilAttachmentFormat@ is a 'Vulkan.Core10.Enums.Format.Format' value
    -- defining the format of the stencil attachment used in this pipeline.
    PipelineRenderingCreateInfoKHR -> Format
stencilAttachmentFormat :: Format
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PipelineRenderingCreateInfoKHR)
#endif
deriving instance Show PipelineRenderingCreateInfoKHR

instance ToCStruct PipelineRenderingCreateInfoKHR where
  withCStruct :: PipelineRenderingCreateInfoKHR
-> (Ptr PipelineRenderingCreateInfoKHR -> IO b) -> IO b
withCStruct PipelineRenderingCreateInfoKHR
x Ptr PipelineRenderingCreateInfoKHR -> IO b
f = Int -> (Ptr PipelineRenderingCreateInfoKHR -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 ((Ptr PipelineRenderingCreateInfoKHR -> IO b) -> IO b)
-> (Ptr PipelineRenderingCreateInfoKHR -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PipelineRenderingCreateInfoKHR
p -> Ptr PipelineRenderingCreateInfoKHR
-> PipelineRenderingCreateInfoKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PipelineRenderingCreateInfoKHR
p PipelineRenderingCreateInfoKHR
x (Ptr PipelineRenderingCreateInfoKHR -> IO b
f Ptr PipelineRenderingCreateInfoKHR
p)
  pokeCStruct :: Ptr PipelineRenderingCreateInfoKHR
-> PipelineRenderingCreateInfoKHR -> IO b -> IO b
pokeCStruct Ptr PipelineRenderingCreateInfoKHR
p PipelineRenderingCreateInfoKHR{Word32
Vector Format
Format
stencilAttachmentFormat :: Format
depthAttachmentFormat :: Format
colorAttachmentFormats :: Vector Format
viewMask :: Word32
$sel:stencilAttachmentFormat:PipelineRenderingCreateInfoKHR :: PipelineRenderingCreateInfoKHR -> Format
$sel:depthAttachmentFormat:PipelineRenderingCreateInfoKHR :: PipelineRenderingCreateInfoKHR -> Format
$sel:colorAttachmentFormats:PipelineRenderingCreateInfoKHR :: PipelineRenderingCreateInfoKHR -> Vector Format
$sel:viewMask:PipelineRenderingCreateInfoKHR :: PipelineRenderingCreateInfoKHR -> 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 PipelineRenderingCreateInfoKHR
p Ptr PipelineRenderingCreateInfoKHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_RENDERING_CREATE_INFO_KHR)
    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 PipelineRenderingCreateInfoKHR
p Ptr PipelineRenderingCreateInfoKHR -> 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 PipelineRenderingCreateInfoKHR
p Ptr PipelineRenderingCreateInfoKHR -> 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 PipelineRenderingCreateInfoKHR
p Ptr PipelineRenderingCreateInfoKHR -> 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 PipelineRenderingCreateInfoKHR
p Ptr PipelineRenderingCreateInfoKHR -> 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 PipelineRenderingCreateInfoKHR
p Ptr PipelineRenderingCreateInfoKHR -> 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 PipelineRenderingCreateInfoKHR
p Ptr PipelineRenderingCreateInfoKHR -> 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 PipelineRenderingCreateInfoKHR -> IO b -> IO b
pokeZeroCStruct Ptr PipelineRenderingCreateInfoKHR
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineRenderingCreateInfoKHR
p Ptr PipelineRenderingCreateInfoKHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PIPELINE_RENDERING_CREATE_INFO_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PipelineRenderingCreateInfoKHR
p Ptr PipelineRenderingCreateInfoKHR -> 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 PipelineRenderingCreateInfoKHR
p Ptr PipelineRenderingCreateInfoKHR -> 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 PipelineRenderingCreateInfoKHR
p Ptr PipelineRenderingCreateInfoKHR -> 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 PipelineRenderingCreateInfoKHR
p Ptr PipelineRenderingCreateInfoKHR -> 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 PipelineRenderingCreateInfoKHR where
  peekCStruct :: Ptr PipelineRenderingCreateInfoKHR
-> IO PipelineRenderingCreateInfoKHR
peekCStruct Ptr PipelineRenderingCreateInfoKHR
p = do
    Word32
viewMask <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PipelineRenderingCreateInfoKHR
p Ptr PipelineRenderingCreateInfoKHR -> 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 PipelineRenderingCreateInfoKHR
p Ptr PipelineRenderingCreateInfoKHR -> 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 PipelineRenderingCreateInfoKHR
p Ptr PipelineRenderingCreateInfoKHR -> 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 PipelineRenderingCreateInfoKHR
p Ptr PipelineRenderingCreateInfoKHR -> 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 PipelineRenderingCreateInfoKHR
p Ptr PipelineRenderingCreateInfoKHR -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Format))
    PipelineRenderingCreateInfoKHR -> IO PipelineRenderingCreateInfoKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PipelineRenderingCreateInfoKHR
 -> IO PipelineRenderingCreateInfoKHR)
-> PipelineRenderingCreateInfoKHR
-> IO PipelineRenderingCreateInfoKHR
forall a b. (a -> b) -> a -> b
$ Word32
-> Vector Format
-> Format
-> Format
-> PipelineRenderingCreateInfoKHR
PipelineRenderingCreateInfoKHR
             Word32
viewMask Vector Format
pColorAttachmentFormats' Format
depthAttachmentFormat Format
stencilAttachmentFormat

instance Zero PipelineRenderingCreateInfoKHR where
  zero :: PipelineRenderingCreateInfoKHR
zero = Word32
-> Vector Format
-> Format
-> Format
-> PipelineRenderingCreateInfoKHR
PipelineRenderingCreateInfoKHR
           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


-- | VkRenderingInfoKHR - 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-VkRenderingInfoKHR-viewMask-06069# If @viewMask@ is @0@,
--     @layerCount@ /must/ not be @0@
--
-- -   #VUID-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-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-VkRenderingInfoKHR-colorAttachmentCount-06106#
--     @colorAttachmentCount@ /must/ be less than or equal to
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxColorAttachments@
--
-- -   #VUID-VkRenderingInfoKHR-imageView-06107# If the @imageView@ member
--     of a 'RenderingFragmentDensityMapAttachmentInfoEXT' structure
--     included in the @pNext@ chain is not
--     'Vulkan.Core10.APIConstants.NULL_HANDLE', and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-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-VkRenderingInfoKHR-imageView-06108# If the @imageView@ member
--     of a '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-VkRenderingInfoKHR-imageView-06109# If the @imageView@ member
--     of a '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-VkRenderingInfoKHR-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
--     '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-VkRenderingInfoKHR-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
--     '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-VkRenderingInfoKHR-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
--     '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-VkRenderingInfoKHR-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
--     '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-VkRenderingInfoKHR-imageView-06116# If the @imageView@ member
--     of a '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-VkRenderingInfoKHR-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
--     '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-VkRenderingInfoKHR-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
--     '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-VkRenderingInfoKHR-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
--     '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-VkRenderingInfoKHR-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
--     '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-VkRenderingInfoKHR-imageView-06123# If the @imageView@ member
--     of a '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-VkRenderingInfoKHR-imageView-06124# If the @imageView@ member
--     of a '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-VkRenderingInfoKHR-imageView-06125# If the @imageView@ member
--     of a '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-VkRenderingInfoKHR-imageView-06126# If the @imageView@ member
--     of a '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
--     'RenderingFragmentDensityMapAttachmentInfoEXT' structure included in
--     the @pNext@ chain
--
-- -   #VUID-VkRenderingInfoKHR-multiview-06127# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-multiview multiview>
--     feature is not enabled, @viewMask@ /must/ be @0@
--
-- -   #VUID-VkRenderingInfoKHR-viewMask-06128# The index of the most
--     significant bit in @viewMask@ /must/ be less than
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-maxMultiviewViewCount maxMultiviewViewCount>
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkRenderingInfoKHR-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_RENDERING_INFO_KHR'
--
-- -   #VUID-VkRenderingInfoKHR-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',
--     'MultiviewPerViewAttributesInfoNVX',
--     'RenderingFragmentDensityMapAttachmentInfoEXT', or
--     'RenderingFragmentShadingRateAttachmentInfoKHR'
--
-- -   #VUID-VkRenderingInfoKHR-sType-unique# The @sType@ value of each
--     struct in the @pNext@ chain /must/ be unique
--
-- -   #VUID-VkRenderingInfoKHR-flags-parameter# @flags@ /must/ be a valid
--     combination of 'RenderingFlagBitsKHR' values
--
-- -   #VUID-VkRenderingInfoKHR-pColorAttachments-parameter# If
--     @colorAttachmentCount@ is not @0@, @pColorAttachments@ /must/ be a
--     valid pointer to an array of @colorAttachmentCount@ valid
--     'RenderingAttachmentInfoKHR' structures
--
-- -   #VUID-VkRenderingInfoKHR-pDepthAttachment-parameter# If
--     @pDepthAttachment@ is not @NULL@, @pDepthAttachment@ /must/ be a
--     valid pointer to a valid 'RenderingAttachmentInfoKHR' structure
--
-- -   #VUID-VkRenderingInfoKHR-pStencilAttachment-parameter# If
--     @pStencilAttachment@ is not @NULL@, @pStencilAttachment@ /must/ be a
--     valid pointer to a valid 'RenderingAttachmentInfoKHR' structure
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_dynamic_rendering VK_KHR_dynamic_rendering>,
-- 'Vulkan.Core10.FundamentalTypes.Rect2D', 'RenderingAttachmentInfoKHR',
-- 'RenderingFlagsKHR', 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'cmdBeginRenderingKHR'
data RenderingInfoKHR (es :: [Type]) = RenderingInfoKHR
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    RenderingInfoKHR es -> Chain es
next :: Chain es
  , -- | @flags@ is a bitmask of 'RenderingFlagBitsKHR'.
    RenderingInfoKHR es -> RenderingFlagsKHR
flags :: RenderingFlagsKHR
  , -- | @renderArea@ is the render area that is affected by the render pass
    -- instance.
    RenderingInfoKHR es -> Rect2D
renderArea :: Rect2D
  , -- | @layerCount@ is the number of layers rendered to in each attachment when
    -- @viewMask@ is @0@.
    RenderingInfoKHR es -> Word32
layerCount :: Word32
  , -- | @viewMask@ is the view mask indicating the indices of attachment layers
    -- that will be rendered when it is not @0@.
    RenderingInfoKHR es -> Word32
viewMask :: Word32
  , -- | @pColorAttachments@ is a pointer to an array of @colorAttachmentCount@
    -- 'RenderingAttachmentInfoKHR' structures describing any color attachments
    -- used.
    RenderingInfoKHR es -> Vector RenderingAttachmentInfoKHR
colorAttachments :: Vector RenderingAttachmentInfoKHR
  , -- | @pDepthAttachment@ is a pointer to a 'RenderingAttachmentInfoKHR'
    -- structure describing a depth attachment.
    RenderingInfoKHR es -> Maybe RenderingAttachmentInfoKHR
depthAttachment :: Maybe RenderingAttachmentInfoKHR
  , -- | @pStencilAttachment@ is a pointer to a 'RenderingAttachmentInfoKHR'
    -- structure describing a stencil attachment.
    RenderingInfoKHR es -> Maybe RenderingAttachmentInfoKHR
stencilAttachment :: Maybe RenderingAttachmentInfoKHR
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (RenderingInfoKHR (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (RenderingInfoKHR es)

instance Extensible RenderingInfoKHR where
  extensibleTypeName :: String
extensibleTypeName = String
"RenderingInfoKHR"
  setNext :: RenderingInfoKHR ds -> Chain es -> RenderingInfoKHR es
setNext RenderingInfoKHR{Maybe RenderingAttachmentInfoKHR
Word32
Vector RenderingAttachmentInfoKHR
Chain ds
Rect2D
RenderingFlagsKHR
stencilAttachment :: Maybe RenderingAttachmentInfoKHR
depthAttachment :: Maybe RenderingAttachmentInfoKHR
colorAttachments :: Vector RenderingAttachmentInfoKHR
viewMask :: Word32
layerCount :: Word32
renderArea :: Rect2D
flags :: RenderingFlagsKHR
next :: Chain ds
$sel:stencilAttachment:RenderingInfoKHR :: forall (es :: [*]).
RenderingInfoKHR es -> Maybe RenderingAttachmentInfoKHR
$sel:depthAttachment:RenderingInfoKHR :: forall (es :: [*]).
RenderingInfoKHR es -> Maybe RenderingAttachmentInfoKHR
$sel:colorAttachments:RenderingInfoKHR :: forall (es :: [*]).
RenderingInfoKHR es -> Vector RenderingAttachmentInfoKHR
$sel:viewMask:RenderingInfoKHR :: forall (es :: [*]). RenderingInfoKHR es -> Word32
$sel:layerCount:RenderingInfoKHR :: forall (es :: [*]). RenderingInfoKHR es -> Word32
$sel:renderArea:RenderingInfoKHR :: forall (es :: [*]). RenderingInfoKHR es -> Rect2D
$sel:flags:RenderingInfoKHR :: forall (es :: [*]). RenderingInfoKHR es -> RenderingFlagsKHR
$sel:next:RenderingInfoKHR :: forall (es :: [*]). RenderingInfoKHR es -> Chain es
..} Chain es
next' = RenderingInfoKHR :: forall (es :: [*]).
Chain es
-> RenderingFlagsKHR
-> Rect2D
-> Word32
-> Word32
-> Vector RenderingAttachmentInfoKHR
-> Maybe RenderingAttachmentInfoKHR
-> Maybe RenderingAttachmentInfoKHR
-> RenderingInfoKHR es
RenderingInfoKHR{$sel:next:RenderingInfoKHR :: Chain es
next = Chain es
next', Maybe RenderingAttachmentInfoKHR
Word32
Vector RenderingAttachmentInfoKHR
Rect2D
RenderingFlagsKHR
stencilAttachment :: Maybe RenderingAttachmentInfoKHR
depthAttachment :: Maybe RenderingAttachmentInfoKHR
colorAttachments :: Vector RenderingAttachmentInfoKHR
viewMask :: Word32
layerCount :: Word32
renderArea :: Rect2D
flags :: RenderingFlagsKHR
$sel:stencilAttachment:RenderingInfoKHR :: Maybe RenderingAttachmentInfoKHR
$sel:depthAttachment:RenderingInfoKHR :: Maybe RenderingAttachmentInfoKHR
$sel:colorAttachments:RenderingInfoKHR :: Vector RenderingAttachmentInfoKHR
$sel:viewMask:RenderingInfoKHR :: Word32
$sel:layerCount:RenderingInfoKHR :: Word32
$sel:renderArea:RenderingInfoKHR :: Rect2D
$sel:flags:RenderingInfoKHR :: RenderingFlagsKHR
..}
  getNext :: RenderingInfoKHR es -> Chain es
getNext RenderingInfoKHR{Maybe RenderingAttachmentInfoKHR
Word32
Vector RenderingAttachmentInfoKHR
Chain es
Rect2D
RenderingFlagsKHR
stencilAttachment :: Maybe RenderingAttachmentInfoKHR
depthAttachment :: Maybe RenderingAttachmentInfoKHR
colorAttachments :: Vector RenderingAttachmentInfoKHR
viewMask :: Word32
layerCount :: Word32
renderArea :: Rect2D
flags :: RenderingFlagsKHR
next :: Chain es
$sel:stencilAttachment:RenderingInfoKHR :: forall (es :: [*]).
RenderingInfoKHR es -> Maybe RenderingAttachmentInfoKHR
$sel:depthAttachment:RenderingInfoKHR :: forall (es :: [*]).
RenderingInfoKHR es -> Maybe RenderingAttachmentInfoKHR
$sel:colorAttachments:RenderingInfoKHR :: forall (es :: [*]).
RenderingInfoKHR es -> Vector RenderingAttachmentInfoKHR
$sel:viewMask:RenderingInfoKHR :: forall (es :: [*]). RenderingInfoKHR es -> Word32
$sel:layerCount:RenderingInfoKHR :: forall (es :: [*]). RenderingInfoKHR es -> Word32
$sel:renderArea:RenderingInfoKHR :: forall (es :: [*]). RenderingInfoKHR es -> Rect2D
$sel:flags:RenderingInfoKHR :: forall (es :: [*]). RenderingInfoKHR es -> RenderingFlagsKHR
$sel:next:RenderingInfoKHR :: forall (es :: [*]). RenderingInfoKHR es -> Chain es
..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends RenderingInfoKHR e => b) -> Maybe b
  extends :: proxy e -> (Extends RenderingInfoKHR e => b) -> Maybe b
extends proxy e
_ Extends RenderingInfoKHR 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 RenderingInfoKHR 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 RenderingInfoKHR 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 RenderingInfoKHR 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 RenderingInfoKHR e => b
f
    | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing

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


-- | VkRenderingAttachmentInfoKHR - 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 'RenderingInfoKHR'. 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 'RENDERING_SUSPENDING_BIT_KHR'
-- flag.
--
-- Load operations are only performed at the beginning of a render pass
-- instance that does not specify the '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-VkRenderingAttachmentInfoKHR-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-VkRenderingAttachmentInfoKHR-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-VkRenderingAttachmentInfoKHR-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-VkRenderingAttachmentInfoKHR-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-VkRenderingAttachmentInfoKHR-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-VkRenderingAttachmentInfoKHR-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-VkRenderingAttachmentInfoKHR-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-VkRenderingAttachmentInfoKHR-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-VkRenderingAttachmentInfoKHR-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-VkRenderingAttachmentInfoKHR-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-VkRenderingAttachmentInfoKHR-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-VkRenderingAttachmentInfoKHR-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-VkRenderingAttachmentInfoKHR-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.Core10.Enums.ImageLayout.IMAGE_LAYOUT_READ_ONLY_OPTIMAL_KHR'
--
-- -   #VUID-VkRenderingAttachmentInfoKHR-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-VkRenderingAttachmentInfoKHR-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-VkRenderingAttachmentInfoKHR-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-VkRenderingAttachmentInfoKHR-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-VkRenderingAttachmentInfoKHR-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_RENDERING_ATTACHMENT_INFO_KHR'
--
-- -   #VUID-VkRenderingAttachmentInfoKHR-pNext-pNext# @pNext@ /must/ be
--     @NULL@
--
-- -   #VUID-VkRenderingAttachmentInfoKHR-imageView-parameter# If
--     @imageView@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @imageView@ /must/ be a valid 'Vulkan.Core10.Handles.ImageView'
--     handle
--
-- -   #VUID-VkRenderingAttachmentInfoKHR-imageLayout-parameter#
--     @imageLayout@ /must/ be a valid
--     'Vulkan.Core10.Enums.ImageLayout.ImageLayout' value
--
-- -   #VUID-VkRenderingAttachmentInfoKHR-resolveMode-parameter# If
--     @resolveMode@ is not @0@, @resolveMode@ /must/ be a valid
--     'Vulkan.Core12.Enums.ResolveModeFlagBits.ResolveModeFlagBits' value
--
-- -   #VUID-VkRenderingAttachmentInfoKHR-resolveImageView-parameter# If
--     @resolveImageView@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @resolveImageView@ /must/ be a valid
--     'Vulkan.Core10.Handles.ImageView' handle
--
-- -   #VUID-VkRenderingAttachmentInfoKHR-resolveImageLayout-parameter#
--     @resolveImageLayout@ /must/ be a valid
--     'Vulkan.Core10.Enums.ImageLayout.ImageLayout' value
--
-- -   #VUID-VkRenderingAttachmentInfoKHR-loadOp-parameter# @loadOp@ /must/
--     be a valid 'Vulkan.Core10.Enums.AttachmentLoadOp.AttachmentLoadOp'
--     value
--
-- -   #VUID-VkRenderingAttachmentInfoKHR-storeOp-parameter# @storeOp@
--     /must/ be a valid
--     'Vulkan.Core10.Enums.AttachmentStoreOp.AttachmentStoreOp' value
--
-- -   #VUID-VkRenderingAttachmentInfoKHR-clearValue-parameter#
--     @clearValue@ /must/ be a valid
--     'Vulkan.Core10.CommandBufferBuilding.ClearValue' union
--
-- -   #VUID-VkRenderingAttachmentInfoKHR-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>,
-- 'Vulkan.Core10.Enums.AttachmentLoadOp.AttachmentLoadOp',
-- 'Vulkan.Core10.Enums.AttachmentStoreOp.AttachmentStoreOp',
-- 'Vulkan.Core10.CommandBufferBuilding.ClearValue',
-- 'Vulkan.Core10.Enums.ImageLayout.ImageLayout',
-- 'Vulkan.Core10.Handles.ImageView', 'RenderingInfoKHR',
-- 'Vulkan.Core12.Enums.ResolveModeFlagBits.ResolveModeFlagBits',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data RenderingAttachmentInfoKHR = RenderingAttachmentInfoKHR
  { -- | @imageView@ is the image view that will be used for rendering.
    RenderingAttachmentInfoKHR -> ImageView
imageView :: ImageView
  , -- | @imageLayout@ is the layout that @imageView@ will be in during
    -- rendering.
    RenderingAttachmentInfoKHR -> ImageLayout
imageLayout :: ImageLayout
  , -- | @resolveMode@ is a
    -- 'Vulkan.Core12.Enums.ResolveModeFlagBits.ResolveModeFlagBits' value
    -- defining how multisampled data written to @imageView@ will be resolved.
    RenderingAttachmentInfoKHR -> ResolveModeFlagBits
resolveMode :: ResolveModeFlagBits
  , -- | @resolveImageView@ is an image view used to write resolved multisample
    -- data at the end of rendering.
    RenderingAttachmentInfoKHR -> ImageView
resolveImageView :: ImageView
  , -- | @resolveImageLayout@ is the layout that @resolveImageView@ will be in
    -- during rendering.
    RenderingAttachmentInfoKHR -> 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.
    RenderingAttachmentInfoKHR -> 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.
    RenderingAttachmentInfoKHR -> 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'.
    RenderingAttachmentInfoKHR -> ClearValue
clearValue :: ClearValue
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (RenderingAttachmentInfoKHR)
#endif
deriving instance Show RenderingAttachmentInfoKHR

instance ToCStruct RenderingAttachmentInfoKHR where
  withCStruct :: RenderingAttachmentInfoKHR
-> (Ptr RenderingAttachmentInfoKHR -> IO b) -> IO b
withCStruct RenderingAttachmentInfoKHR
x Ptr RenderingAttachmentInfoKHR -> IO b
f = Int -> (Ptr RenderingAttachmentInfoKHR -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
72 ((Ptr RenderingAttachmentInfoKHR -> IO b) -> IO b)
-> (Ptr RenderingAttachmentInfoKHR -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr RenderingAttachmentInfoKHR
p -> Ptr RenderingAttachmentInfoKHR
-> RenderingAttachmentInfoKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr RenderingAttachmentInfoKHR
p RenderingAttachmentInfoKHR
x (Ptr RenderingAttachmentInfoKHR -> IO b
f Ptr RenderingAttachmentInfoKHR
p)
  pokeCStruct :: Ptr RenderingAttachmentInfoKHR
-> RenderingAttachmentInfoKHR -> IO b -> IO b
pokeCStruct Ptr RenderingAttachmentInfoKHR
p RenderingAttachmentInfoKHR{ImageLayout
ImageView
ResolveModeFlagBits
AttachmentStoreOp
AttachmentLoadOp
ClearValue
clearValue :: ClearValue
storeOp :: AttachmentStoreOp
loadOp :: AttachmentLoadOp
resolveImageLayout :: ImageLayout
resolveImageView :: ImageView
resolveMode :: ResolveModeFlagBits
imageLayout :: ImageLayout
imageView :: ImageView
$sel:clearValue:RenderingAttachmentInfoKHR :: RenderingAttachmentInfoKHR -> ClearValue
$sel:storeOp:RenderingAttachmentInfoKHR :: RenderingAttachmentInfoKHR -> AttachmentStoreOp
$sel:loadOp:RenderingAttachmentInfoKHR :: RenderingAttachmentInfoKHR -> AttachmentLoadOp
$sel:resolveImageLayout:RenderingAttachmentInfoKHR :: RenderingAttachmentInfoKHR -> ImageLayout
$sel:resolveImageView:RenderingAttachmentInfoKHR :: RenderingAttachmentInfoKHR -> ImageView
$sel:resolveMode:RenderingAttachmentInfoKHR :: RenderingAttachmentInfoKHR -> ResolveModeFlagBits
$sel:imageLayout:RenderingAttachmentInfoKHR :: RenderingAttachmentInfoKHR -> ImageLayout
$sel:imageView:RenderingAttachmentInfoKHR :: RenderingAttachmentInfoKHR -> 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 RenderingAttachmentInfoKHR
p Ptr RenderingAttachmentInfoKHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_RENDERING_ATTACHMENT_INFO_KHR)
    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 RenderingAttachmentInfoKHR
p Ptr RenderingAttachmentInfoKHR -> 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 RenderingAttachmentInfoKHR
p Ptr RenderingAttachmentInfoKHR -> 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 RenderingAttachmentInfoKHR
p Ptr RenderingAttachmentInfoKHR -> 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 RenderingAttachmentInfoKHR
p Ptr RenderingAttachmentInfoKHR -> 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 RenderingAttachmentInfoKHR
p Ptr RenderingAttachmentInfoKHR -> 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 RenderingAttachmentInfoKHR
p Ptr RenderingAttachmentInfoKHR -> 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 RenderingAttachmentInfoKHR
p Ptr RenderingAttachmentInfoKHR -> 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 RenderingAttachmentInfoKHR
p Ptr RenderingAttachmentInfoKHR -> 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 RenderingAttachmentInfoKHR
p Ptr RenderingAttachmentInfoKHR -> 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 RenderingAttachmentInfoKHR -> IO b -> IO b
pokeZeroCStruct Ptr RenderingAttachmentInfoKHR
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 RenderingAttachmentInfoKHR
p Ptr RenderingAttachmentInfoKHR -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_RENDERING_ATTACHMENT_INFO_KHR)
    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 RenderingAttachmentInfoKHR
p Ptr RenderingAttachmentInfoKHR -> 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 RenderingAttachmentInfoKHR
p Ptr RenderingAttachmentInfoKHR -> 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 RenderingAttachmentInfoKHR
p Ptr RenderingAttachmentInfoKHR -> 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 RenderingAttachmentInfoKHR
p Ptr RenderingAttachmentInfoKHR -> 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 RenderingAttachmentInfoKHR
p Ptr RenderingAttachmentInfoKHR -> 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 RenderingAttachmentInfoKHR
p Ptr RenderingAttachmentInfoKHR -> 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 RenderingAttachmentInfoKHR where
  zero :: RenderingAttachmentInfoKHR
zero = ImageView
-> ImageLayout
-> ResolveModeFlagBits
-> ImageView
-> ImageLayout
-> AttachmentLoadOp
-> AttachmentStoreOp
-> ClearValue
-> RenderingAttachmentInfoKHR
RenderingAttachmentInfoKHR
           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


-- | VkRenderingFragmentShadingRateAttachmentInfoKHR - Structure specifying
-- fragment shading rate attachment information
--
-- = Description
--
-- This structure can be included in the @pNext@ chain of
-- 'RenderingInfoKHR' to define a
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#primsrast-fragment-shading-rate-attachment fragment shading rate attachment>.
-- If @imageView@ is 'Vulkan.Core10.APIConstants.NULL_HANDLE', or if this
-- structure is not specified, the implementation behaves as if a valid
-- shading rate attachment was specified with all texels specifying a
-- single pixel per fragment.
--
-- == Valid Usage
--
-- -   #VUID-VkRenderingFragmentShadingRateAttachmentInfoKHR-imageView-06147#
--     If @imageView@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @layout@ /must/ be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_GENERAL' or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_FRAGMENT_SHADING_RATE_ATTACHMENT_OPTIMAL_KHR'
--
-- -   #VUID-VkRenderingFragmentShadingRateAttachmentInfoKHR-imageView-06148#
--     If @imageView@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE', it
--     /must/ have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_FRAGMENT_SHADING_RATE_ATTACHMENT_BIT_KHR'
--
-- -   #VUID-VkRenderingFragmentShadingRateAttachmentInfoKHR-imageView-06149#
--     If @imageView@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @shadingRateAttachmentTexelSize.width@ /must/ be a power of two
--     value
--
-- -   #VUID-VkRenderingFragmentShadingRateAttachmentInfoKHR-imageView-06150#
--     If @imageView@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @shadingRateAttachmentTexelSize.width@ /must/ be less than or equal
--     to
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-maxFragmentShadingRateAttachmentTexelSize maxFragmentShadingRateAttachmentTexelSize.width>
--
-- -   #VUID-VkRenderingFragmentShadingRateAttachmentInfoKHR-imageView-06151#
--     If @imageView@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @shadingRateAttachmentTexelSize.width@ /must/ be greater than or
--     equal to
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-minFragmentShadingRateAttachmentTexelSize minFragmentShadingRateAttachmentTexelSize.width>
--
-- -   #VUID-VkRenderingFragmentShadingRateAttachmentInfoKHR-imageView-06152#
--     If @imageView@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @shadingRateAttachmentTexelSize.height@ /must/ be a power of two
--     value
--
-- -   #VUID-VkRenderingFragmentShadingRateAttachmentInfoKHR-imageView-06153#
--     If @imageView@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @shadingRateAttachmentTexelSize.height@ /must/ be less than or equal
--     to
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-maxFragmentShadingRateAttachmentTexelSize maxFragmentShadingRateAttachmentTexelSize.height>
--
-- -   #VUID-VkRenderingFragmentShadingRateAttachmentInfoKHR-imageView-06154#
--     If @imageView@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @shadingRateAttachmentTexelSize.height@ /must/ be greater than or
--     equal to
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-minFragmentShadingRateAttachmentTexelSize minFragmentShadingRateAttachmentTexelSize.height>
--
-- -   #VUID-VkRenderingFragmentShadingRateAttachmentInfoKHR-imageView-06155#
--     If @imageView@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE', the
--     quotient of @shadingRateAttachmentTexelSize.width@ and
--     @shadingRateAttachmentTexelSize.height@ /must/ be less than or equal
--     to
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-maxFragmentShadingRateAttachmentTexelSizeAspectRatio maxFragmentShadingRateAttachmentTexelSizeAspectRatio>
--
-- -   #VUID-VkRenderingFragmentShadingRateAttachmentInfoKHR-imageView-06156#
--     If @imageView@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE', the
--     quotient of @shadingRateAttachmentTexelSize.height@ and
--     @shadingRateAttachmentTexelSize.width@ /must/ be less than or equal
--     to
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-maxFragmentShadingRateAttachmentTexelSizeAspectRatio maxFragmentShadingRateAttachmentTexelSizeAspectRatio>
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkRenderingFragmentShadingRateAttachmentInfoKHR-sType-sType#
--     @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_RENDERING_FRAGMENT_SHADING_RATE_ATTACHMENT_INFO_KHR'
--
-- -   #VUID-VkRenderingFragmentShadingRateAttachmentInfoKHR-imageView-parameter#
--     If @imageView@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @imageView@ /must/ be a valid 'Vulkan.Core10.Handles.ImageView'
--     handle
--
-- -   #VUID-VkRenderingFragmentShadingRateAttachmentInfoKHR-imageLayout-parameter#
--     @imageLayout@ /must/ be a valid
--     'Vulkan.Core10.Enums.ImageLayout.ImageLayout' 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_KHR_fragment_shading_rate VK_KHR_fragment_shading_rate>,
-- 'Vulkan.Core10.FundamentalTypes.Extent2D',
-- 'Vulkan.Core10.Enums.ImageLayout.ImageLayout',
-- 'Vulkan.Core10.Handles.ImageView',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data RenderingFragmentShadingRateAttachmentInfoKHR = RenderingFragmentShadingRateAttachmentInfoKHR
  { -- | @imageView@ is the image view that will be used as a fragment shading
    -- rate attachment.
    RenderingFragmentShadingRateAttachmentInfoKHR -> ImageView
imageView :: ImageView
  , -- | @imageLayout@ is the layout that @imageView@ will be in during
    -- rendering.
    RenderingFragmentShadingRateAttachmentInfoKHR -> ImageLayout
imageLayout :: ImageLayout
  , -- | @shadingRateAttachmentTexelSize@ specifies the number of pixels
    -- corresponding to each texel in @imageView@.
    RenderingFragmentShadingRateAttachmentInfoKHR -> Extent2D
shadingRateAttachmentTexelSize :: Extent2D
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (RenderingFragmentShadingRateAttachmentInfoKHR)
#endif
deriving instance Show RenderingFragmentShadingRateAttachmentInfoKHR

instance ToCStruct RenderingFragmentShadingRateAttachmentInfoKHR where
  withCStruct :: RenderingFragmentShadingRateAttachmentInfoKHR
-> (Ptr RenderingFragmentShadingRateAttachmentInfoKHR -> IO b)
-> IO b
withCStruct RenderingFragmentShadingRateAttachmentInfoKHR
x Ptr RenderingFragmentShadingRateAttachmentInfoKHR -> IO b
f = Int
-> (Ptr RenderingFragmentShadingRateAttachmentInfoKHR -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 ((Ptr RenderingFragmentShadingRateAttachmentInfoKHR -> IO b)
 -> IO b)
-> (Ptr RenderingFragmentShadingRateAttachmentInfoKHR -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr RenderingFragmentShadingRateAttachmentInfoKHR
p -> Ptr RenderingFragmentShadingRateAttachmentInfoKHR
-> RenderingFragmentShadingRateAttachmentInfoKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr RenderingFragmentShadingRateAttachmentInfoKHR
p RenderingFragmentShadingRateAttachmentInfoKHR
x (Ptr RenderingFragmentShadingRateAttachmentInfoKHR -> IO b
f Ptr RenderingFragmentShadingRateAttachmentInfoKHR
p)
  pokeCStruct :: Ptr RenderingFragmentShadingRateAttachmentInfoKHR
-> RenderingFragmentShadingRateAttachmentInfoKHR -> IO b -> IO b
pokeCStruct Ptr RenderingFragmentShadingRateAttachmentInfoKHR
p RenderingFragmentShadingRateAttachmentInfoKHR{ImageLayout
Extent2D
ImageView
shadingRateAttachmentTexelSize :: Extent2D
imageLayout :: ImageLayout
imageView :: ImageView
$sel:shadingRateAttachmentTexelSize:RenderingFragmentShadingRateAttachmentInfoKHR :: RenderingFragmentShadingRateAttachmentInfoKHR -> Extent2D
$sel:imageLayout:RenderingFragmentShadingRateAttachmentInfoKHR :: RenderingFragmentShadingRateAttachmentInfoKHR -> ImageLayout
$sel:imageView:RenderingFragmentShadingRateAttachmentInfoKHR :: RenderingFragmentShadingRateAttachmentInfoKHR -> ImageView
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingFragmentShadingRateAttachmentInfoKHR
p Ptr RenderingFragmentShadingRateAttachmentInfoKHR
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_RENDERING_FRAGMENT_SHADING_RATE_ATTACHMENT_INFO_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingFragmentShadingRateAttachmentInfoKHR
p Ptr RenderingFragmentShadingRateAttachmentInfoKHR
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ImageView -> ImageView -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingFragmentShadingRateAttachmentInfoKHR
p Ptr RenderingFragmentShadingRateAttachmentInfoKHR
-> Int -> Ptr ImageView
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageView)) (ImageView
imageView)
    Ptr ImageLayout -> ImageLayout -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingFragmentShadingRateAttachmentInfoKHR
p Ptr RenderingFragmentShadingRateAttachmentInfoKHR
-> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout)) (ImageLayout
imageLayout)
    Ptr Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingFragmentShadingRateAttachmentInfoKHR
p Ptr RenderingFragmentShadingRateAttachmentInfoKHR
-> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Extent2D)) (Extent2D
shadingRateAttachmentTexelSize)
    IO b
f
  cStructSize :: Int
cStructSize = Int
40
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr RenderingFragmentShadingRateAttachmentInfoKHR -> IO b -> IO b
pokeZeroCStruct Ptr RenderingFragmentShadingRateAttachmentInfoKHR
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingFragmentShadingRateAttachmentInfoKHR
p Ptr RenderingFragmentShadingRateAttachmentInfoKHR
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_RENDERING_FRAGMENT_SHADING_RATE_ATTACHMENT_INFO_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingFragmentShadingRateAttachmentInfoKHR
p Ptr RenderingFragmentShadingRateAttachmentInfoKHR
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ImageLayout -> ImageLayout -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingFragmentShadingRateAttachmentInfoKHR
p Ptr RenderingFragmentShadingRateAttachmentInfoKHR
-> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout)) (ImageLayout
forall a. Zero a => a
zero)
    Ptr Extent2D -> Extent2D -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingFragmentShadingRateAttachmentInfoKHR
p Ptr RenderingFragmentShadingRateAttachmentInfoKHR
-> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Extent2D)) (Extent2D
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct RenderingFragmentShadingRateAttachmentInfoKHR where
  peekCStruct :: Ptr RenderingFragmentShadingRateAttachmentInfoKHR
-> IO RenderingFragmentShadingRateAttachmentInfoKHR
peekCStruct Ptr RenderingFragmentShadingRateAttachmentInfoKHR
p = do
    ImageView
imageView <- Ptr ImageView -> IO ImageView
forall a. Storable a => Ptr a -> IO a
peek @ImageView ((Ptr RenderingFragmentShadingRateAttachmentInfoKHR
p Ptr RenderingFragmentShadingRateAttachmentInfoKHR
-> Int -> Ptr ImageView
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageView))
    ImageLayout
imageLayout <- Ptr ImageLayout -> IO ImageLayout
forall a. Storable a => Ptr a -> IO a
peek @ImageLayout ((Ptr RenderingFragmentShadingRateAttachmentInfoKHR
p Ptr RenderingFragmentShadingRateAttachmentInfoKHR
-> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout))
    Extent2D
shadingRateAttachmentTexelSize <- Ptr Extent2D -> IO Extent2D
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent2D ((Ptr RenderingFragmentShadingRateAttachmentInfoKHR
p Ptr RenderingFragmentShadingRateAttachmentInfoKHR
-> Int -> Ptr Extent2D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Extent2D))
    RenderingFragmentShadingRateAttachmentInfoKHR
-> IO RenderingFragmentShadingRateAttachmentInfoKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RenderingFragmentShadingRateAttachmentInfoKHR
 -> IO RenderingFragmentShadingRateAttachmentInfoKHR)
-> RenderingFragmentShadingRateAttachmentInfoKHR
-> IO RenderingFragmentShadingRateAttachmentInfoKHR
forall a b. (a -> b) -> a -> b
$ ImageView
-> ImageLayout
-> Extent2D
-> RenderingFragmentShadingRateAttachmentInfoKHR
RenderingFragmentShadingRateAttachmentInfoKHR
             ImageView
imageView ImageLayout
imageLayout Extent2D
shadingRateAttachmentTexelSize

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

instance Zero RenderingFragmentShadingRateAttachmentInfoKHR where
  zero :: RenderingFragmentShadingRateAttachmentInfoKHR
zero = ImageView
-> ImageLayout
-> Extent2D
-> RenderingFragmentShadingRateAttachmentInfoKHR
RenderingFragmentShadingRateAttachmentInfoKHR
           ImageView
forall a. Zero a => a
zero
           ImageLayout
forall a. Zero a => a
zero
           Extent2D
forall a. Zero a => a
zero


-- | VkRenderingFragmentDensityMapAttachmentInfoEXT - Structure specifying
-- fragment shading rate attachment information
--
-- = Description
--
-- This structure can be included in the @pNext@ chain of
-- 'RenderingInfoKHR' to define a fragment density map. If @imageView@ is
-- 'Vulkan.Core10.APIConstants.NULL_HANDLE', or if this structure is not
-- specified, @imageView@ is 'Vulkan.Core10.APIConstants.NULL_HANDLE'.
--
-- == Valid Usage
--
-- -   #VUID-VkRenderingFragmentDensityMapAttachmentInfoEXT-imageView-06157#
--     If @imageView@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE',
--     @layout@ /must/ be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_GENERAL' or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_FRAGMENT_DENSITY_MAP_OPTIMAL_EXT'
--
-- -   #VUID-VkRenderingFragmentDensityMapAttachmentInfoEXT-imageView-06158#
--     If @imageView@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE', it
--     /must/ have been created with
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_FRAGMENT_DENSITY_MAP_BIT_EXT'
--
-- -   #VUID-VkRenderingFragmentDensityMapAttachmentInfoEXT-imageView-06159#
--     If @imageView@ is not 'Vulkan.Core10.APIConstants.NULL_HANDLE', it
--     /must/ not have been created with
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SUBSAMPLED_BIT_EXT'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkRenderingFragmentDensityMapAttachmentInfoEXT-sType-sType#
--     @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_RENDERING_FRAGMENT_DENSITY_MAP_ATTACHMENT_INFO_EXT'
--
-- -   #VUID-VkRenderingFragmentDensityMapAttachmentInfoEXT-imageView-parameter#
--     @imageView@ /must/ be a valid 'Vulkan.Core10.Handles.ImageView'
--     handle
--
-- -   #VUID-VkRenderingFragmentDensityMapAttachmentInfoEXT-imageLayout-parameter#
--     @imageLayout@ /must/ be a valid
--     'Vulkan.Core10.Enums.ImageLayout.ImageLayout' value
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_fragment_density_map VK_EXT_fragment_density_map>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_dynamic_rendering VK_KHR_dynamic_rendering>,
-- 'Vulkan.Core10.Enums.ImageLayout.ImageLayout',
-- 'Vulkan.Core10.Handles.ImageView',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data RenderingFragmentDensityMapAttachmentInfoEXT = RenderingFragmentDensityMapAttachmentInfoEXT
  { -- | @imageView@ is the image view that will be used as a fragment shading
    -- rate attachment.
    RenderingFragmentDensityMapAttachmentInfoEXT -> ImageView
imageView :: ImageView
  , -- | @imageLayout@ is the layout that @imageView@ will be in during
    -- rendering.
    RenderingFragmentDensityMapAttachmentInfoEXT -> ImageLayout
imageLayout :: ImageLayout
  }
  deriving (Typeable, RenderingFragmentDensityMapAttachmentInfoEXT
-> RenderingFragmentDensityMapAttachmentInfoEXT -> Bool
(RenderingFragmentDensityMapAttachmentInfoEXT
 -> RenderingFragmentDensityMapAttachmentInfoEXT -> Bool)
-> (RenderingFragmentDensityMapAttachmentInfoEXT
    -> RenderingFragmentDensityMapAttachmentInfoEXT -> Bool)
-> Eq RenderingFragmentDensityMapAttachmentInfoEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderingFragmentDensityMapAttachmentInfoEXT
-> RenderingFragmentDensityMapAttachmentInfoEXT -> Bool
$c/= :: RenderingFragmentDensityMapAttachmentInfoEXT
-> RenderingFragmentDensityMapAttachmentInfoEXT -> Bool
== :: RenderingFragmentDensityMapAttachmentInfoEXT
-> RenderingFragmentDensityMapAttachmentInfoEXT -> Bool
$c== :: RenderingFragmentDensityMapAttachmentInfoEXT
-> RenderingFragmentDensityMapAttachmentInfoEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (RenderingFragmentDensityMapAttachmentInfoEXT)
#endif
deriving instance Show RenderingFragmentDensityMapAttachmentInfoEXT

instance ToCStruct RenderingFragmentDensityMapAttachmentInfoEXT where
  withCStruct :: RenderingFragmentDensityMapAttachmentInfoEXT
-> (Ptr RenderingFragmentDensityMapAttachmentInfoEXT -> IO b)
-> IO b
withCStruct RenderingFragmentDensityMapAttachmentInfoEXT
x Ptr RenderingFragmentDensityMapAttachmentInfoEXT -> IO b
f = Int
-> (Ptr RenderingFragmentDensityMapAttachmentInfoEXT -> IO b)
-> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr RenderingFragmentDensityMapAttachmentInfoEXT -> IO b)
 -> IO b)
-> (Ptr RenderingFragmentDensityMapAttachmentInfoEXT -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr RenderingFragmentDensityMapAttachmentInfoEXT
p -> Ptr RenderingFragmentDensityMapAttachmentInfoEXT
-> RenderingFragmentDensityMapAttachmentInfoEXT -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr RenderingFragmentDensityMapAttachmentInfoEXT
p RenderingFragmentDensityMapAttachmentInfoEXT
x (Ptr RenderingFragmentDensityMapAttachmentInfoEXT -> IO b
f Ptr RenderingFragmentDensityMapAttachmentInfoEXT
p)
  pokeCStruct :: Ptr RenderingFragmentDensityMapAttachmentInfoEXT
-> RenderingFragmentDensityMapAttachmentInfoEXT -> IO b -> IO b
pokeCStruct Ptr RenderingFragmentDensityMapAttachmentInfoEXT
p RenderingFragmentDensityMapAttachmentInfoEXT{ImageLayout
ImageView
imageLayout :: ImageLayout
imageView :: ImageView
$sel:imageLayout:RenderingFragmentDensityMapAttachmentInfoEXT :: RenderingFragmentDensityMapAttachmentInfoEXT -> ImageLayout
$sel:imageView:RenderingFragmentDensityMapAttachmentInfoEXT :: RenderingFragmentDensityMapAttachmentInfoEXT -> ImageView
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingFragmentDensityMapAttachmentInfoEXT
p Ptr RenderingFragmentDensityMapAttachmentInfoEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_RENDERING_FRAGMENT_DENSITY_MAP_ATTACHMENT_INFO_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingFragmentDensityMapAttachmentInfoEXT
p Ptr RenderingFragmentDensityMapAttachmentInfoEXT
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ImageView -> ImageView -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingFragmentDensityMapAttachmentInfoEXT
p Ptr RenderingFragmentDensityMapAttachmentInfoEXT
-> Int -> Ptr ImageView
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageView)) (ImageView
imageView)
    Ptr ImageLayout -> ImageLayout -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingFragmentDensityMapAttachmentInfoEXT
p Ptr RenderingFragmentDensityMapAttachmentInfoEXT
-> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout)) (ImageLayout
imageLayout)
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr RenderingFragmentDensityMapAttachmentInfoEXT -> IO b -> IO b
pokeZeroCStruct Ptr RenderingFragmentDensityMapAttachmentInfoEXT
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingFragmentDensityMapAttachmentInfoEXT
p Ptr RenderingFragmentDensityMapAttachmentInfoEXT
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_RENDERING_FRAGMENT_DENSITY_MAP_ATTACHMENT_INFO_EXT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingFragmentDensityMapAttachmentInfoEXT
p Ptr RenderingFragmentDensityMapAttachmentInfoEXT
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr ImageView -> ImageView -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingFragmentDensityMapAttachmentInfoEXT
p Ptr RenderingFragmentDensityMapAttachmentInfoEXT
-> Int -> Ptr ImageView
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageView)) (ImageView
forall a. Zero a => a
zero)
    Ptr ImageLayout -> ImageLayout -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr RenderingFragmentDensityMapAttachmentInfoEXT
p Ptr RenderingFragmentDensityMapAttachmentInfoEXT
-> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout)) (ImageLayout
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct RenderingFragmentDensityMapAttachmentInfoEXT where
  peekCStruct :: Ptr RenderingFragmentDensityMapAttachmentInfoEXT
-> IO RenderingFragmentDensityMapAttachmentInfoEXT
peekCStruct Ptr RenderingFragmentDensityMapAttachmentInfoEXT
p = do
    ImageView
imageView <- Ptr ImageView -> IO ImageView
forall a. Storable a => Ptr a -> IO a
peek @ImageView ((Ptr RenderingFragmentDensityMapAttachmentInfoEXT
p Ptr RenderingFragmentDensityMapAttachmentInfoEXT
-> Int -> Ptr ImageView
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr ImageView))
    ImageLayout
imageLayout <- Ptr ImageLayout -> IO ImageLayout
forall a. Storable a => Ptr a -> IO a
peek @ImageLayout ((Ptr RenderingFragmentDensityMapAttachmentInfoEXT
p Ptr RenderingFragmentDensityMapAttachmentInfoEXT
-> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageLayout))
    RenderingFragmentDensityMapAttachmentInfoEXT
-> IO RenderingFragmentDensityMapAttachmentInfoEXT
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RenderingFragmentDensityMapAttachmentInfoEXT
 -> IO RenderingFragmentDensityMapAttachmentInfoEXT)
-> RenderingFragmentDensityMapAttachmentInfoEXT
-> IO RenderingFragmentDensityMapAttachmentInfoEXT
forall a b. (a -> b) -> a -> b
$ ImageView
-> ImageLayout -> RenderingFragmentDensityMapAttachmentInfoEXT
RenderingFragmentDensityMapAttachmentInfoEXT
             ImageView
imageView ImageLayout
imageLayout

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

instance Zero RenderingFragmentDensityMapAttachmentInfoEXT where
  zero :: RenderingFragmentDensityMapAttachmentInfoEXT
zero = ImageView
-> ImageLayout -> RenderingFragmentDensityMapAttachmentInfoEXT
RenderingFragmentDensityMapAttachmentInfoEXT
           ImageView
forall a. Zero a => a
zero
           ImageLayout
forall a. Zero a => a
zero


-- | VkPhysicalDeviceDynamicRenderingFeaturesKHR - Structure indicating
-- support for dynamic render pass instances
--
-- = Members
--
-- The members of the 'PhysicalDeviceDynamicRenderingFeaturesKHR' structure
-- describe the following features:
--
-- = Description
--
-- If the 'PhysicalDeviceDynamicRenderingFeaturesKHR' 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. 'PhysicalDeviceDynamicRenderingFeaturesKHR' /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>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceDynamicRenderingFeaturesKHR = PhysicalDeviceDynamicRenderingFeaturesKHR
  { -- | #features-dynamicRendering# @dynamicRendering@ specifies that the
    -- implementation supports dynamic render pass instances using the
    -- 'cmdBeginRenderingKHR' command.
    PhysicalDeviceDynamicRenderingFeaturesKHR -> Bool
dynamicRendering :: Bool }
  deriving (Typeable, PhysicalDeviceDynamicRenderingFeaturesKHR
-> PhysicalDeviceDynamicRenderingFeaturesKHR -> Bool
(PhysicalDeviceDynamicRenderingFeaturesKHR
 -> PhysicalDeviceDynamicRenderingFeaturesKHR -> Bool)
-> (PhysicalDeviceDynamicRenderingFeaturesKHR
    -> PhysicalDeviceDynamicRenderingFeaturesKHR -> Bool)
-> Eq PhysicalDeviceDynamicRenderingFeaturesKHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceDynamicRenderingFeaturesKHR
-> PhysicalDeviceDynamicRenderingFeaturesKHR -> Bool
$c/= :: PhysicalDeviceDynamicRenderingFeaturesKHR
-> PhysicalDeviceDynamicRenderingFeaturesKHR -> Bool
== :: PhysicalDeviceDynamicRenderingFeaturesKHR
-> PhysicalDeviceDynamicRenderingFeaturesKHR -> Bool
$c== :: PhysicalDeviceDynamicRenderingFeaturesKHR
-> PhysicalDeviceDynamicRenderingFeaturesKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceDynamicRenderingFeaturesKHR)
#endif
deriving instance Show PhysicalDeviceDynamicRenderingFeaturesKHR

instance ToCStruct PhysicalDeviceDynamicRenderingFeaturesKHR where
  withCStruct :: PhysicalDeviceDynamicRenderingFeaturesKHR
-> (Ptr PhysicalDeviceDynamicRenderingFeaturesKHR -> IO b) -> IO b
withCStruct PhysicalDeviceDynamicRenderingFeaturesKHR
x Ptr PhysicalDeviceDynamicRenderingFeaturesKHR -> IO b
f = Int
-> (Ptr PhysicalDeviceDynamicRenderingFeaturesKHR -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((Ptr PhysicalDeviceDynamicRenderingFeaturesKHR -> IO b) -> IO b)
-> (Ptr PhysicalDeviceDynamicRenderingFeaturesKHR -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceDynamicRenderingFeaturesKHR
p -> Ptr PhysicalDeviceDynamicRenderingFeaturesKHR
-> PhysicalDeviceDynamicRenderingFeaturesKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceDynamicRenderingFeaturesKHR
p PhysicalDeviceDynamicRenderingFeaturesKHR
x (Ptr PhysicalDeviceDynamicRenderingFeaturesKHR -> IO b
f Ptr PhysicalDeviceDynamicRenderingFeaturesKHR
p)
  pokeCStruct :: Ptr PhysicalDeviceDynamicRenderingFeaturesKHR
-> PhysicalDeviceDynamicRenderingFeaturesKHR -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceDynamicRenderingFeaturesKHR
p PhysicalDeviceDynamicRenderingFeaturesKHR{Bool
dynamicRendering :: Bool
$sel:dynamicRendering:PhysicalDeviceDynamicRenderingFeaturesKHR :: PhysicalDeviceDynamicRenderingFeaturesKHR -> Bool
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDynamicRenderingFeaturesKHR
p Ptr PhysicalDeviceDynamicRenderingFeaturesKHR
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_DYNAMIC_RENDERING_FEATURES_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDynamicRenderingFeaturesKHR
p Ptr PhysicalDeviceDynamicRenderingFeaturesKHR
-> 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 PhysicalDeviceDynamicRenderingFeaturesKHR
p Ptr PhysicalDeviceDynamicRenderingFeaturesKHR -> 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 PhysicalDeviceDynamicRenderingFeaturesKHR -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceDynamicRenderingFeaturesKHR
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDynamicRenderingFeaturesKHR
p Ptr PhysicalDeviceDynamicRenderingFeaturesKHR
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_DYNAMIC_RENDERING_FEATURES_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceDynamicRenderingFeaturesKHR
p Ptr PhysicalDeviceDynamicRenderingFeaturesKHR
-> 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 PhysicalDeviceDynamicRenderingFeaturesKHR
p Ptr PhysicalDeviceDynamicRenderingFeaturesKHR -> 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 PhysicalDeviceDynamicRenderingFeaturesKHR where
  peekCStruct :: Ptr PhysicalDeviceDynamicRenderingFeaturesKHR
-> IO PhysicalDeviceDynamicRenderingFeaturesKHR
peekCStruct Ptr PhysicalDeviceDynamicRenderingFeaturesKHR
p = do
    Bool32
dynamicRendering <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceDynamicRenderingFeaturesKHR
p Ptr PhysicalDeviceDynamicRenderingFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
    PhysicalDeviceDynamicRenderingFeaturesKHR
-> IO PhysicalDeviceDynamicRenderingFeaturesKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceDynamicRenderingFeaturesKHR
 -> IO PhysicalDeviceDynamicRenderingFeaturesKHR)
-> PhysicalDeviceDynamicRenderingFeaturesKHR
-> IO PhysicalDeviceDynamicRenderingFeaturesKHR
forall a b. (a -> b) -> a -> b
$ Bool -> PhysicalDeviceDynamicRenderingFeaturesKHR
PhysicalDeviceDynamicRenderingFeaturesKHR
             (Bool32 -> Bool
bool32ToBool Bool32
dynamicRendering)

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

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


-- | VkCommandBufferInheritanceRenderingInfoKHR - Structure specifying
-- command buffer inheritance info for dynamic render pass instances
--
-- = Description
--
-- If the @pNext@ chain of
-- 'Vulkan.Core10.CommandBuffer.CommandBufferInheritanceInfo' includes a
-- 'CommandBufferInheritanceRenderingInfoKHR' 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.2-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-VkCommandBufferInheritanceRenderingInfoKHR-colorAttachmentCount-06004#
--     If @colorAttachmentCount@ is not @0@, @rasterizationSamples@ /must/
--     be a valid
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits' value
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfoKHR-variableMultisampleRate-06005#
--     If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-variableMultisampleRate variableMultisampleRate>
--     feature is not enabled, @rasterizationSamples@ /must/ be a valid
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits' value
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfoKHR-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.2-extensions/html/vkspec.html#potential-format-features potential format features>
--     that include
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_COLOR_ATTACHMENT_BIT'
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfoKHR-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.2-extensions/html/vkspec.html#potential-format-features potential format features>
--     that include
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_DEPTH_STENCIL_ATTACHMENT_BIT'
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfoKHR-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.2-extensions/html/vkspec.html#potential-format-features potential format features>
--     that include
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_DEPTH_STENCIL_ATTACHMENT_BIT'
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfoKHR-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-VkCommandBufferInheritanceRenderingInfoKHR-multiview-06008# If
--     the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-multiview multiview>
--     feature is not enabled, @viewMask@ /must/ be @0@
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfoKHR-viewMask-06009# The
--     index of the most significant bit in @viewMask@ /must/ be less than
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-maxMultiviewViewCount maxMultiviewViewCount>
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfoKHR-sType-sType#
--     @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_COMMAND_BUFFER_INHERITANCE_RENDERING_INFO_KHR'
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfoKHR-flags-parameter#
--     @flags@ /must/ be a valid combination of 'RenderingFlagBitsKHR'
--     values
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfoKHR-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-VkCommandBufferInheritanceRenderingInfoKHR-depthAttachmentFormat-parameter#
--     @depthAttachmentFormat@ /must/ be a valid
--     'Vulkan.Core10.Enums.Format.Format' value
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfoKHR-stencilAttachmentFormat-parameter#
--     @stencilAttachmentFormat@ /must/ be a valid
--     'Vulkan.Core10.Enums.Format.Format' value
--
-- -   #VUID-VkCommandBufferInheritanceRenderingInfoKHR-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>,
-- 'Vulkan.Core10.Enums.Format.Format', 'RenderingFlagsKHR',
-- 'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data CommandBufferInheritanceRenderingInfoKHR = CommandBufferInheritanceRenderingInfoKHR
  { -- | @flags@ is a bitmask of 'RenderingFlagBitsKHR' used by the render pass
    -- instance.
    CommandBufferInheritanceRenderingInfoKHR -> RenderingFlagsKHR
flags :: RenderingFlagsKHR
  , -- | @viewMask@ is the view mask used for rendering.
    CommandBufferInheritanceRenderingInfoKHR -> Word32
viewMask :: Word32
  , -- | @pColorAttachmentFormats@ is a pointer to an array of
    -- 'Vulkan.Core10.Enums.Format.Format' values defining the format of color
    -- attachments.
    CommandBufferInheritanceRenderingInfoKHR -> Vector Format
colorAttachmentFormats :: Vector Format
  , -- | @depthAttachmentFormat@ is a 'Vulkan.Core10.Enums.Format.Format' value
    -- defining the format of the depth attachment.
    CommandBufferInheritanceRenderingInfoKHR -> Format
depthAttachmentFormat :: Format
  , -- | @stencilAttachmentFormat@ is a 'Vulkan.Core10.Enums.Format.Format' value
    -- defining the format of the stencil attachment.
    CommandBufferInheritanceRenderingInfoKHR -> Format
stencilAttachmentFormat :: Format
  , -- | @rasterizationSamples@ is a
    -- 'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits' specifying
    -- the number of samples used in rasterization.
    CommandBufferInheritanceRenderingInfoKHR -> SampleCountFlagBits
rasterizationSamples :: SampleCountFlagBits
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CommandBufferInheritanceRenderingInfoKHR)
#endif
deriving instance Show CommandBufferInheritanceRenderingInfoKHR

instance ToCStruct CommandBufferInheritanceRenderingInfoKHR where
  withCStruct :: CommandBufferInheritanceRenderingInfoKHR
-> (Ptr CommandBufferInheritanceRenderingInfoKHR -> IO b) -> IO b
withCStruct CommandBufferInheritanceRenderingInfoKHR
x Ptr CommandBufferInheritanceRenderingInfoKHR -> IO b
f = Int
-> (Ptr CommandBufferInheritanceRenderingInfoKHR -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
56 ((Ptr CommandBufferInheritanceRenderingInfoKHR -> IO b) -> IO b)
-> (Ptr CommandBufferInheritanceRenderingInfoKHR -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr CommandBufferInheritanceRenderingInfoKHR
p -> Ptr CommandBufferInheritanceRenderingInfoKHR
-> CommandBufferInheritanceRenderingInfoKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr CommandBufferInheritanceRenderingInfoKHR
p CommandBufferInheritanceRenderingInfoKHR
x (Ptr CommandBufferInheritanceRenderingInfoKHR -> IO b
f Ptr CommandBufferInheritanceRenderingInfoKHR
p)
  pokeCStruct :: Ptr CommandBufferInheritanceRenderingInfoKHR
-> CommandBufferInheritanceRenderingInfoKHR -> IO b -> IO b
pokeCStruct Ptr CommandBufferInheritanceRenderingInfoKHR
p CommandBufferInheritanceRenderingInfoKHR{Word32
Vector Format
Format
SampleCountFlagBits
RenderingFlagsKHR
rasterizationSamples :: SampleCountFlagBits
stencilAttachmentFormat :: Format
depthAttachmentFormat :: Format
colorAttachmentFormats :: Vector Format
viewMask :: Word32
flags :: RenderingFlagsKHR
$sel:rasterizationSamples:CommandBufferInheritanceRenderingInfoKHR :: CommandBufferInheritanceRenderingInfoKHR -> SampleCountFlagBits
$sel:stencilAttachmentFormat:CommandBufferInheritanceRenderingInfoKHR :: CommandBufferInheritanceRenderingInfoKHR -> Format
$sel:depthAttachmentFormat:CommandBufferInheritanceRenderingInfoKHR :: CommandBufferInheritanceRenderingInfoKHR -> Format
$sel:colorAttachmentFormats:CommandBufferInheritanceRenderingInfoKHR :: CommandBufferInheritanceRenderingInfoKHR -> Vector Format
$sel:viewMask:CommandBufferInheritanceRenderingInfoKHR :: CommandBufferInheritanceRenderingInfoKHR -> Word32
$sel:flags:CommandBufferInheritanceRenderingInfoKHR :: CommandBufferInheritanceRenderingInfoKHR -> RenderingFlagsKHR
..} 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 CommandBufferInheritanceRenderingInfoKHR
p Ptr CommandBufferInheritanceRenderingInfoKHR
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COMMAND_BUFFER_INHERITANCE_RENDERING_INFO_KHR)
    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 CommandBufferInheritanceRenderingInfoKHR
p Ptr CommandBufferInheritanceRenderingInfoKHR -> 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 RenderingFlagsKHR -> RenderingFlagsKHR -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CommandBufferInheritanceRenderingInfoKHR
p Ptr CommandBufferInheritanceRenderingInfoKHR
-> Int -> Ptr RenderingFlagsKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr RenderingFlagsKHR)) (RenderingFlagsKHR
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 CommandBufferInheritanceRenderingInfoKHR
p Ptr CommandBufferInheritanceRenderingInfoKHR -> 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 CommandBufferInheritanceRenderingInfoKHR
p Ptr CommandBufferInheritanceRenderingInfoKHR -> 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 CommandBufferInheritanceRenderingInfoKHR
p Ptr CommandBufferInheritanceRenderingInfoKHR
-> 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 CommandBufferInheritanceRenderingInfoKHR
p Ptr CommandBufferInheritanceRenderingInfoKHR -> 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 CommandBufferInheritanceRenderingInfoKHR
p Ptr CommandBufferInheritanceRenderingInfoKHR -> 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 CommandBufferInheritanceRenderingInfoKHR
p Ptr CommandBufferInheritanceRenderingInfoKHR
-> 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 CommandBufferInheritanceRenderingInfoKHR -> IO b -> IO b
pokeZeroCStruct Ptr CommandBufferInheritanceRenderingInfoKHR
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CommandBufferInheritanceRenderingInfoKHR
p Ptr CommandBufferInheritanceRenderingInfoKHR
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COMMAND_BUFFER_INHERITANCE_RENDERING_INFO_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CommandBufferInheritanceRenderingInfoKHR
p Ptr CommandBufferInheritanceRenderingInfoKHR -> 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 CommandBufferInheritanceRenderingInfoKHR
p Ptr CommandBufferInheritanceRenderingInfoKHR -> 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 CommandBufferInheritanceRenderingInfoKHR
p Ptr CommandBufferInheritanceRenderingInfoKHR -> 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 CommandBufferInheritanceRenderingInfoKHR
p Ptr CommandBufferInheritanceRenderingInfoKHR -> 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 CommandBufferInheritanceRenderingInfoKHR where
  peekCStruct :: Ptr CommandBufferInheritanceRenderingInfoKHR
-> IO CommandBufferInheritanceRenderingInfoKHR
peekCStruct Ptr CommandBufferInheritanceRenderingInfoKHR
p = do
    RenderingFlagsKHR
flags <- Ptr RenderingFlagsKHR -> IO RenderingFlagsKHR
forall a. Storable a => Ptr a -> IO a
peek @RenderingFlagsKHR ((Ptr CommandBufferInheritanceRenderingInfoKHR
p Ptr CommandBufferInheritanceRenderingInfoKHR
-> Int -> Ptr RenderingFlagsKHR
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr RenderingFlagsKHR))
    Word32
viewMask <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr CommandBufferInheritanceRenderingInfoKHR
p Ptr CommandBufferInheritanceRenderingInfoKHR -> 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 CommandBufferInheritanceRenderingInfoKHR
p Ptr CommandBufferInheritanceRenderingInfoKHR -> 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 CommandBufferInheritanceRenderingInfoKHR
p Ptr CommandBufferInheritanceRenderingInfoKHR
-> 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 CommandBufferInheritanceRenderingInfoKHR
p Ptr CommandBufferInheritanceRenderingInfoKHR -> 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 CommandBufferInheritanceRenderingInfoKHR
p Ptr CommandBufferInheritanceRenderingInfoKHR -> 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 CommandBufferInheritanceRenderingInfoKHR
p Ptr CommandBufferInheritanceRenderingInfoKHR
-> Int -> Ptr SampleCountFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr SampleCountFlagBits))
    CommandBufferInheritanceRenderingInfoKHR
-> IO CommandBufferInheritanceRenderingInfoKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CommandBufferInheritanceRenderingInfoKHR
 -> IO CommandBufferInheritanceRenderingInfoKHR)
-> CommandBufferInheritanceRenderingInfoKHR
-> IO CommandBufferInheritanceRenderingInfoKHR
forall a b. (a -> b) -> a -> b
$ RenderingFlagsKHR
-> Word32
-> Vector Format
-> Format
-> Format
-> SampleCountFlagBits
-> CommandBufferInheritanceRenderingInfoKHR
CommandBufferInheritanceRenderingInfoKHR
             RenderingFlagsKHR
flags Word32
viewMask Vector Format
pColorAttachmentFormats' Format
depthAttachmentFormat Format
stencilAttachmentFormat SampleCountFlagBits
rasterizationSamples

instance Zero CommandBufferInheritanceRenderingInfoKHR where
  zero :: CommandBufferInheritanceRenderingInfoKHR
zero = RenderingFlagsKHR
-> Word32
-> Vector Format
-> Format
-> Format
-> SampleCountFlagBits
-> CommandBufferInheritanceRenderingInfoKHR
CommandBufferInheritanceRenderingInfoKHR
           RenderingFlagsKHR
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


-- | VkAttachmentSampleCountInfoAMD - Structure specifying command buffer
-- inheritance info for dynamic render pass instances
--
-- = Description
--
-- If
-- 'Vulkan.Core10.CommandBuffer.CommandBufferInheritanceInfo'::@renderPass@
-- is 'Vulkan.Core10.APIConstants.NULL_HANDLE',
-- 'Vulkan.Core10.Enums.CommandBufferUsageFlagBits.COMMAND_BUFFER_USAGE_RENDER_PASS_CONTINUE_BIT'
-- is specified in
-- 'Vulkan.Core10.CommandBuffer.CommandBufferBeginInfo'::@flags@, and the
-- @pNext@ chain of
-- 'Vulkan.Core10.CommandBuffer.CommandBufferInheritanceInfo' includes
-- 'AttachmentSampleCountInfoAMD', then this structure defines the sample
-- counts of each attachment within the render pass instance. If
-- 'AttachmentSampleCountInfoAMD' is not included, the value of
-- 'CommandBufferInheritanceRenderingInfoKHR'::@rasterizationSamples@ is
-- used as the sample count for each attachment. 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.
--
-- 'AttachmentSampleCountInfoAMD' /can/ also be included in the @pNext@
-- chain of 'Vulkan.Core10.Pipeline.GraphicsPipelineCreateInfo'. When a
-- graphics 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 sample count of attachments used for rendering. If this
-- structure is not specified, and the pipeline does not include a
-- 'Vulkan.Core10.Handles.RenderPass', the value of
-- 'Vulkan.Core10.Pipeline.PipelineMultisampleStateCreateInfo'::@rasterizationSamples@
-- is used as the sample count for each attachment. If a graphics pipeline
-- is created with a valid 'Vulkan.Core10.Handles.RenderPass', parameters
-- of this structure are ignored.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkAttachmentSampleCountInfoAMD-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_ATTACHMENT_SAMPLE_COUNT_INFO_AMD'
--
-- -   #VUID-VkAttachmentSampleCountInfoAMD-pColorAttachmentSamples-parameter#
--     @pColorAttachmentSamples@ /must/ be a valid pointer to an array of
--     @colorAttachmentCount@ valid or
--     'Vulkan.Core10.APIConstants.NULL_HANDLE'
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits' values
--
-- -   #VUID-VkAttachmentSampleCountInfoAMD-depthStencilAttachmentSamples-parameter#
--     If @depthStencilAttachmentSamples@ is not @0@,
--     @depthStencilAttachmentSamples@ /must/ be a valid
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits' value
--
-- -   #VUID-VkAttachmentSampleCountInfoAMD-colorAttachmentCount-arraylength#
--     @colorAttachmentCount@ /must/ be greater than @0@
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_AMD_mixed_attachment_samples VK_AMD_mixed_attachment_samples>,
-- <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_NV_framebuffer_mixed_samples VK_NV_framebuffer_mixed_samples>,
-- 'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data AttachmentSampleCountInfoAMD = AttachmentSampleCountInfoAMD
  { -- | @pColorAttachmentSamples@ is a pointer to an array of
    -- 'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits' values
    -- defining the sample count of color attachments.
    AttachmentSampleCountInfoAMD -> Vector SampleCountFlagBits
colorAttachmentSamples :: Vector SampleCountFlagBits
  , -- | @depthStencilAttachmentSamples@ is a
    -- 'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits' value
    -- defining the sample count of a depth\/stencil attachment.
    AttachmentSampleCountInfoAMD -> SampleCountFlagBits
depthStencilAttachmentSamples :: SampleCountFlagBits
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (AttachmentSampleCountInfoAMD)
#endif
deriving instance Show AttachmentSampleCountInfoAMD

instance ToCStruct AttachmentSampleCountInfoAMD where
  withCStruct :: AttachmentSampleCountInfoAMD
-> (Ptr AttachmentSampleCountInfoAMD -> IO b) -> IO b
withCStruct AttachmentSampleCountInfoAMD
x Ptr AttachmentSampleCountInfoAMD -> IO b
f = Int -> (Ptr AttachmentSampleCountInfoAMD -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 ((Ptr AttachmentSampleCountInfoAMD -> IO b) -> IO b)
-> (Ptr AttachmentSampleCountInfoAMD -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr AttachmentSampleCountInfoAMD
p -> Ptr AttachmentSampleCountInfoAMD
-> AttachmentSampleCountInfoAMD -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr AttachmentSampleCountInfoAMD
p AttachmentSampleCountInfoAMD
x (Ptr AttachmentSampleCountInfoAMD -> IO b
f Ptr AttachmentSampleCountInfoAMD
p)
  pokeCStruct :: Ptr AttachmentSampleCountInfoAMD
-> AttachmentSampleCountInfoAMD -> IO b -> IO b
pokeCStruct Ptr AttachmentSampleCountInfoAMD
p AttachmentSampleCountInfoAMD{Vector SampleCountFlagBits
SampleCountFlagBits
depthStencilAttachmentSamples :: SampleCountFlagBits
colorAttachmentSamples :: Vector SampleCountFlagBits
$sel:depthStencilAttachmentSamples:AttachmentSampleCountInfoAMD :: AttachmentSampleCountInfoAMD -> SampleCountFlagBits
$sel:colorAttachmentSamples:AttachmentSampleCountInfoAMD :: AttachmentSampleCountInfoAMD -> Vector SampleCountFlagBits
..} 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 AttachmentSampleCountInfoAMD
p Ptr AttachmentSampleCountInfoAMD -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_ATTACHMENT_SAMPLE_COUNT_INFO_AMD)
    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 AttachmentSampleCountInfoAMD
p Ptr AttachmentSampleCountInfoAMD -> 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 AttachmentSampleCountInfoAMD
p Ptr AttachmentSampleCountInfoAMD -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector SampleCountFlagBits -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector SampleCountFlagBits -> Int)
-> Vector SampleCountFlagBits -> Int
forall a b. (a -> b) -> a -> b
$ (Vector SampleCountFlagBits
colorAttachmentSamples)) :: Word32))
    Ptr SampleCountFlagBits
pPColorAttachmentSamples' <- ((Ptr SampleCountFlagBits -> IO b) -> IO b)
-> ContT b IO (Ptr SampleCountFlagBits)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr SampleCountFlagBits -> IO b) -> IO b)
 -> ContT b IO (Ptr SampleCountFlagBits))
-> ((Ptr SampleCountFlagBits -> IO b) -> IO b)
-> ContT b IO (Ptr SampleCountFlagBits)
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr SampleCountFlagBits -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @SampleCountFlagBits ((Vector SampleCountFlagBits -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector SampleCountFlagBits
colorAttachmentSamples)) 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 -> SampleCountFlagBits -> IO ())
-> Vector SampleCountFlagBits -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i SampleCountFlagBits
e -> Ptr SampleCountFlagBits -> SampleCountFlagBits -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr SampleCountFlagBits
pPColorAttachmentSamples' Ptr SampleCountFlagBits -> Int -> Ptr SampleCountFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SampleCountFlagBits) (SampleCountFlagBits
e)) (Vector SampleCountFlagBits
colorAttachmentSamples)
    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 SampleCountFlagBits) -> Ptr SampleCountFlagBits -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AttachmentSampleCountInfoAMD
p Ptr AttachmentSampleCountInfoAMD
-> Int -> Ptr (Ptr SampleCountFlagBits)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr SampleCountFlagBits))) (Ptr SampleCountFlagBits
pPColorAttachmentSamples')
    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 AttachmentSampleCountInfoAMD
p Ptr AttachmentSampleCountInfoAMD -> Int -> Ptr SampleCountFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr SampleCountFlagBits)) (SampleCountFlagBits
depthStencilAttachmentSamples)
    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 AttachmentSampleCountInfoAMD -> IO b -> IO b
pokeZeroCStruct Ptr AttachmentSampleCountInfoAMD
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AttachmentSampleCountInfoAMD
p Ptr AttachmentSampleCountInfoAMD -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_ATTACHMENT_SAMPLE_COUNT_INFO_AMD)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr AttachmentSampleCountInfoAMD
p Ptr AttachmentSampleCountInfoAMD -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO b
f

instance FromCStruct AttachmentSampleCountInfoAMD where
  peekCStruct :: Ptr AttachmentSampleCountInfoAMD -> IO AttachmentSampleCountInfoAMD
peekCStruct Ptr AttachmentSampleCountInfoAMD
p = do
    Word32
colorAttachmentCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr AttachmentSampleCountInfoAMD
p Ptr AttachmentSampleCountInfoAMD -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    Ptr SampleCountFlagBits
pColorAttachmentSamples <- Ptr (Ptr SampleCountFlagBits) -> IO (Ptr SampleCountFlagBits)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr SampleCountFlagBits) ((Ptr AttachmentSampleCountInfoAMD
p Ptr AttachmentSampleCountInfoAMD
-> Int -> Ptr (Ptr SampleCountFlagBits)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr SampleCountFlagBits)))
    Vector SampleCountFlagBits
pColorAttachmentSamples' <- Int
-> (Int -> IO SampleCountFlagBits)
-> IO (Vector SampleCountFlagBits)
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 SampleCountFlagBits -> IO SampleCountFlagBits
forall a. Storable a => Ptr a -> IO a
peek @SampleCountFlagBits ((Ptr SampleCountFlagBits
pColorAttachmentSamples Ptr SampleCountFlagBits -> Int -> Ptr SampleCountFlagBits
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr SampleCountFlagBits)))
    SampleCountFlagBits
depthStencilAttachmentSamples <- Ptr SampleCountFlagBits -> IO SampleCountFlagBits
forall a. Storable a => Ptr a -> IO a
peek @SampleCountFlagBits ((Ptr AttachmentSampleCountInfoAMD
p Ptr AttachmentSampleCountInfoAMD -> Int -> Ptr SampleCountFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr SampleCountFlagBits))
    AttachmentSampleCountInfoAMD -> IO AttachmentSampleCountInfoAMD
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AttachmentSampleCountInfoAMD -> IO AttachmentSampleCountInfoAMD)
-> AttachmentSampleCountInfoAMD -> IO AttachmentSampleCountInfoAMD
forall a b. (a -> b) -> a -> b
$ Vector SampleCountFlagBits
-> SampleCountFlagBits -> AttachmentSampleCountInfoAMD
AttachmentSampleCountInfoAMD
             Vector SampleCountFlagBits
pColorAttachmentSamples' SampleCountFlagBits
depthStencilAttachmentSamples

instance Zero AttachmentSampleCountInfoAMD where
  zero :: AttachmentSampleCountInfoAMD
zero = Vector SampleCountFlagBits
-> SampleCountFlagBits -> AttachmentSampleCountInfoAMD
AttachmentSampleCountInfoAMD
           Vector SampleCountFlagBits
forall a. Monoid a => a
mempty
           SampleCountFlagBits
forall a. Zero a => a
zero


-- | VkMultiviewPerViewAttributesInfoNVX - Structure specifying the multiview
-- per-attribute properties
--
-- = Description
--
-- When dynamic render pass instances are being used, instead of specifying
-- 'Vulkan.Core10.Enums.SubpassDescriptionFlagBits.SUBPASS_DESCRIPTION_PER_VIEW_ATTRIBUTES_BIT_NVX'
-- or
-- 'Vulkan.Core10.Enums.SubpassDescriptionFlagBits.SUBPASS_DESCRIPTION_PER_VIEW_POSITION_X_ONLY_BIT_NVX'
-- in the subpass description flags, the per-attibute properties of the
-- render pass instance /must/ be specified by the
-- 'MultiviewPerViewAttributesInfoNVX' structure Include the
-- 'MultiviewPerViewAttributesInfoNVX' structure in the @pNext@ chain of
-- 'Vulkan.Core10.Pipeline.GraphicsPipelineCreateInfo' when creating a
-- graphics pipeline for dynamic rendering, 'RenderingInfoKHR' when
-- starting a dynamic render pass instance, and
-- 'Vulkan.Core10.CommandBuffer.CommandBufferInheritanceInfo' when
-- specifying the dynamic render pass instance parameters for secondary
-- command buffers.
--
-- == Valid Usage
--
-- -   #VUID-VkMultiviewPerViewAttributesInfoNVX-perViewAttributesPositionXOnly-06163#
--     If @perViewAttributesPositionXOnly@ is
--     'Vulkan.Core10.FundamentalTypes.TRUE' then @perViewAttributes@
--     /must/ also be 'Vulkan.Core10.FundamentalTypes.TRUE'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkMultiviewPerViewAttributesInfoNVX-sType-sType# @sType@
--     /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_MULTIVIEW_PER_VIEW_ATTRIBUTES_INFO_NVX'
--
-- = 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_NVX_multiview_per_view_attributes VK_NVX_multiview_per_view_attributes>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data MultiviewPerViewAttributesInfoNVX = MultiviewPerViewAttributesInfoNVX
  { -- | @perViewAttributes@ specifies that shaders compiled for this pipeline
    -- write the attributes for all views in a single invocation of each vertex
    -- processing stage. All pipelines executed within a render pass instance
    -- that includes this bit /must/ write per-view attributes to the
    -- @*PerViewNV[]@ shader outputs, in addition to the non-per-view (e.g.
    -- @Position@) outputs.
    MultiviewPerViewAttributesInfoNVX -> Bool
perViewAttributes :: Bool
  , -- | @perViewAttributesPositionXOnly@ specifies that shaders compiled for
    -- this pipeline use per-view positions which only differ in value in the x
    -- component. Per-view viewport mask /can/ also be used.
    MultiviewPerViewAttributesInfoNVX -> Bool
perViewAttributesPositionXOnly :: Bool
  }
  deriving (Typeable, MultiviewPerViewAttributesInfoNVX
-> MultiviewPerViewAttributesInfoNVX -> Bool
(MultiviewPerViewAttributesInfoNVX
 -> MultiviewPerViewAttributesInfoNVX -> Bool)
-> (MultiviewPerViewAttributesInfoNVX
    -> MultiviewPerViewAttributesInfoNVX -> Bool)
-> Eq MultiviewPerViewAttributesInfoNVX
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MultiviewPerViewAttributesInfoNVX
-> MultiviewPerViewAttributesInfoNVX -> Bool
$c/= :: MultiviewPerViewAttributesInfoNVX
-> MultiviewPerViewAttributesInfoNVX -> Bool
== :: MultiviewPerViewAttributesInfoNVX
-> MultiviewPerViewAttributesInfoNVX -> Bool
$c== :: MultiviewPerViewAttributesInfoNVX
-> MultiviewPerViewAttributesInfoNVX -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MultiviewPerViewAttributesInfoNVX)
#endif
deriving instance Show MultiviewPerViewAttributesInfoNVX

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

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

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

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


type RenderingFlagsKHR = RenderingFlagBitsKHR

-- | VkRenderingFlagBitsKHR - Bitmask specifying additional properties of a
-- dynamic render pass instance
--
-- = Description
--
-- The contents of @pRenderingInfo@ /must/ match between suspended render
-- pass instances and the render pass instances that resume them, other
-- than the presence or absence of the 'RENDERING_RESUMING_BIT_KHR',
-- 'RENDERING_SUSPENDING_BIT_KHR', and
-- 'RENDERING_CONTENTS_SECONDARY_COMMAND_BUFFERS_BIT_KHR' flags. No action
-- or synchronization commands, or other render pass instances, are allowed
-- between suspending and resuming render pass instances.
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_dynamic_rendering VK_KHR_dynamic_rendering>,
-- 'RenderingFlagsKHR'
newtype RenderingFlagBitsKHR = RenderingFlagBitsKHR Flags
  deriving newtype (RenderingFlagsKHR -> RenderingFlagsKHR -> Bool
(RenderingFlagsKHR -> RenderingFlagsKHR -> Bool)
-> (RenderingFlagsKHR -> RenderingFlagsKHR -> Bool)
-> Eq RenderingFlagsKHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderingFlagsKHR -> RenderingFlagsKHR -> Bool
$c/= :: RenderingFlagsKHR -> RenderingFlagsKHR -> Bool
== :: RenderingFlagsKHR -> RenderingFlagsKHR -> Bool
$c== :: RenderingFlagsKHR -> RenderingFlagsKHR -> Bool
Eq, Eq RenderingFlagsKHR
Eq RenderingFlagsKHR
-> (RenderingFlagsKHR -> RenderingFlagsKHR -> Ordering)
-> (RenderingFlagsKHR -> RenderingFlagsKHR -> Bool)
-> (RenderingFlagsKHR -> RenderingFlagsKHR -> Bool)
-> (RenderingFlagsKHR -> RenderingFlagsKHR -> Bool)
-> (RenderingFlagsKHR -> RenderingFlagsKHR -> Bool)
-> (RenderingFlagsKHR -> RenderingFlagsKHR -> RenderingFlagsKHR)
-> (RenderingFlagsKHR -> RenderingFlagsKHR -> RenderingFlagsKHR)
-> Ord RenderingFlagsKHR
RenderingFlagsKHR -> RenderingFlagsKHR -> Bool
RenderingFlagsKHR -> RenderingFlagsKHR -> Ordering
RenderingFlagsKHR -> RenderingFlagsKHR -> RenderingFlagsKHR
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RenderingFlagsKHR -> RenderingFlagsKHR -> RenderingFlagsKHR
$cmin :: RenderingFlagsKHR -> RenderingFlagsKHR -> RenderingFlagsKHR
max :: RenderingFlagsKHR -> RenderingFlagsKHR -> RenderingFlagsKHR
$cmax :: RenderingFlagsKHR -> RenderingFlagsKHR -> RenderingFlagsKHR
>= :: RenderingFlagsKHR -> RenderingFlagsKHR -> Bool
$c>= :: RenderingFlagsKHR -> RenderingFlagsKHR -> Bool
> :: RenderingFlagsKHR -> RenderingFlagsKHR -> Bool
$c> :: RenderingFlagsKHR -> RenderingFlagsKHR -> Bool
<= :: RenderingFlagsKHR -> RenderingFlagsKHR -> Bool
$c<= :: RenderingFlagsKHR -> RenderingFlagsKHR -> Bool
< :: RenderingFlagsKHR -> RenderingFlagsKHR -> Bool
$c< :: RenderingFlagsKHR -> RenderingFlagsKHR -> Bool
compare :: RenderingFlagsKHR -> RenderingFlagsKHR -> Ordering
$ccompare :: RenderingFlagsKHR -> RenderingFlagsKHR -> Ordering
$cp1Ord :: Eq RenderingFlagsKHR
Ord, Ptr b -> Int -> IO RenderingFlagsKHR
Ptr b -> Int -> RenderingFlagsKHR -> IO ()
Ptr RenderingFlagsKHR -> IO RenderingFlagsKHR
Ptr RenderingFlagsKHR -> Int -> IO RenderingFlagsKHR
Ptr RenderingFlagsKHR -> Int -> RenderingFlagsKHR -> IO ()
Ptr RenderingFlagsKHR -> RenderingFlagsKHR -> IO ()
RenderingFlagsKHR -> Int
(RenderingFlagsKHR -> Int)
-> (RenderingFlagsKHR -> Int)
-> (Ptr RenderingFlagsKHR -> Int -> IO RenderingFlagsKHR)
-> (Ptr RenderingFlagsKHR -> Int -> RenderingFlagsKHR -> IO ())
-> (forall b. Ptr b -> Int -> IO RenderingFlagsKHR)
-> (forall b. Ptr b -> Int -> RenderingFlagsKHR -> IO ())
-> (Ptr RenderingFlagsKHR -> IO RenderingFlagsKHR)
-> (Ptr RenderingFlagsKHR -> RenderingFlagsKHR -> IO ())
-> Storable RenderingFlagsKHR
forall b. Ptr b -> Int -> IO RenderingFlagsKHR
forall b. Ptr b -> Int -> RenderingFlagsKHR -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr RenderingFlagsKHR -> RenderingFlagsKHR -> IO ()
$cpoke :: Ptr RenderingFlagsKHR -> RenderingFlagsKHR -> IO ()
peek :: Ptr RenderingFlagsKHR -> IO RenderingFlagsKHR
$cpeek :: Ptr RenderingFlagsKHR -> IO RenderingFlagsKHR
pokeByteOff :: Ptr b -> Int -> RenderingFlagsKHR -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> RenderingFlagsKHR -> IO ()
peekByteOff :: Ptr b -> Int -> IO RenderingFlagsKHR
$cpeekByteOff :: forall b. Ptr b -> Int -> IO RenderingFlagsKHR
pokeElemOff :: Ptr RenderingFlagsKHR -> Int -> RenderingFlagsKHR -> IO ()
$cpokeElemOff :: Ptr RenderingFlagsKHR -> Int -> RenderingFlagsKHR -> IO ()
peekElemOff :: Ptr RenderingFlagsKHR -> Int -> IO RenderingFlagsKHR
$cpeekElemOff :: Ptr RenderingFlagsKHR -> Int -> IO RenderingFlagsKHR
alignment :: RenderingFlagsKHR -> Int
$calignment :: RenderingFlagsKHR -> Int
sizeOf :: RenderingFlagsKHR -> Int
$csizeOf :: RenderingFlagsKHR -> Int
Storable, RenderingFlagsKHR
RenderingFlagsKHR -> Zero RenderingFlagsKHR
forall a. a -> Zero a
zero :: RenderingFlagsKHR
$czero :: RenderingFlagsKHR
Zero, Eq RenderingFlagsKHR
RenderingFlagsKHR
Eq RenderingFlagsKHR
-> (RenderingFlagsKHR -> RenderingFlagsKHR -> RenderingFlagsKHR)
-> (RenderingFlagsKHR -> RenderingFlagsKHR -> RenderingFlagsKHR)
-> (RenderingFlagsKHR -> RenderingFlagsKHR -> RenderingFlagsKHR)
-> (RenderingFlagsKHR -> RenderingFlagsKHR)
-> (RenderingFlagsKHR -> Int -> RenderingFlagsKHR)
-> (RenderingFlagsKHR -> Int -> RenderingFlagsKHR)
-> RenderingFlagsKHR
-> (Int -> RenderingFlagsKHR)
-> (RenderingFlagsKHR -> Int -> RenderingFlagsKHR)
-> (RenderingFlagsKHR -> Int -> RenderingFlagsKHR)
-> (RenderingFlagsKHR -> Int -> RenderingFlagsKHR)
-> (RenderingFlagsKHR -> Int -> Bool)
-> (RenderingFlagsKHR -> Maybe Int)
-> (RenderingFlagsKHR -> Int)
-> (RenderingFlagsKHR -> Bool)
-> (RenderingFlagsKHR -> Int -> RenderingFlagsKHR)
-> (RenderingFlagsKHR -> Int -> RenderingFlagsKHR)
-> (RenderingFlagsKHR -> Int -> RenderingFlagsKHR)
-> (RenderingFlagsKHR -> Int -> RenderingFlagsKHR)
-> (RenderingFlagsKHR -> Int -> RenderingFlagsKHR)
-> (RenderingFlagsKHR -> Int -> RenderingFlagsKHR)
-> (RenderingFlagsKHR -> Int)
-> Bits RenderingFlagsKHR
Int -> RenderingFlagsKHR
RenderingFlagsKHR -> Bool
RenderingFlagsKHR -> Int
RenderingFlagsKHR -> Maybe Int
RenderingFlagsKHR -> RenderingFlagsKHR
RenderingFlagsKHR -> Int -> Bool
RenderingFlagsKHR -> Int -> RenderingFlagsKHR
RenderingFlagsKHR -> RenderingFlagsKHR -> RenderingFlagsKHR
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: RenderingFlagsKHR -> Int
$cpopCount :: RenderingFlagsKHR -> Int
rotateR :: RenderingFlagsKHR -> Int -> RenderingFlagsKHR
$crotateR :: RenderingFlagsKHR -> Int -> RenderingFlagsKHR
rotateL :: RenderingFlagsKHR -> Int -> RenderingFlagsKHR
$crotateL :: RenderingFlagsKHR -> Int -> RenderingFlagsKHR
unsafeShiftR :: RenderingFlagsKHR -> Int -> RenderingFlagsKHR
$cunsafeShiftR :: RenderingFlagsKHR -> Int -> RenderingFlagsKHR
shiftR :: RenderingFlagsKHR -> Int -> RenderingFlagsKHR
$cshiftR :: RenderingFlagsKHR -> Int -> RenderingFlagsKHR
unsafeShiftL :: RenderingFlagsKHR -> Int -> RenderingFlagsKHR
$cunsafeShiftL :: RenderingFlagsKHR -> Int -> RenderingFlagsKHR
shiftL :: RenderingFlagsKHR -> Int -> RenderingFlagsKHR
$cshiftL :: RenderingFlagsKHR -> Int -> RenderingFlagsKHR
isSigned :: RenderingFlagsKHR -> Bool
$cisSigned :: RenderingFlagsKHR -> Bool
bitSize :: RenderingFlagsKHR -> Int
$cbitSize :: RenderingFlagsKHR -> Int
bitSizeMaybe :: RenderingFlagsKHR -> Maybe Int
$cbitSizeMaybe :: RenderingFlagsKHR -> Maybe Int
testBit :: RenderingFlagsKHR -> Int -> Bool
$ctestBit :: RenderingFlagsKHR -> Int -> Bool
complementBit :: RenderingFlagsKHR -> Int -> RenderingFlagsKHR
$ccomplementBit :: RenderingFlagsKHR -> Int -> RenderingFlagsKHR
clearBit :: RenderingFlagsKHR -> Int -> RenderingFlagsKHR
$cclearBit :: RenderingFlagsKHR -> Int -> RenderingFlagsKHR
setBit :: RenderingFlagsKHR -> Int -> RenderingFlagsKHR
$csetBit :: RenderingFlagsKHR -> Int -> RenderingFlagsKHR
bit :: Int -> RenderingFlagsKHR
$cbit :: Int -> RenderingFlagsKHR
zeroBits :: RenderingFlagsKHR
$czeroBits :: RenderingFlagsKHR
rotate :: RenderingFlagsKHR -> Int -> RenderingFlagsKHR
$crotate :: RenderingFlagsKHR -> Int -> RenderingFlagsKHR
shift :: RenderingFlagsKHR -> Int -> RenderingFlagsKHR
$cshift :: RenderingFlagsKHR -> Int -> RenderingFlagsKHR
complement :: RenderingFlagsKHR -> RenderingFlagsKHR
$ccomplement :: RenderingFlagsKHR -> RenderingFlagsKHR
xor :: RenderingFlagsKHR -> RenderingFlagsKHR -> RenderingFlagsKHR
$cxor :: RenderingFlagsKHR -> RenderingFlagsKHR -> RenderingFlagsKHR
.|. :: RenderingFlagsKHR -> RenderingFlagsKHR -> RenderingFlagsKHR
$c.|. :: RenderingFlagsKHR -> RenderingFlagsKHR -> RenderingFlagsKHR
.&. :: RenderingFlagsKHR -> RenderingFlagsKHR -> RenderingFlagsKHR
$c.&. :: RenderingFlagsKHR -> RenderingFlagsKHR -> RenderingFlagsKHR
$cp1Bits :: Eq RenderingFlagsKHR
Bits, Bits RenderingFlagsKHR
Bits RenderingFlagsKHR
-> (RenderingFlagsKHR -> Int)
-> (RenderingFlagsKHR -> Int)
-> (RenderingFlagsKHR -> Int)
-> FiniteBits RenderingFlagsKHR
RenderingFlagsKHR -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: RenderingFlagsKHR -> Int
$ccountTrailingZeros :: RenderingFlagsKHR -> Int
countLeadingZeros :: RenderingFlagsKHR -> Int
$ccountLeadingZeros :: RenderingFlagsKHR -> Int
finiteBitSize :: RenderingFlagsKHR -> Int
$cfiniteBitSize :: RenderingFlagsKHR -> Int
$cp1FiniteBits :: Bits RenderingFlagsKHR
FiniteBits)

-- | 'RENDERING_CONTENTS_SECONDARY_COMMAND_BUFFERS_BIT_KHR' specifies that
-- draw calls for the render pass instance will be recorded in secondary
-- command buffers.
pattern $bRENDERING_CONTENTS_SECONDARY_COMMAND_BUFFERS_BIT_KHR :: RenderingFlagsKHR
$mRENDERING_CONTENTS_SECONDARY_COMMAND_BUFFERS_BIT_KHR :: forall r. RenderingFlagsKHR -> (Void# -> r) -> (Void# -> r) -> r
RENDERING_CONTENTS_SECONDARY_COMMAND_BUFFERS_BIT_KHR = RenderingFlagBitsKHR 0x00000001
-- | 'RENDERING_SUSPENDING_BIT_KHR' specifies that the render pass instance
-- will be suspended.
pattern $bRENDERING_SUSPENDING_BIT_KHR :: RenderingFlagsKHR
$mRENDERING_SUSPENDING_BIT_KHR :: forall r. RenderingFlagsKHR -> (Void# -> r) -> (Void# -> r) -> r
RENDERING_SUSPENDING_BIT_KHR                         = RenderingFlagBitsKHR 0x00000002
-- | 'RENDERING_RESUMING_BIT_KHR' specifies that the render pass instance is
-- resuming an earlier suspended render pass instance.
pattern $bRENDERING_RESUMING_BIT_KHR :: RenderingFlagsKHR
$mRENDERING_RESUMING_BIT_KHR :: forall r. RenderingFlagsKHR -> (Void# -> r) -> (Void# -> r) -> r
RENDERING_RESUMING_BIT_KHR                           = RenderingFlagBitsKHR 0x00000004

conNameRenderingFlagBitsKHR :: String
conNameRenderingFlagBitsKHR :: String
conNameRenderingFlagBitsKHR = String
"RenderingFlagBitsKHR"

enumPrefixRenderingFlagBitsKHR :: String
enumPrefixRenderingFlagBitsKHR :: String
enumPrefixRenderingFlagBitsKHR = String
"RENDERING_"

showTableRenderingFlagBitsKHR :: [(RenderingFlagBitsKHR, String)]
showTableRenderingFlagBitsKHR :: [(RenderingFlagsKHR, String)]
showTableRenderingFlagBitsKHR =
  [ (RenderingFlagsKHR
RENDERING_CONTENTS_SECONDARY_COMMAND_BUFFERS_BIT_KHR, String
"CONTENTS_SECONDARY_COMMAND_BUFFERS_BIT_KHR")
  , (RenderingFlagsKHR
RENDERING_SUSPENDING_BIT_KHR                        , String
"SUSPENDING_BIT_KHR")
  , (RenderingFlagsKHR
RENDERING_RESUMING_BIT_KHR                          , String
"RESUMING_BIT_KHR")
  ]

instance Show RenderingFlagBitsKHR where
  showsPrec :: Int -> RenderingFlagsKHR -> ShowS
showsPrec = String
-> [(RenderingFlagsKHR, String)]
-> String
-> (RenderingFlagsKHR -> Word32)
-> (Word32 -> ShowS)
-> Int
-> RenderingFlagsKHR
-> ShowS
forall a i.
Eq a =>
String
-> [(a, String)]
-> String
-> (a -> i)
-> (i -> ShowS)
-> Int
-> a
-> ShowS
enumShowsPrec String
enumPrefixRenderingFlagBitsKHR
                            [(RenderingFlagsKHR, String)]
showTableRenderingFlagBitsKHR
                            String
conNameRenderingFlagBitsKHR
                            (\(RenderingFlagBitsKHR Word32
x) -> Word32
x)
                            (\Word32
x -> String -> ShowS
showString String
"0x" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word32
x)

instance Read RenderingFlagBitsKHR where
  readPrec :: ReadPrec RenderingFlagsKHR
readPrec = String
-> [(RenderingFlagsKHR, String)]
-> String
-> (Word32 -> RenderingFlagsKHR)
-> ReadPrec RenderingFlagsKHR
forall i a.
Read i =>
String -> [(a, String)] -> String -> (i -> a) -> ReadPrec a
enumReadPrec String
enumPrefixRenderingFlagBitsKHR
                          [(RenderingFlagsKHR, String)]
showTableRenderingFlagBitsKHR
                          String
conNameRenderingFlagBitsKHR
                          Word32 -> RenderingFlagsKHR
RenderingFlagBitsKHR


-- No documentation found for TopLevel "VkAttachmentSampleCountInfoNV"
type AttachmentSampleCountInfoNV = AttachmentSampleCountInfoAMD


type KHR_DYNAMIC_RENDERING_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_KHR_DYNAMIC_RENDERING_SPEC_VERSION"
pattern KHR_DYNAMIC_RENDERING_SPEC_VERSION :: forall a . Integral a => a
pattern $bKHR_DYNAMIC_RENDERING_SPEC_VERSION :: a
$mKHR_DYNAMIC_RENDERING_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
KHR_DYNAMIC_RENDERING_SPEC_VERSION = 1


type KHR_DYNAMIC_RENDERING_EXTENSION_NAME = "VK_KHR_dynamic_rendering"

-- No documentation found for TopLevel "VK_KHR_DYNAMIC_RENDERING_EXTENSION_NAME"
pattern KHR_DYNAMIC_RENDERING_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bKHR_DYNAMIC_RENDERING_EXTENSION_NAME :: a
$mKHR_DYNAMIC_RENDERING_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
KHR_DYNAMIC_RENDERING_EXTENSION_NAME = "VK_KHR_dynamic_rendering"