{-# language CPP #-}
-- No documentation found for Chapter "Promoted_From_VK_KHR_create_renderpass2"
module Vulkan.Core12.Promoted_From_VK_KHR_create_renderpass2  ( createRenderPass2
                                                              , cmdBeginRenderPass2
                                                              , cmdUseRenderPass2
                                                              , cmdNextSubpass2
                                                              , cmdEndRenderPass2
                                                              , AttachmentDescription2(..)
                                                              , AttachmentReference2(..)
                                                              , SubpassDescription2(..)
                                                              , SubpassDependency2(..)
                                                              , RenderPassCreateInfo2(..)
                                                              , SubpassBeginInfo(..)
                                                              , SubpassEndInfo(..)
                                                              , StructureType(..)
                                                              ) where

import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import Foreign.Marshal.Utils (maybePeek)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (castPtr)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import qualified Data.Vector (null)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.Type.Equality ((:~:)(Refl))
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Data.Int (Int32)
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.CStruct.Utils (advancePtrBytes)
import Vulkan.CStruct.Extends (forgetExtensions)
import Vulkan.CStruct.Extends (peekSomeCStruct)
import Vulkan.CStruct.Extends (pokeSomeCStruct)
import Vulkan.CStruct.Extends (withSomeCStruct)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.Enums.AccessFlagBits (AccessFlags)
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.Core10.Enums.AttachmentDescriptionFlagBits (AttachmentDescriptionFlags)
import {-# SOURCE #-} Vulkan.Core12.Promoted_From_VK_KHR_separate_depth_stencil_layouts (AttachmentDescriptionStencilLayout)
import Vulkan.Core10.Enums.AttachmentLoadOp (AttachmentLoadOp)
import {-# SOURCE #-} Vulkan.Core12.Promoted_From_VK_KHR_separate_depth_stencil_layouts (AttachmentReferenceStencilLayout)
import Vulkan.Core10.Enums.AttachmentStoreOp (AttachmentStoreOp)
import Vulkan.CStruct.Extends (Chain)
import Vulkan.Core10.Handles (CommandBuffer)
import Vulkan.Core10.Handles (CommandBuffer(..))
import Vulkan.Core10.Handles (CommandBuffer(CommandBuffer))
import Vulkan.Core10.Handles (CommandBuffer_T)
import Vulkan.Core10.Enums.DependencyFlagBits (DependencyFlags)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkCmdBeginRenderPass2))
import Vulkan.Dynamic (DeviceCmds(pVkCmdEndRenderPass2))
import Vulkan.Dynamic (DeviceCmds(pVkCmdNextSubpass2))
import Vulkan.Dynamic (DeviceCmds(pVkCreateRenderPass2))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.CStruct.Extends (Extends)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (Extensible(..))
import Vulkan.Core10.Enums.Format (Format)
import {-# SOURCE #-} Vulkan.Extensions.VK_KHR_fragment_shading_rate (FragmentShadingRateAttachmentInfoKHR)
import Vulkan.Core10.Enums.ImageAspectFlagBits (ImageAspectFlags)
import Vulkan.Core10.Enums.ImageLayout (ImageLayout)
import {-# SOURCE #-} Vulkan.Core13.Promoted_From_VK_KHR_synchronization2 (MemoryBarrier2)
import Vulkan.CStruct.Extends (PeekChain)
import Vulkan.CStruct.Extends (PeekChain(..))
import Vulkan.Core10.Enums.PipelineBindPoint (PipelineBindPoint)
import Vulkan.Core10.Enums.PipelineStageFlagBits (PipelineStageFlags)
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (PokeChain(..))
import Vulkan.Core10.Handles (RenderPass)
import Vulkan.Core10.Handles (RenderPass(..))
import Vulkan.Core10.CommandBufferBuilding (RenderPassBeginInfo)
import Vulkan.Core10.Enums.RenderPassCreateFlagBits (RenderPassCreateFlags)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_fragment_density_map (RenderPassFragmentDensityMapCreateInfoEXT)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.SampleCountFlagBits (SampleCountFlagBits)
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.SubpassContents (SubpassContents)
import {-# SOURCE #-} Vulkan.Core12.Promoted_From_VK_KHR_depth_stencil_resolve (SubpassDescriptionDepthStencilResolve)
import Vulkan.Core10.Enums.SubpassDescriptionFlagBits (SubpassDescriptionFlags)
import {-# SOURCE #-} Vulkan.Extensions.VK_QCOM_fragment_density_map_offset (SubpassFragmentDensityMapOffsetEndInfoQCOM)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_ATTACHMENT_DESCRIPTION_2))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_ATTACHMENT_REFERENCE_2))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_RENDER_PASS_CREATE_INFO_2))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SUBPASS_BEGIN_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SUBPASS_DEPENDENCY_2))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SUBPASS_DESCRIPTION_2))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SUBPASS_END_INFO))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Core10.Enums.StructureType (StructureType(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkCreateRenderPass2
  :: FunPtr (Ptr Device_T -> Ptr (SomeStruct RenderPassCreateInfo2) -> Ptr AllocationCallbacks -> Ptr RenderPass -> IO Result) -> Ptr Device_T -> Ptr (SomeStruct RenderPassCreateInfo2) -> Ptr AllocationCallbacks -> Ptr RenderPass -> IO Result

-- | vkCreateRenderPass2 - Create a new render pass object
--
-- = Description
--
-- This command is functionally identical to
-- 'Vulkan.Core10.Pass.createRenderPass', but includes extensible
-- sub-structures that include @sType@ and @pNext@ parameters, allowing
-- them to be more easily extended.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCreateRenderPass2-device-parameter# @device@ /must/ be a
--     valid 'Vulkan.Core10.Handles.Device' handle
--
-- -   #VUID-vkCreateRenderPass2-pCreateInfo-parameter# @pCreateInfo@
--     /must/ be a valid pointer to a valid 'RenderPassCreateInfo2'
--     structure
--
-- -   #VUID-vkCreateRenderPass2-pAllocator-parameter# If @pAllocator@ is
--     not @NULL@, @pAllocator@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks' structure
--
-- -   #VUID-vkCreateRenderPass2-pRenderPass-parameter# @pRenderPass@
--     /must/ be a valid pointer to a 'Vulkan.Core10.Handles.RenderPass'
--     handle
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-errorcodes Failure>]
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_HOST_MEMORY'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_OUT_OF_DEVICE_MEMORY'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_create_renderpass2 VK_KHR_create_renderpass2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_2 VK_VERSION_1_2>,
-- 'Vulkan.Core10.AllocationCallbacks.AllocationCallbacks',
-- 'Vulkan.Core10.Handles.Device', 'Vulkan.Core10.Handles.RenderPass',
-- 'RenderPassCreateInfo2'
createRenderPass2 :: forall a io
                   . (Extendss RenderPassCreateInfo2 a, PokeChain a, MonadIO io)
                  => -- | @device@ is the logical device that creates the render pass.
                     Device
                  -> -- | @pCreateInfo@ is a pointer to a 'RenderPassCreateInfo2' structure
                     -- describing the parameters of the render pass.
                     (RenderPassCreateInfo2 a)
                  -> -- | @pAllocator@ controls host memory allocation as described in the
                     -- <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#memory-allocation Memory Allocation>
                     -- chapter.
                     ("allocator" ::: Maybe AllocationCallbacks)
                  -> io (RenderPass)
createRenderPass2 :: Device
-> RenderPassCreateInfo2 a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> io RenderPass
createRenderPass2 Device
device RenderPassCreateInfo2 a
createInfo "allocator" ::: Maybe AllocationCallbacks
allocator = IO RenderPass -> io RenderPass
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RenderPass -> io RenderPass)
-> (ContT RenderPass IO RenderPass -> IO RenderPass)
-> ContT RenderPass IO RenderPass
-> io RenderPass
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT RenderPass IO RenderPass -> IO RenderPass
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT RenderPass IO RenderPass -> io RenderPass)
-> ContT RenderPass IO RenderPass -> io RenderPass
forall a b. (a -> b) -> a -> b
$ do
  let vkCreateRenderPass2Ptr :: FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct RenderPassCreateInfo2))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pRenderPass" ::: Ptr RenderPass)
   -> IO Result)
vkCreateRenderPass2Ptr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> ("pCreateInfo" ::: Ptr (SomeStruct RenderPassCreateInfo2))
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pRenderPass" ::: Ptr RenderPass)
      -> IO Result)
pVkCreateRenderPass2 (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT RenderPass IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT RenderPass IO ())
-> IO () -> ContT RenderPass IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct RenderPassCreateInfo2))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pRenderPass" ::: Ptr RenderPass)
   -> IO Result)
vkCreateRenderPass2Ptr FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct RenderPassCreateInfo2))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pRenderPass" ::: Ptr RenderPass)
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> ("pCreateInfo" ::: Ptr (SomeStruct RenderPassCreateInfo2))
      -> ("pAllocator" ::: Ptr AllocationCallbacks)
      -> ("pRenderPass" ::: Ptr RenderPass)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct RenderPassCreateInfo2))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pRenderPass" ::: Ptr RenderPass)
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCreateRenderPass2 is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCreateRenderPass2' :: Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct RenderPassCreateInfo2))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pRenderPass" ::: Ptr RenderPass)
-> IO Result
vkCreateRenderPass2' = FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct RenderPassCreateInfo2))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pRenderPass" ::: Ptr RenderPass)
   -> IO Result)
-> Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct RenderPassCreateInfo2))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pRenderPass" ::: Ptr RenderPass)
-> IO Result
mkVkCreateRenderPass2 FunPtr
  (Ptr Device_T
   -> ("pCreateInfo" ::: Ptr (SomeStruct RenderPassCreateInfo2))
   -> ("pAllocator" ::: Ptr AllocationCallbacks)
   -> ("pRenderPass" ::: Ptr RenderPass)
   -> IO Result)
vkCreateRenderPass2Ptr
  Ptr (RenderPassCreateInfo2 a)
pCreateInfo <- ((Ptr (RenderPassCreateInfo2 a) -> IO RenderPass) -> IO RenderPass)
-> ContT RenderPass IO (Ptr (RenderPassCreateInfo2 a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (RenderPassCreateInfo2 a) -> IO RenderPass)
  -> IO RenderPass)
 -> ContT RenderPass IO (Ptr (RenderPassCreateInfo2 a)))
-> ((Ptr (RenderPassCreateInfo2 a) -> IO RenderPass)
    -> IO RenderPass)
-> ContT RenderPass IO (Ptr (RenderPassCreateInfo2 a))
forall a b. (a -> b) -> a -> b
$ RenderPassCreateInfo2 a
-> (Ptr (RenderPassCreateInfo2 a) -> IO RenderPass)
-> IO RenderPass
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (RenderPassCreateInfo2 a
createInfo)
  "pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
    "allocator" ::: Maybe AllocationCallbacks
Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT RenderPass IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
    Just AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO RenderPass)
 -> IO RenderPass)
-> ContT RenderPass IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO RenderPass)
  -> IO RenderPass)
 -> ContT RenderPass IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO RenderPass)
    -> IO RenderPass)
-> ContT RenderPass IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO RenderPass)
-> IO RenderPass
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
  "pRenderPass" ::: Ptr RenderPass
pPRenderPass <- ((("pRenderPass" ::: Ptr RenderPass) -> IO RenderPass)
 -> IO RenderPass)
-> ContT RenderPass IO ("pRenderPass" ::: Ptr RenderPass)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pRenderPass" ::: Ptr RenderPass) -> IO RenderPass)
  -> IO RenderPass)
 -> ContT RenderPass IO ("pRenderPass" ::: Ptr RenderPass))
-> ((("pRenderPass" ::: Ptr RenderPass) -> IO RenderPass)
    -> IO RenderPass)
-> ContT RenderPass IO ("pRenderPass" ::: Ptr RenderPass)
forall a b. (a -> b) -> a -> b
$ IO ("pRenderPass" ::: Ptr RenderPass)
-> (("pRenderPass" ::: Ptr RenderPass) -> IO ())
-> (("pRenderPass" ::: Ptr RenderPass) -> IO RenderPass)
-> IO RenderPass
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pRenderPass" ::: Ptr RenderPass)
forall a. Int -> IO (Ptr a)
callocBytes @RenderPass Int
8) ("pRenderPass" ::: Ptr RenderPass) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT RenderPass IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT RenderPass IO Result)
-> IO Result -> ContT RenderPass IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCreateRenderPass2" (Ptr Device_T
-> ("pCreateInfo" ::: Ptr (SomeStruct RenderPassCreateInfo2))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pRenderPass" ::: Ptr RenderPass)
-> IO Result
vkCreateRenderPass2' (Device -> Ptr Device_T
deviceHandle (Device
device)) (Ptr (RenderPassCreateInfo2 a)
-> "pCreateInfo" ::: Ptr (SomeStruct RenderPassCreateInfo2)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (RenderPassCreateInfo2 a)
pCreateInfo) "pAllocator" ::: Ptr AllocationCallbacks
pAllocator ("pRenderPass" ::: Ptr RenderPass
pPRenderPass))
  IO () -> ContT RenderPass IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT RenderPass IO ())
-> IO () -> ContT RenderPass IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
  RenderPass
pRenderPass <- IO RenderPass -> ContT RenderPass IO RenderPass
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO RenderPass -> ContT RenderPass IO RenderPass)
-> IO RenderPass -> ContT RenderPass IO RenderPass
forall a b. (a -> b) -> a -> b
$ ("pRenderPass" ::: Ptr RenderPass) -> IO RenderPass
forall a. Storable a => Ptr a -> IO a
peek @RenderPass "pRenderPass" ::: Ptr RenderPass
pPRenderPass
  RenderPass -> ContT RenderPass IO RenderPass
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RenderPass -> ContT RenderPass IO RenderPass)
-> RenderPass -> ContT RenderPass IO RenderPass
forall a b. (a -> b) -> a -> b
$ (RenderPass
pRenderPass)


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

-- | vkCmdBeginRenderPass2 - Begin a new render pass
--
-- = Description
--
-- After beginning a render pass instance, the command buffer is ready to
-- record the commands for the first subpass of that render pass.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdBeginRenderPass2-framebuffer-02779# Both the
--     @framebuffer@ and @renderPass@ members of @pRenderPassBegin@ /must/
--     have been created on the same 'Vulkan.Core10.Handles.Device' that
--     @commandBuffer@ was allocated on
--
-- -   #VUID-vkCmdBeginRenderPass2-initialLayout-03094# If any of the
--     @initialLayout@ or @finalLayout@ member of the
--     'Vulkan.Core10.Pass.AttachmentDescription' structures or the
--     @layout@ member of the 'Vulkan.Core10.Pass.AttachmentReference'
--     structures specified when creating the render pass specified in the
--     @renderPass@ member of @pRenderPassBegin@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL'
--     then the corresponding attachment image view of the framebuffer
--     specified in the @framebuffer@ member of @pRenderPassBegin@ /must/
--     have been created with a @usage@ value including
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_COLOR_ATTACHMENT_BIT'
--
-- -   #VUID-vkCmdBeginRenderPass2-initialLayout-03096# If any of the
--     @initialLayout@ or @finalLayout@ member of the
--     'Vulkan.Core10.Pass.AttachmentDescription' structures or the
--     @layout@ member of the 'Vulkan.Core10.Pass.AttachmentReference'
--     structures specified when creating the render pass specified in the
--     @renderPass@ member of @pRenderPassBegin@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_STENCIL_ATTACHMENT_OPTIMAL',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_STENCIL_READ_ONLY_OPTIMAL',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL',
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_STENCIL_READ_ONLY_OPTIMAL'
--     then the corresponding attachment image view of the framebuffer
--     specified in the @framebuffer@ member of @pRenderPassBegin@ /must/
--     have been created with a @usage@ value including
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT'
--
-- -   #VUID-vkCmdBeginRenderPass2-initialLayout-02844# If any of the
--     @initialLayout@ or @finalLayout@ member of the
--     'Vulkan.Core10.Pass.AttachmentDescription' structures or the
--     @layout@ member of the 'Vulkan.Core10.Pass.AttachmentReference'
--     structures specified when creating the render pass specified in the
--     @renderPass@ member of @pRenderPassBegin@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_OPTIMAL',
--     or
--     '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'
--     then the corresponding attachment image view of the framebuffer
--     specified in the @framebuffer@ member of @pRenderPassBegin@ /must/
--     have been created with a @usage@ value including
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT'
--
-- -   #VUID-vkCmdBeginRenderPass2-stencilInitialLayout-02845# If any of
--     the @stencilInitialLayout@ or @stencilFinalLayout@ member of the
--     'Vulkan.Core12.Promoted_From_VK_KHR_separate_depth_stencil_layouts.AttachmentDescriptionStencilLayout'
--     structures or the @stencilLayout@ member of the
--     'Vulkan.Core12.Promoted_From_VK_KHR_separate_depth_stencil_layouts.AttachmentReferenceStencilLayout'
--     structures specified when creating the render pass specified in the
--     @renderPass@ member of @pRenderPassBegin@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_STENCIL_ATTACHMENT_OPTIMAL',
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_STENCIL_READ_ONLY_OPTIMAL'
--     then the corresponding attachment image view of the framebuffer
--     specified in the @framebuffer@ member of @pRenderPassBegin@ /must/
--     have been created with a @usage@ value including
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT'
--
-- -   #VUID-vkCmdBeginRenderPass2-initialLayout-03097# If any of the
--     @initialLayout@ or @finalLayout@ member of the
--     'Vulkan.Core10.Pass.AttachmentDescription' structures or the
--     @layout@ member of the 'Vulkan.Core10.Pass.AttachmentReference'
--     structures specified when creating the render pass specified in the
--     @renderPass@ member of @pRenderPassBegin@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL'
--     then the corresponding attachment image view of the framebuffer
--     specified in the @framebuffer@ member of @pRenderPassBegin@ /must/
--     have been created with a @usage@ value including
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_SAMPLED_BIT' or
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_INPUT_ATTACHMENT_BIT'
--
-- -   #VUID-vkCmdBeginRenderPass2-initialLayout-03098# If any of the
--     @initialLayout@ or @finalLayout@ member of the
--     'Vulkan.Core10.Pass.AttachmentDescription' structures or the
--     @layout@ member of the 'Vulkan.Core10.Pass.AttachmentReference'
--     structures specified when creating the render pass specified in the
--     @renderPass@ member of @pRenderPassBegin@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_TRANSFER_SRC_OPTIMAL'
--     then the corresponding attachment image view of the framebuffer
--     specified in the @framebuffer@ member of @pRenderPassBegin@ /must/
--     have been created with a @usage@ value including
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_TRANSFER_SRC_BIT'
--
-- -   #VUID-vkCmdBeginRenderPass2-initialLayout-03099# If any of the
--     @initialLayout@ or @finalLayout@ member of the
--     'Vulkan.Core10.Pass.AttachmentDescription' structures or the
--     @layout@ member of the 'Vulkan.Core10.Pass.AttachmentReference'
--     structures specified when creating the render pass specified in the
--     @renderPass@ member of @pRenderPassBegin@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL'
--     then the corresponding attachment image view of the framebuffer
--     specified in the @framebuffer@ member of @pRenderPassBegin@ /must/
--     have been created with a @usage@ value including
--     'Vulkan.Core10.Enums.ImageUsageFlagBits.IMAGE_USAGE_TRANSFER_DST_BIT'
--
-- -   #VUID-vkCmdBeginRenderPass2-initialLayout-03100# If the
--     @initialLayout@ member of any of the
--     'Vulkan.Core10.Pass.AttachmentDescription' structures specified when
--     creating the render pass specified in the @renderPass@ member of
--     @pRenderPassBegin@ is not
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_UNDEFINED', then each
--     such @initialLayout@ /must/ be equal to the current layout of the
--     corresponding attachment image subresource of the framebuffer
--     specified in the @framebuffer@ member of @pRenderPassBegin@
--
-- -   #VUID-vkCmdBeginRenderPass2-srcStageMask-06453# The @srcStageMask@
--     members of any element of the @pDependencies@ member of
--     'Vulkan.Core10.Pass.RenderPassCreateInfo' used to create
--     @renderPass@ /must/ be supported by the capabilities of the queue
--     family identified by the @queueFamilyIndex@ member of the
--     'Vulkan.Core10.CommandPool.CommandPoolCreateInfo' used to create the
--     command pool which @commandBuffer@ was allocated from
--
-- -   #VUID-vkCmdBeginRenderPass2-dstStageMask-06454# The @dstStageMask@
--     members of any element of the @pDependencies@ member of
--     'Vulkan.Core10.Pass.RenderPassCreateInfo' used to create
--     @renderPass@ /must/ be supported by the capabilities of the queue
--     family identified by the @queueFamilyIndex@ member of the
--     'Vulkan.Core10.CommandPool.CommandPoolCreateInfo' used to create the
--     command pool which @commandBuffer@ was allocated from
--
-- -   #VUID-vkCmdBeginRenderPass2-framebuffer-02533# For any attachment in
--     @framebuffer@ that is used by @renderPass@ and is bound to memory
--     locations that are also bound to another attachment used by
--     @renderPass@, and if at least one of those uses causes either
--     attachment to be written to, both attachments /must/ have had the
--     'Vulkan.Core10.Enums.AttachmentDescriptionFlagBits.ATTACHMENT_DESCRIPTION_MAY_ALIAS_BIT'
--     set
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdBeginRenderPass2-commandBuffer-parameter# @commandBuffer@
--     /must/ be a valid 'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdBeginRenderPass2-pRenderPassBegin-parameter#
--     @pRenderPassBegin@ /must/ be a valid pointer to a valid
--     'Vulkan.Core10.CommandBufferBuilding.RenderPassBeginInfo' structure
--
-- -   #VUID-vkCmdBeginRenderPass2-pSubpassBeginInfo-parameter#
--     @pSubpassBeginInfo@ /must/ be a valid pointer to a valid
--     'SubpassBeginInfo' structure
--
-- -   #VUID-vkCmdBeginRenderPass2-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-vkCmdBeginRenderPass2-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- -   #VUID-vkCmdBeginRenderPass2-renderpass# This command /must/ only be
--     called outside of a render pass instance
--
-- -   #VUID-vkCmdBeginRenderPass2-bufferlevel# @commandBuffer@ /must/ be a
--     primary 'Vulkan.Core10.Handles.CommandBuffer'
--
-- == 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                                                                                                              |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_create_renderpass2 VK_KHR_create_renderpass2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_2 VK_VERSION_1_2>,
-- 'Vulkan.Core10.Handles.CommandBuffer',
-- 'Vulkan.Core10.CommandBufferBuilding.RenderPassBeginInfo',
-- 'SubpassBeginInfo'
cmdBeginRenderPass2 :: forall a io
                     . (Extendss RenderPassBeginInfo a, PokeChain a, MonadIO io)
                    => -- | @commandBuffer@ is the command buffer in which to record the command.
                       CommandBuffer
                    -> -- | @pRenderPassBegin@ is a pointer to a
                       -- 'Vulkan.Core10.CommandBufferBuilding.RenderPassBeginInfo' structure
                       -- specifying the render pass to begin an instance of, and the framebuffer
                       -- the instance uses.
                       (RenderPassBeginInfo a)
                    -> -- | @pSubpassBeginInfo@ is a pointer to a 'SubpassBeginInfo' structure
                       -- containing information about the subpass which is about to begin
                       -- rendering.
                       SubpassBeginInfo
                    -> io ()
cmdBeginRenderPass2 :: CommandBuffer -> RenderPassBeginInfo a -> SubpassBeginInfo -> io ()
cmdBeginRenderPass2 CommandBuffer
commandBuffer RenderPassBeginInfo a
renderPassBegin SubpassBeginInfo
subpassBeginInfo = 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 vkCmdBeginRenderPass2Ptr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("pRenderPassBegin" ::: Ptr (SomeStruct RenderPassBeginInfo))
   -> ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
   -> IO ())
vkCmdBeginRenderPass2Ptr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pRenderPassBegin" ::: Ptr (SomeStruct RenderPassBeginInfo))
      -> ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
      -> IO ())
pVkCmdBeginRenderPass2 (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
   -> ("pRenderPassBegin" ::: Ptr (SomeStruct RenderPassBeginInfo))
   -> ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
   -> IO ())
vkCmdBeginRenderPass2Ptr FunPtr
  (Ptr CommandBuffer_T
   -> ("pRenderPassBegin" ::: Ptr (SomeStruct RenderPassBeginInfo))
   -> ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pRenderPassBegin" ::: Ptr (SomeStruct RenderPassBeginInfo))
      -> ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("pRenderPassBegin" ::: Ptr (SomeStruct RenderPassBeginInfo))
   -> ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
   -> 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 vkCmdBeginRenderPass2 is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdBeginRenderPass2' :: Ptr CommandBuffer_T
-> ("pRenderPassBegin" ::: Ptr (SomeStruct RenderPassBeginInfo))
-> ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
-> IO ()
vkCmdBeginRenderPass2' = FunPtr
  (Ptr CommandBuffer_T
   -> ("pRenderPassBegin" ::: Ptr (SomeStruct RenderPassBeginInfo))
   -> ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
   -> IO ())
-> Ptr CommandBuffer_T
-> ("pRenderPassBegin" ::: Ptr (SomeStruct RenderPassBeginInfo))
-> ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
-> IO ()
mkVkCmdBeginRenderPass2 FunPtr
  (Ptr CommandBuffer_T
   -> ("pRenderPassBegin" ::: Ptr (SomeStruct RenderPassBeginInfo))
   -> ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
   -> IO ())
vkCmdBeginRenderPass2Ptr
  Ptr (RenderPassBeginInfo a)
pRenderPassBegin <- ((Ptr (RenderPassBeginInfo a) -> IO ()) -> IO ())
-> ContT () IO (Ptr (RenderPassBeginInfo a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (RenderPassBeginInfo a) -> IO ()) -> IO ())
 -> ContT () IO (Ptr (RenderPassBeginInfo a)))
-> ((Ptr (RenderPassBeginInfo a) -> IO ()) -> IO ())
-> ContT () IO (Ptr (RenderPassBeginInfo a))
forall a b. (a -> b) -> a -> b
$ RenderPassBeginInfo a
-> (Ptr (RenderPassBeginInfo a) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (RenderPassBeginInfo a
renderPassBegin)
  "pSubpassBeginInfo" ::: Ptr SubpassBeginInfo
pSubpassBeginInfo <- ((("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo) -> IO ())
 -> IO ())
-> ContT () IO ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo) -> IO ())
  -> IO ())
 -> ContT () IO ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo))
-> ((("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo) -> IO ())
    -> IO ())
-> ContT () IO ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
forall a b. (a -> b) -> a -> b
$ SubpassBeginInfo
-> (("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo) -> IO ())
-> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (SubpassBeginInfo
subpassBeginInfo)
  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
"vkCmdBeginRenderPass2" (Ptr CommandBuffer_T
-> ("pRenderPassBegin" ::: Ptr (SomeStruct RenderPassBeginInfo))
-> ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
-> IO ()
vkCmdBeginRenderPass2' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) (Ptr (RenderPassBeginInfo a)
-> "pRenderPassBegin" ::: Ptr (SomeStruct RenderPassBeginInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (RenderPassBeginInfo a)
pRenderPassBegin) "pSubpassBeginInfo" ::: Ptr SubpassBeginInfo
pSubpassBeginInfo)
  () -> 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
-- 'cmdBeginRenderPass2' and 'cmdEndRenderPass2'
--
-- Note that 'cmdEndRenderPass2' is *not* called if an exception is thrown
-- by the inner action.
cmdUseRenderPass2 :: forall a io r . (Extendss RenderPassBeginInfo a, Extendss SubpassEndInfo a, PokeChain a, PokeChain a, MonadIO io) => CommandBuffer -> RenderPassBeginInfo a -> SubpassBeginInfo -> SubpassEndInfo a -> io r -> io r
cmdUseRenderPass2 :: CommandBuffer
-> RenderPassBeginInfo a
-> SubpassBeginInfo
-> SubpassEndInfo a
-> io r
-> io r
cmdUseRenderPass2 CommandBuffer
commandBuffer RenderPassBeginInfo a
pRenderPassBegin SubpassBeginInfo
pSubpassBeginInfo SubpassEndInfo a
pSubpassEndInfo io r
a =
  (CommandBuffer -> RenderPassBeginInfo a -> SubpassBeginInfo -> io ()
forall (a :: [*]) (io :: * -> *).
(Extendss RenderPassBeginInfo a, PokeChain a, MonadIO io) =>
CommandBuffer -> RenderPassBeginInfo a -> SubpassBeginInfo -> io ()
cmdBeginRenderPass2 CommandBuffer
commandBuffer RenderPassBeginInfo a
pRenderPassBegin SubpassBeginInfo
pSubpassBeginInfo) 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 -> SubpassEndInfo a -> io ()
forall (a :: [*]) (io :: * -> *).
(Extendss SubpassEndInfo a, PokeChain a, MonadIO io) =>
CommandBuffer -> SubpassEndInfo a -> io ()
cmdEndRenderPass2 CommandBuffer
commandBuffer SubpassEndInfo a
pSubpassEndInfo)


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

-- | vkCmdNextSubpass2 - Transition to the next subpass of a render pass
--
-- = Description
--
-- 'cmdNextSubpass2' is semantically identical to
-- 'Vulkan.Core10.CommandBufferBuilding.cmdNextSubpass', except that it is
-- extensible, and that @contents@ is provided as part of an extensible
-- structure instead of as a flat parameter.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdNextSubpass2-None-03102# The current subpass index /must/
--     be less than the number of subpasses in the render pass minus one
--
-- -   #VUID-vkCmdNextSubpass2-None-02350# This command /must/ not be
--     recorded when transform feedback is active
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdNextSubpass2-commandBuffer-parameter# @commandBuffer@
--     /must/ be a valid 'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdNextSubpass2-pSubpassBeginInfo-parameter#
--     @pSubpassBeginInfo@ /must/ be a valid pointer to a valid
--     'SubpassBeginInfo' structure
--
-- -   #VUID-vkCmdNextSubpass2-pSubpassEndInfo-parameter# @pSubpassEndInfo@
--     /must/ be a valid pointer to a valid 'SubpassEndInfo' structure
--
-- -   #VUID-vkCmdNextSubpass2-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-vkCmdNextSubpass2-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- -   #VUID-vkCmdNextSubpass2-renderpass# This command /must/ only be
--     called inside of a render pass instance
--
-- -   #VUID-vkCmdNextSubpass2-bufferlevel# @commandBuffer@ /must/ be a
--     primary 'Vulkan.Core10.Handles.CommandBuffer'
--
-- == 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                                                                                                              |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_create_renderpass2 VK_KHR_create_renderpass2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_2 VK_VERSION_1_2>,
-- 'Vulkan.Core10.Handles.CommandBuffer', 'SubpassBeginInfo',
-- 'SubpassEndInfo'
cmdNextSubpass2 :: forall a io
                 . (Extendss SubpassEndInfo a, PokeChain a, MonadIO io)
                => -- | @commandBuffer@ is the command buffer in which to record the command.
                   CommandBuffer
                -> -- | @pSubpassBeginInfo@ is a pointer to a 'SubpassBeginInfo' structure
                   -- containing information about the subpass which is about to begin
                   -- rendering.
                   SubpassBeginInfo
                -> -- | @pSubpassEndInfo@ is a pointer to a 'SubpassEndInfo' structure
                   -- containing information about how the previous subpass will be ended.
                   (SubpassEndInfo a)
                -> io ()
cmdNextSubpass2 :: CommandBuffer -> SubpassBeginInfo -> SubpassEndInfo a -> io ()
cmdNextSubpass2 CommandBuffer
commandBuffer SubpassBeginInfo
subpassBeginInfo SubpassEndInfo a
subpassEndInfo = 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 vkCmdNextSubpass2Ptr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
   -> ("pSubpassEndInfo" ::: Ptr (SomeStruct SubpassEndInfo))
   -> IO ())
vkCmdNextSubpass2Ptr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
      -> ("pSubpassEndInfo" ::: Ptr (SomeStruct SubpassEndInfo))
      -> IO ())
pVkCmdNextSubpass2 (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr CommandBuffer_T
   -> ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
   -> ("pSubpassEndInfo" ::: Ptr (SomeStruct SubpassEndInfo))
   -> IO ())
vkCmdNextSubpass2Ptr FunPtr
  (Ptr CommandBuffer_T
   -> ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
   -> ("pSubpassEndInfo" ::: Ptr (SomeStruct SubpassEndInfo))
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
      -> ("pSubpassEndInfo" ::: Ptr (SomeStruct SubpassEndInfo))
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
   -> ("pSubpassEndInfo" ::: Ptr (SomeStruct SubpassEndInfo))
   -> 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 vkCmdNextSubpass2 is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdNextSubpass2' :: Ptr CommandBuffer_T
-> ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
-> ("pSubpassEndInfo" ::: Ptr (SomeStruct SubpassEndInfo))
-> IO ()
vkCmdNextSubpass2' = FunPtr
  (Ptr CommandBuffer_T
   -> ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
   -> ("pSubpassEndInfo" ::: Ptr (SomeStruct SubpassEndInfo))
   -> IO ())
-> Ptr CommandBuffer_T
-> ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
-> ("pSubpassEndInfo" ::: Ptr (SomeStruct SubpassEndInfo))
-> IO ()
mkVkCmdNextSubpass2 FunPtr
  (Ptr CommandBuffer_T
   -> ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
   -> ("pSubpassEndInfo" ::: Ptr (SomeStruct SubpassEndInfo))
   -> IO ())
vkCmdNextSubpass2Ptr
  "pSubpassBeginInfo" ::: Ptr SubpassBeginInfo
pSubpassBeginInfo <- ((("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo) -> IO ())
 -> IO ())
-> ContT () IO ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo) -> IO ())
  -> IO ())
 -> ContT () IO ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo))
-> ((("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo) -> IO ())
    -> IO ())
-> ContT () IO ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
forall a b. (a -> b) -> a -> b
$ SubpassBeginInfo
-> (("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo) -> IO ())
-> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (SubpassBeginInfo
subpassBeginInfo)
  Ptr (SubpassEndInfo a)
pSubpassEndInfo <- ((Ptr (SubpassEndInfo a) -> IO ()) -> IO ())
-> ContT () IO (Ptr (SubpassEndInfo a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (SubpassEndInfo a) -> IO ()) -> IO ())
 -> ContT () IO (Ptr (SubpassEndInfo a)))
-> ((Ptr (SubpassEndInfo a) -> IO ()) -> IO ())
-> ContT () IO (Ptr (SubpassEndInfo a))
forall a b. (a -> b) -> a -> b
$ SubpassEndInfo a -> (Ptr (SubpassEndInfo a) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (SubpassEndInfo a
subpassEndInfo)
  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
"vkCmdNextSubpass2" (Ptr CommandBuffer_T
-> ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
-> ("pSubpassEndInfo" ::: Ptr (SomeStruct SubpassEndInfo))
-> IO ()
vkCmdNextSubpass2' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) "pSubpassBeginInfo" ::: Ptr SubpassBeginInfo
pSubpassBeginInfo (Ptr (SubpassEndInfo a)
-> "pSubpassEndInfo" ::: Ptr (SomeStruct SubpassEndInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (SubpassEndInfo a)
pSubpassEndInfo))
  () -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()


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

-- | vkCmdEndRenderPass2 - End the current render pass
--
-- = Description
--
-- 'cmdEndRenderPass2' is semantically identical to
-- 'Vulkan.Core10.CommandBufferBuilding.cmdEndRenderPass', except that it
-- is extensible.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdEndRenderPass2-None-03103# The current subpass index
--     /must/ be equal to the number of subpasses in the render pass minus
--     one
--
-- -   #VUID-vkCmdEndRenderPass2-None-02352# This command /must/ not be
--     recorded when transform feedback is active
--
-- -   #VUID-vkCmdEndRenderPass2-None-06171# The current render pass
--     instance /must/ not have been begun with
--     'Vulkan.Core13.Promoted_From_VK_KHR_dynamic_rendering.cmdBeginRendering'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdEndRenderPass2-commandBuffer-parameter# @commandBuffer@
--     /must/ be a valid 'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdEndRenderPass2-pSubpassEndInfo-parameter#
--     @pSubpassEndInfo@ /must/ be a valid pointer to a valid
--     'SubpassEndInfo' structure
--
-- -   #VUID-vkCmdEndRenderPass2-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-vkCmdEndRenderPass2-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- -   #VUID-vkCmdEndRenderPass2-renderpass# This command /must/ only be
--     called inside of a render pass instance
--
-- -   #VUID-vkCmdEndRenderPass2-bufferlevel# @commandBuffer@ /must/ be a
--     primary 'Vulkan.Core10.Handles.CommandBuffer'
--
-- == 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                                                                                                              |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_create_renderpass2 VK_KHR_create_renderpass2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_2 VK_VERSION_1_2>,
-- 'Vulkan.Core10.Handles.CommandBuffer', 'SubpassEndInfo'
cmdEndRenderPass2 :: forall a io
                   . (Extendss SubpassEndInfo a, PokeChain a, MonadIO io)
                  => -- | @commandBuffer@ is the command buffer in which to end the current render
                     -- pass instance.
                     CommandBuffer
                  -> -- | @pSubpassEndInfo@ is a pointer to a 'SubpassEndInfo' structure
                     -- containing information about how the previous subpass will be ended.
                     (SubpassEndInfo a)
                  -> io ()
cmdEndRenderPass2 :: CommandBuffer -> SubpassEndInfo a -> io ()
cmdEndRenderPass2 CommandBuffer
commandBuffer SubpassEndInfo a
subpassEndInfo = 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 vkCmdEndRenderPass2Ptr :: FunPtr
  (Ptr CommandBuffer_T
   -> ("pSubpassEndInfo" ::: Ptr (SomeStruct SubpassEndInfo))
   -> IO ())
vkCmdEndRenderPass2Ptr = DeviceCmds
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pSubpassEndInfo" ::: Ptr (SomeStruct SubpassEndInfo))
      -> IO ())
pVkCmdEndRenderPass2 (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
deviceCmds :: DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr CommandBuffer_T
   -> ("pSubpassEndInfo" ::: Ptr (SomeStruct SubpassEndInfo))
   -> IO ())
vkCmdEndRenderPass2Ptr FunPtr
  (Ptr CommandBuffer_T
   -> ("pSubpassEndInfo" ::: Ptr (SomeStruct SubpassEndInfo))
   -> IO ())
-> FunPtr
     (Ptr CommandBuffer_T
      -> ("pSubpassEndInfo" ::: Ptr (SomeStruct SubpassEndInfo))
      -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr CommandBuffer_T
   -> ("pSubpassEndInfo" ::: Ptr (SomeStruct SubpassEndInfo))
   -> 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 vkCmdEndRenderPass2 is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdEndRenderPass2' :: Ptr CommandBuffer_T
-> ("pSubpassEndInfo" ::: Ptr (SomeStruct SubpassEndInfo)) -> IO ()
vkCmdEndRenderPass2' = FunPtr
  (Ptr CommandBuffer_T
   -> ("pSubpassEndInfo" ::: Ptr (SomeStruct SubpassEndInfo))
   -> IO ())
-> Ptr CommandBuffer_T
-> ("pSubpassEndInfo" ::: Ptr (SomeStruct SubpassEndInfo))
-> IO ()
mkVkCmdEndRenderPass2 FunPtr
  (Ptr CommandBuffer_T
   -> ("pSubpassEndInfo" ::: Ptr (SomeStruct SubpassEndInfo))
   -> IO ())
vkCmdEndRenderPass2Ptr
  Ptr (SubpassEndInfo a)
pSubpassEndInfo <- ((Ptr (SubpassEndInfo a) -> IO ()) -> IO ())
-> ContT () IO (Ptr (SubpassEndInfo a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (SubpassEndInfo a) -> IO ()) -> IO ())
 -> ContT () IO (Ptr (SubpassEndInfo a)))
-> ((Ptr (SubpassEndInfo a) -> IO ()) -> IO ())
-> ContT () IO (Ptr (SubpassEndInfo a))
forall a b. (a -> b) -> a -> b
$ SubpassEndInfo a -> (Ptr (SubpassEndInfo a) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (SubpassEndInfo a
subpassEndInfo)
  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
"vkCmdEndRenderPass2" (Ptr CommandBuffer_T
-> ("pSubpassEndInfo" ::: Ptr (SomeStruct SubpassEndInfo)) -> IO ()
vkCmdEndRenderPass2' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)) (Ptr (SubpassEndInfo a)
-> "pSubpassEndInfo" ::: Ptr (SomeStruct SubpassEndInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (SubpassEndInfo a)
pSubpassEndInfo))
  () -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ ()


-- | VkAttachmentDescription2 - Structure specifying an attachment
-- description
--
-- = Description
--
-- Parameters defined by this structure with the same name as those in
-- 'Vulkan.Core10.Pass.AttachmentDescription' have the identical effect to
-- those parameters.
--
-- If the
-- <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#features-separateDepthStencilLayouts separateDepthStencilLayouts>
-- feature is enabled, and @format@ is a depth\/stencil format,
-- @initialLayout@ and @finalLayout@ /can/ be set to a layout that only
-- specifies the layout of the depth aspect.
--
-- If the @pNext@ chain includes a
-- 'Vulkan.Core12.Promoted_From_VK_KHR_separate_depth_stencil_layouts.AttachmentDescriptionStencilLayout'
-- structure, then the @stencilInitialLayout@ and @stencilFinalLayout@
-- members specify the initial and final layouts of the stencil aspect of a
-- depth\/stencil format, and @initialLayout@ and @finalLayout@ only apply
-- to the depth aspect. For depth-only formats, the
-- 'Vulkan.Core12.Promoted_From_VK_KHR_separate_depth_stencil_layouts.AttachmentDescriptionStencilLayout'
-- structure is ignored. For stencil-only formats, the initial and final
-- layouts of the stencil aspect are taken from the
-- 'Vulkan.Core12.Promoted_From_VK_KHR_separate_depth_stencil_layouts.AttachmentDescriptionStencilLayout'
-- structure if present, or @initialLayout@ and @finalLayout@ if not
-- present.
--
-- If @format@ is a depth\/stencil format, and either @initialLayout@ or
-- @finalLayout@ does not specify a layout for the stencil aspect, then the
-- application /must/ specify the initial and final layouts of the stencil
-- aspect by including a
-- 'Vulkan.Core12.Promoted_From_VK_KHR_separate_depth_stencil_layouts.AttachmentDescriptionStencilLayout'
-- structure in the @pNext@ chain.
--
-- == Valid Usage
--
-- -   #VUID-VkAttachmentDescription2-format-06701# @format@ /must/ not be
--     VK_FORMAT_UNDEFINED
--
-- -   #VUID-VkAttachmentDescription2-finalLayout-03061# @finalLayout@
--     /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_UNDEFINED' or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_PREINITIALIZED'
--
-- -   #VUID-VkAttachmentDescription2-format-06702# If @format@ includes a
--     color or depth aspect and @loadOp@ is
--     'Vulkan.Core10.Enums.AttachmentLoadOp.ATTACHMENT_LOAD_OP_LOAD', then
--     @initialLayout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_UNDEFINED'
--
-- -   #VUID-VkAttachmentDescription2-pNext-06704# If the @pNext@ chain
--     does not include a
--     'Vulkan.Core12.Promoted_From_VK_KHR_separate_depth_stencil_layouts.AttachmentDescriptionStencilLayout'
--     structure, @format@ includes a stencil aspect, and @stencilLoadOp@
--     is 'Vulkan.Core10.Enums.AttachmentLoadOp.ATTACHMENT_LOAD_OP_LOAD',
--     then @initialLayout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_UNDEFINED'
--
-- -   #VUID-VkAttachmentDescription2-pNext-06705# If the @pNext@ chain
--     does includes a
--     'Vulkan.Core12.Promoted_From_VK_KHR_separate_depth_stencil_layouts.AttachmentDescriptionStencilLayout'
--     structure, @format@ includes a stencil aspect, and @stencilLoadOp@
--     is 'Vulkan.Core10.Enums.AttachmentLoadOp.ATTACHMENT_LOAD_OP_LOAD',
--     then
--     'Vulkan.Core12.Promoted_From_VK_KHR_separate_depth_stencil_layouts.AttachmentDescriptionStencilLayout'::stencilInitialLayout
--     /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_UNDEFINED'
--
-- -   #VUID-VkAttachmentDescription2-format-03294# If @format@ is a color
--     format, @initialLayout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_STENCIL_READ_ONLY_OPTIMAL',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_STENCIL_READ_ONLY_OPTIMAL',
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_STENCIL_ATTACHMENT_OPTIMAL'
--
-- -   #VUID-VkAttachmentDescription2-format-03295# If @format@ is a
--     depth\/stencil format, @initialLayout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL'
--
-- -   #VUID-VkAttachmentDescription2-format-03296# If @format@ is a color
--     format, @finalLayout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_STENCIL_READ_ONLY_OPTIMAL',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_STENCIL_READ_ONLY_OPTIMAL',
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_STENCIL_ATTACHMENT_OPTIMAL'
--
-- -   #VUID-VkAttachmentDescription2-format-03297# If @format@ is a
--     depth\/stencil format, @finalLayout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL'
--
-- -   #VUID-VkAttachmentDescription2-separateDepthStencilLayouts-03298# If
--     the
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#features-separateDepthStencilLayouts separateDepthStencilLayouts>
--     feature is not enabled, @initialLayout@ /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-VkAttachmentDescription2-separateDepthStencilLayouts-03299# If
--     the
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#features-separateDepthStencilLayouts separateDepthStencilLayouts>
--     feature is not enabled, @finalLayout@ /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-VkAttachmentDescription2-format-03300# If @format@ is a color
--     format, @initialLayout@ /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-VkAttachmentDescription2-format-03301# If @format@ is a color
--     format, @finalLayout@ /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-VkAttachmentDescription2-format-03302# If @format@ is a
--     depth\/stencil format which includes both depth and stencil aspects,
--     and @initialLayout@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_OPTIMAL'
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_OPTIMAL',
--     the @pNext@ chain /must/ include a
--     'Vulkan.Core12.Promoted_From_VK_KHR_separate_depth_stencil_layouts.AttachmentDescriptionStencilLayout'
--     structure
--
-- -   #VUID-VkAttachmentDescription2-format-03303# If @format@ is a
--     depth\/stencil format which includes both depth and stencil aspects,
--     and @finalLayout@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_OPTIMAL'
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_OPTIMAL',
--     the @pNext@ chain /must/ include a
--     'Vulkan.Core12.Promoted_From_VK_KHR_separate_depth_stencil_layouts.AttachmentDescriptionStencilLayout'
--     structure
--
-- -   #VUID-VkAttachmentDescription2-format-03304# If @format@ is a
--     depth\/stencil format which includes only the depth aspect,
--     @initialLayout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_STENCIL_ATTACHMENT_OPTIMAL'
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_STENCIL_READ_ONLY_OPTIMAL'
--
-- -   #VUID-VkAttachmentDescription2-format-03305# If @format@ is a
--     depth\/stencil format which includes only the depth aspect,
--     @finalLayout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_STENCIL_ATTACHMENT_OPTIMAL'
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_STENCIL_READ_ONLY_OPTIMAL'
--
-- -   #VUID-VkAttachmentDescription2-format-03306# If @format@ is a
--     depth\/stencil format which includes only the stencil aspect,
--     @initialLayout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_OPTIMAL'
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_OPTIMAL'
--
-- -   #VUID-VkAttachmentDescription2-format-03307# If @format@ is a
--     depth\/stencil format which includes only the stencil aspect,
--     @finalLayout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_OPTIMAL'
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_OPTIMAL'
--
-- -   #VUID-VkAttachmentDescription2-separateDepthStencilLayouts-06556# If
--     the
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#features-separateDepthStencilLayouts separateDepthStencilLayouts>
--     feature is enabled and @format@ is a depth\/stencil format that
--     includes a depth aspect and the @pNext@ chain includes a
--     'Vulkan.Core12.Promoted_From_VK_KHR_separate_depth_stencil_layouts.AttachmentDescriptionStencilLayout'
--     structure, @initialLayout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_STENCIL_ATTACHMENT_OPTIMAL'
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_STENCIL_READ_ONLY_OPTIMAL'
--
-- -   #VUID-VkAttachmentDescription2-separateDepthStencilLayouts-06557# If
--     the
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#features-separateDepthStencilLayouts separateDepthStencilLayouts>
--     feature is enabled and @format@ is a depth\/stencil format that
--     includes a depth aspect and the @pNext@ chain includes a
--     'Vulkan.Core12.Promoted_From_VK_KHR_separate_depth_stencil_layouts.AttachmentDescriptionStencilLayout'
--     structure, @finalLayout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_STENCIL_ATTACHMENT_OPTIMAL'
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_STENCIL_READ_ONLY_OPTIMAL'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkAttachmentDescription2-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_ATTACHMENT_DESCRIPTION_2'
--
-- -   #VUID-VkAttachmentDescription2-pNext-pNext# @pNext@ /must/ be @NULL@
--     or a pointer to a valid instance of
--     'Vulkan.Core12.Promoted_From_VK_KHR_separate_depth_stencil_layouts.AttachmentDescriptionStencilLayout'
--
-- -   #VUID-VkAttachmentDescription2-sType-unique# The @sType@ value of
--     each struct in the @pNext@ chain /must/ be unique
--
-- -   #VUID-VkAttachmentDescription2-flags-parameter# @flags@ /must/ be a
--     valid combination of
--     'Vulkan.Core10.Enums.AttachmentDescriptionFlagBits.AttachmentDescriptionFlagBits'
--     values
--
-- -   #VUID-VkAttachmentDescription2-format-parameter# @format@ /must/ be
--     a valid 'Vulkan.Core10.Enums.Format.Format' value
--
-- -   #VUID-VkAttachmentDescription2-samples-parameter# @samples@ /must/
--     be a valid
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits' value
--
-- -   #VUID-VkAttachmentDescription2-loadOp-parameter# @loadOp@ /must/ be
--     a valid 'Vulkan.Core10.Enums.AttachmentLoadOp.AttachmentLoadOp'
--     value
--
-- -   #VUID-VkAttachmentDescription2-storeOp-parameter# @storeOp@ /must/
--     be a valid 'Vulkan.Core10.Enums.AttachmentStoreOp.AttachmentStoreOp'
--     value
--
-- -   #VUID-VkAttachmentDescription2-stencilLoadOp-parameter#
--     @stencilLoadOp@ /must/ be a valid
--     'Vulkan.Core10.Enums.AttachmentLoadOp.AttachmentLoadOp' value
--
-- -   #VUID-VkAttachmentDescription2-stencilStoreOp-parameter#
--     @stencilStoreOp@ /must/ be a valid
--     'Vulkan.Core10.Enums.AttachmentStoreOp.AttachmentStoreOp' value
--
-- -   #VUID-VkAttachmentDescription2-initialLayout-parameter#
--     @initialLayout@ /must/ be a valid
--     'Vulkan.Core10.Enums.ImageLayout.ImageLayout' value
--
-- -   #VUID-VkAttachmentDescription2-finalLayout-parameter# @finalLayout@
--     /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_create_renderpass2 VK_KHR_create_renderpass2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_2 VK_VERSION_1_2>,
-- 'Vulkan.Core10.Enums.AttachmentDescriptionFlagBits.AttachmentDescriptionFlags',
-- 'Vulkan.Core10.Enums.AttachmentLoadOp.AttachmentLoadOp',
-- 'Vulkan.Core10.Enums.AttachmentStoreOp.AttachmentStoreOp',
-- 'Vulkan.Core10.Enums.Format.Format',
-- 'Vulkan.Core10.Enums.ImageLayout.ImageLayout', 'RenderPassCreateInfo2',
-- 'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data AttachmentDescription2 (es :: [Type]) = AttachmentDescription2
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    AttachmentDescription2 es -> Chain es
next :: Chain es
  , -- | @flags@ is a bitmask of
    -- 'Vulkan.Core10.Enums.AttachmentDescriptionFlagBits.AttachmentDescriptionFlagBits'
    -- specifying additional properties of the attachment.
    AttachmentDescription2 es -> AttachmentDescriptionFlags
flags :: AttachmentDescriptionFlags
  , -- | @format@ is a 'Vulkan.Core10.Enums.Format.Format' value specifying the
    -- format of the image that will be used for the attachment.
    AttachmentDescription2 es -> Format
format :: Format
  , -- | @samples@ is a
    -- 'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits' value
    -- specifying the number of samples of the image.
    AttachmentDescription2 es -> SampleCountFlagBits
samples :: SampleCountFlagBits
  , -- | @loadOp@ is a 'Vulkan.Core10.Enums.AttachmentLoadOp.AttachmentLoadOp'
    -- value specifying how the contents of color and depth components of the
    -- attachment are treated at the beginning of the subpass where it is first
    -- used.
    AttachmentDescription2 es -> AttachmentLoadOp
loadOp :: AttachmentLoadOp
  , -- | @storeOp@ is a 'Vulkan.Core10.Enums.AttachmentStoreOp.AttachmentStoreOp'
    -- value specifying how the contents of color and depth components of the
    -- attachment are treated at the end of the subpass where it is last used.
    AttachmentDescription2 es -> AttachmentStoreOp
storeOp :: AttachmentStoreOp
  , -- | @stencilLoadOp@ is a
    -- 'Vulkan.Core10.Enums.AttachmentLoadOp.AttachmentLoadOp' value specifying
    -- how the contents of stencil components of the attachment are treated at
    -- the beginning of the subpass where it is first used.
    AttachmentDescription2 es -> AttachmentLoadOp
stencilLoadOp :: AttachmentLoadOp
  , -- | @stencilStoreOp@ is a
    -- 'Vulkan.Core10.Enums.AttachmentStoreOp.AttachmentStoreOp' value
    -- specifying how the contents of stencil components of the attachment are
    -- treated at the end of the last subpass where it is used.
    AttachmentDescription2 es -> AttachmentStoreOp
stencilStoreOp :: AttachmentStoreOp
  , -- | @initialLayout@ is the layout the attachment image subresource will be
    -- in when a render pass instance begins.
    AttachmentDescription2 es -> ImageLayout
initialLayout :: ImageLayout
  , -- | @finalLayout@ is the layout the attachment image subresource will be
    -- transitioned to when a render pass instance ends.
    AttachmentDescription2 es -> ImageLayout
finalLayout :: ImageLayout
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (AttachmentDescription2 (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (AttachmentDescription2 es)

instance Extensible AttachmentDescription2 where
  extensibleTypeName :: String
extensibleTypeName = String
"AttachmentDescription2"
  setNext :: AttachmentDescription2 ds -> Chain es -> AttachmentDescription2 es
setNext AttachmentDescription2{Chain ds
Format
ImageLayout
SampleCountFlagBits
AttachmentStoreOp
AttachmentLoadOp
AttachmentDescriptionFlags
finalLayout :: ImageLayout
initialLayout :: ImageLayout
stencilStoreOp :: AttachmentStoreOp
stencilLoadOp :: AttachmentLoadOp
storeOp :: AttachmentStoreOp
loadOp :: AttachmentLoadOp
samples :: SampleCountFlagBits
format :: Format
flags :: AttachmentDescriptionFlags
next :: Chain ds
$sel:finalLayout:AttachmentDescription2 :: forall (es :: [*]). AttachmentDescription2 es -> ImageLayout
$sel:initialLayout:AttachmentDescription2 :: forall (es :: [*]). AttachmentDescription2 es -> ImageLayout
$sel:stencilStoreOp:AttachmentDescription2 :: forall (es :: [*]). AttachmentDescription2 es -> AttachmentStoreOp
$sel:stencilLoadOp:AttachmentDescription2 :: forall (es :: [*]). AttachmentDescription2 es -> AttachmentLoadOp
$sel:storeOp:AttachmentDescription2 :: forall (es :: [*]). AttachmentDescription2 es -> AttachmentStoreOp
$sel:loadOp:AttachmentDescription2 :: forall (es :: [*]). AttachmentDescription2 es -> AttachmentLoadOp
$sel:samples:AttachmentDescription2 :: forall (es :: [*]).
AttachmentDescription2 es -> SampleCountFlagBits
$sel:format:AttachmentDescription2 :: forall (es :: [*]). AttachmentDescription2 es -> Format
$sel:flags:AttachmentDescription2 :: forall (es :: [*]).
AttachmentDescription2 es -> AttachmentDescriptionFlags
$sel:next:AttachmentDescription2 :: forall (es :: [*]). AttachmentDescription2 es -> Chain es
..} Chain es
next' = AttachmentDescription2 :: forall (es :: [*]).
Chain es
-> AttachmentDescriptionFlags
-> Format
-> SampleCountFlagBits
-> AttachmentLoadOp
-> AttachmentStoreOp
-> AttachmentLoadOp
-> AttachmentStoreOp
-> ImageLayout
-> ImageLayout
-> AttachmentDescription2 es
AttachmentDescription2{$sel:next:AttachmentDescription2 :: Chain es
next = Chain es
next', Format
ImageLayout
SampleCountFlagBits
AttachmentStoreOp
AttachmentLoadOp
AttachmentDescriptionFlags
finalLayout :: ImageLayout
initialLayout :: ImageLayout
stencilStoreOp :: AttachmentStoreOp
stencilLoadOp :: AttachmentLoadOp
storeOp :: AttachmentStoreOp
loadOp :: AttachmentLoadOp
samples :: SampleCountFlagBits
format :: Format
flags :: AttachmentDescriptionFlags
$sel:finalLayout:AttachmentDescription2 :: ImageLayout
$sel:initialLayout:AttachmentDescription2 :: ImageLayout
$sel:stencilStoreOp:AttachmentDescription2 :: AttachmentStoreOp
$sel:stencilLoadOp:AttachmentDescription2 :: AttachmentLoadOp
$sel:storeOp:AttachmentDescription2 :: AttachmentStoreOp
$sel:loadOp:AttachmentDescription2 :: AttachmentLoadOp
$sel:samples:AttachmentDescription2 :: SampleCountFlagBits
$sel:format:AttachmentDescription2 :: Format
$sel:flags:AttachmentDescription2 :: AttachmentDescriptionFlags
..}
  getNext :: AttachmentDescription2 es -> Chain es
getNext AttachmentDescription2{Chain es
Format
ImageLayout
SampleCountFlagBits
AttachmentStoreOp
AttachmentLoadOp
AttachmentDescriptionFlags
finalLayout :: ImageLayout
initialLayout :: ImageLayout
stencilStoreOp :: AttachmentStoreOp
stencilLoadOp :: AttachmentLoadOp
storeOp :: AttachmentStoreOp
loadOp :: AttachmentLoadOp
samples :: SampleCountFlagBits
format :: Format
flags :: AttachmentDescriptionFlags
next :: Chain es
$sel:finalLayout:AttachmentDescription2 :: forall (es :: [*]). AttachmentDescription2 es -> ImageLayout
$sel:initialLayout:AttachmentDescription2 :: forall (es :: [*]). AttachmentDescription2 es -> ImageLayout
$sel:stencilStoreOp:AttachmentDescription2 :: forall (es :: [*]). AttachmentDescription2 es -> AttachmentStoreOp
$sel:stencilLoadOp:AttachmentDescription2 :: forall (es :: [*]). AttachmentDescription2 es -> AttachmentLoadOp
$sel:storeOp:AttachmentDescription2 :: forall (es :: [*]). AttachmentDescription2 es -> AttachmentStoreOp
$sel:loadOp:AttachmentDescription2 :: forall (es :: [*]). AttachmentDescription2 es -> AttachmentLoadOp
$sel:samples:AttachmentDescription2 :: forall (es :: [*]).
AttachmentDescription2 es -> SampleCountFlagBits
$sel:format:AttachmentDescription2 :: forall (es :: [*]). AttachmentDescription2 es -> Format
$sel:flags:AttachmentDescription2 :: forall (es :: [*]).
AttachmentDescription2 es -> AttachmentDescriptionFlags
$sel:next:AttachmentDescription2 :: forall (es :: [*]). AttachmentDescription2 es -> Chain es
..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends AttachmentDescription2 e => b) -> Maybe b
  extends :: proxy e -> (Extends AttachmentDescription2 e => b) -> Maybe b
extends proxy e
_ Extends AttachmentDescription2 e => b
f
    | Just e :~: AttachmentDescriptionStencilLayout
Refl <- (Typeable e, Typeable AttachmentDescriptionStencilLayout) =>
Maybe (e :~: AttachmentDescriptionStencilLayout)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @AttachmentDescriptionStencilLayout = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends AttachmentDescription2 e => b
f
    | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing

instance (Extendss AttachmentDescription2 es, PokeChain es) => ToCStruct (AttachmentDescription2 es) where
  withCStruct :: AttachmentDescription2 es
-> (Ptr (AttachmentDescription2 es) -> IO b) -> IO b
withCStruct AttachmentDescription2 es
x Ptr (AttachmentDescription2 es) -> IO b
f = Int -> (Ptr (AttachmentDescription2 es) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
56 ((Ptr (AttachmentDescription2 es) -> IO b) -> IO b)
-> (Ptr (AttachmentDescription2 es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr (AttachmentDescription2 es)
p -> Ptr (AttachmentDescription2 es)
-> AttachmentDescription2 es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (AttachmentDescription2 es)
p AttachmentDescription2 es
x (Ptr (AttachmentDescription2 es) -> IO b
f Ptr (AttachmentDescription2 es)
p)
  pokeCStruct :: Ptr (AttachmentDescription2 es)
-> AttachmentDescription2 es -> IO b -> IO b
pokeCStruct Ptr (AttachmentDescription2 es)
p AttachmentDescription2{Chain es
Format
ImageLayout
SampleCountFlagBits
AttachmentStoreOp
AttachmentLoadOp
AttachmentDescriptionFlags
finalLayout :: ImageLayout
initialLayout :: ImageLayout
stencilStoreOp :: AttachmentStoreOp
stencilLoadOp :: AttachmentLoadOp
storeOp :: AttachmentStoreOp
loadOp :: AttachmentLoadOp
samples :: SampleCountFlagBits
format :: Format
flags :: AttachmentDescriptionFlags
next :: Chain es
$sel:finalLayout:AttachmentDescription2 :: forall (es :: [*]). AttachmentDescription2 es -> ImageLayout
$sel:initialLayout:AttachmentDescription2 :: forall (es :: [*]). AttachmentDescription2 es -> ImageLayout
$sel:stencilStoreOp:AttachmentDescription2 :: forall (es :: [*]). AttachmentDescription2 es -> AttachmentStoreOp
$sel:stencilLoadOp:AttachmentDescription2 :: forall (es :: [*]). AttachmentDescription2 es -> AttachmentLoadOp
$sel:storeOp:AttachmentDescription2 :: forall (es :: [*]). AttachmentDescription2 es -> AttachmentStoreOp
$sel:loadOp:AttachmentDescription2 :: forall (es :: [*]). AttachmentDescription2 es -> AttachmentLoadOp
$sel:samples:AttachmentDescription2 :: forall (es :: [*]).
AttachmentDescription2 es -> SampleCountFlagBits
$sel:format:AttachmentDescription2 :: forall (es :: [*]). AttachmentDescription2 es -> Format
$sel:flags:AttachmentDescription2 :: forall (es :: [*]).
AttachmentDescription2 es -> AttachmentDescriptionFlags
$sel:next:AttachmentDescription2 :: forall (es :: [*]). AttachmentDescription2 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 (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_ATTACHMENT_DESCRIPTION_2)
    Ptr ()
pNext'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 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 AttachmentDescriptionFlags
-> AttachmentDescriptionFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es)
-> Int -> Ptr AttachmentDescriptionFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr AttachmentDescriptionFlags)) (AttachmentDescriptionFlags
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 Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Format)) (Format
format)
    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 (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr SampleCountFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr SampleCountFlagBits)) (SampleCountFlagBits
samples)
    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 (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr AttachmentLoadOp
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: 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 (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr AttachmentStoreOp
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr AttachmentStoreOp)) (AttachmentStoreOp
storeOp)
    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 (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr AttachmentLoadOp
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr AttachmentLoadOp)) (AttachmentLoadOp
stencilLoadOp)
    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 (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr AttachmentStoreOp
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr AttachmentStoreOp)) (AttachmentStoreOp
stencilStoreOp)
    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 (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr ImageLayout)) (ImageLayout
initialLayout)
    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 (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr ImageLayout)) (ImageLayout
finalLayout)
    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 (AttachmentDescription2 es) -> IO b -> IO b
pokeZeroCStruct Ptr (AttachmentDescription2 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 (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_ATTACHMENT_DESCRIPTION_2)
    Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall 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 (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 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 Format -> Format -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Format)) (Format
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 SampleCountFlagBits -> SampleCountFlagBits -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr SampleCountFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr SampleCountFlagBits)) (SampleCountFlagBits
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 (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr AttachmentLoadOp
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: 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 (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr AttachmentStoreOp
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr AttachmentStoreOp)) (AttachmentStoreOp
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 (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr AttachmentLoadOp
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: 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 (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr AttachmentStoreOp
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr AttachmentStoreOp)) (AttachmentStoreOp
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 (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: 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 (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr ImageLayout)) (ImageLayout
forall a. Zero a => a
zero)
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

instance (Extendss AttachmentDescription2 es, PeekChain es) => FromCStruct (AttachmentDescription2 es) where
  peekCStruct :: Ptr (AttachmentDescription2 es) -> IO (AttachmentDescription2 es)
peekCStruct Ptr (AttachmentDescription2 es)
p = do
    Ptr ()
pNext <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ())))
    Chain es
next <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
    AttachmentDescriptionFlags
flags <- Ptr AttachmentDescriptionFlags -> IO AttachmentDescriptionFlags
forall a. Storable a => Ptr a -> IO a
peek @AttachmentDescriptionFlags ((Ptr (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es)
-> Int -> Ptr AttachmentDescriptionFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr AttachmentDescriptionFlags))
    Format
format <- Ptr Format -> IO Format
forall a. Storable a => Ptr a -> IO a
peek @Format ((Ptr (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr Format
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Format))
    SampleCountFlagBits
samples <- Ptr SampleCountFlagBits -> IO SampleCountFlagBits
forall a. Storable a => Ptr a -> IO a
peek @SampleCountFlagBits ((Ptr (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr SampleCountFlagBits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr SampleCountFlagBits))
    AttachmentLoadOp
loadOp <- Ptr AttachmentLoadOp -> IO AttachmentLoadOp
forall a. Storable a => Ptr a -> IO a
peek @AttachmentLoadOp ((Ptr (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr AttachmentLoadOp
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr AttachmentLoadOp))
    AttachmentStoreOp
storeOp <- Ptr AttachmentStoreOp -> IO AttachmentStoreOp
forall a. Storable a => Ptr a -> IO a
peek @AttachmentStoreOp ((Ptr (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr AttachmentStoreOp
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr AttachmentStoreOp))
    AttachmentLoadOp
stencilLoadOp <- Ptr AttachmentLoadOp -> IO AttachmentLoadOp
forall a. Storable a => Ptr a -> IO a
peek @AttachmentLoadOp ((Ptr (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr AttachmentLoadOp
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr AttachmentLoadOp))
    AttachmentStoreOp
stencilStoreOp <- Ptr AttachmentStoreOp -> IO AttachmentStoreOp
forall a. Storable a => Ptr a -> IO a
peek @AttachmentStoreOp ((Ptr (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr AttachmentStoreOp
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr AttachmentStoreOp))
    ImageLayout
initialLayout <- Ptr ImageLayout -> IO ImageLayout
forall a. Storable a => Ptr a -> IO a
peek @ImageLayout ((Ptr (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr ImageLayout))
    ImageLayout
finalLayout <- Ptr ImageLayout -> IO ImageLayout
forall a. Storable a => Ptr a -> IO a
peek @ImageLayout ((Ptr (AttachmentDescription2 es)
p Ptr (AttachmentDescription2 es) -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr ImageLayout))
    AttachmentDescription2 es -> IO (AttachmentDescription2 es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AttachmentDescription2 es -> IO (AttachmentDescription2 es))
-> AttachmentDescription2 es -> IO (AttachmentDescription2 es)
forall a b. (a -> b) -> a -> b
$ Chain es
-> AttachmentDescriptionFlags
-> Format
-> SampleCountFlagBits
-> AttachmentLoadOp
-> AttachmentStoreOp
-> AttachmentLoadOp
-> AttachmentStoreOp
-> ImageLayout
-> ImageLayout
-> AttachmentDescription2 es
forall (es :: [*]).
Chain es
-> AttachmentDescriptionFlags
-> Format
-> SampleCountFlagBits
-> AttachmentLoadOp
-> AttachmentStoreOp
-> AttachmentLoadOp
-> AttachmentStoreOp
-> ImageLayout
-> ImageLayout
-> AttachmentDescription2 es
AttachmentDescription2
             Chain es
next AttachmentDescriptionFlags
flags Format
format SampleCountFlagBits
samples AttachmentLoadOp
loadOp AttachmentStoreOp
storeOp AttachmentLoadOp
stencilLoadOp AttachmentStoreOp
stencilStoreOp ImageLayout
initialLayout ImageLayout
finalLayout

instance es ~ '[] => Zero (AttachmentDescription2 es) where
  zero :: AttachmentDescription2 es
zero = Chain es
-> AttachmentDescriptionFlags
-> Format
-> SampleCountFlagBits
-> AttachmentLoadOp
-> AttachmentStoreOp
-> AttachmentLoadOp
-> AttachmentStoreOp
-> ImageLayout
-> ImageLayout
-> AttachmentDescription2 es
forall (es :: [*]).
Chain es
-> AttachmentDescriptionFlags
-> Format
-> SampleCountFlagBits
-> AttachmentLoadOp
-> AttachmentStoreOp
-> AttachmentLoadOp
-> AttachmentStoreOp
-> ImageLayout
-> ImageLayout
-> AttachmentDescription2 es
AttachmentDescription2
           ()
           AttachmentDescriptionFlags
forall a. Zero a => a
zero
           Format
forall a. Zero a => a
zero
           SampleCountFlagBits
forall a. Zero a => a
zero
           AttachmentLoadOp
forall a. Zero a => a
zero
           AttachmentStoreOp
forall a. Zero a => a
zero
           AttachmentLoadOp
forall a. Zero a => a
zero
           AttachmentStoreOp
forall a. Zero a => a
zero
           ImageLayout
forall a. Zero a => a
zero
           ImageLayout
forall a. Zero a => a
zero


-- | VkAttachmentReference2 - Structure specifying an attachment reference
--
-- = Description
--
-- Parameters defined by this structure with the same name as those in
-- 'Vulkan.Core10.Pass.AttachmentReference' have the identical effect to
-- those parameters.
--
-- @aspectMask@ is ignored when this structure is used to describe anything
-- other than an input attachment reference.
--
-- If the
-- <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#features-separateDepthStencilLayouts separateDepthStencilLayouts>
-- feature is enabled, and @attachment@ has a depth\/stencil format,
-- @layout@ /can/ be set to a layout that only specifies the layout of the
-- depth aspect.
--
-- If @layout@ only specifies the layout of the depth aspect of the
-- attachment, the layout of the stencil aspect is specified by the
-- @stencilLayout@ member of a
-- 'Vulkan.Core12.Promoted_From_VK_KHR_separate_depth_stencil_layouts.AttachmentReferenceStencilLayout'
-- structure included in the @pNext@ chain. Otherwise, @layout@ describes
-- the layout for all relevant image aspects.
--
-- == Valid Usage
--
-- -   #VUID-VkAttachmentReference2-layout-03077# If @attachment@ is not
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED', @layout@ /must/ not
--     be 'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_UNDEFINED',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_PREINITIALIZED', or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_PRESENT_SRC_KHR'
--
-- -   #VUID-VkAttachmentReference2-separateDepthStencilLayouts-03313# If
--     the
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#features-separateDepthStencilLayouts separateDepthStencilLayouts>
--     feature is not enabled, and @attachment@ is not
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED', @layout@ /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-VkAttachmentReference2-attachment-04754# If @attachment@ is
--     not 'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED', and the format
--     of the referenced attachment is a color format, @layout@ /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-VkAttachmentReference2-attachment-04755# If @attachment@ is
--     not 'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED', and the format
--     of the referenced attachment is a depth\/stencil format which
--     includes both depth and stencil aspects, and @layout@ is
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_OPTIMAL'
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_OPTIMAL',
--     the @pNext@ chain /must/ include a
--     'Vulkan.Core12.Promoted_From_VK_KHR_separate_depth_stencil_layouts.AttachmentReferenceStencilLayout'
--     structure
--
-- -   #VUID-VkAttachmentReference2-attachment-04756# If @attachment@ is
--     not 'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED', and the format
--     of the referenced attachment is a depth\/stencil format which
--     includes only the depth aspect, @layout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_STENCIL_ATTACHMENT_OPTIMAL'
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_STENCIL_READ_ONLY_OPTIMAL'
--
-- -   #VUID-VkAttachmentReference2-attachment-04757# If @attachment@ is
--     not 'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED', and the format
--     of the referenced attachment is a depth\/stencil format which
--     includes only the stencil aspect, @layout@ /must/ not be
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_OPTIMAL'
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_OPTIMAL'
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkAttachmentReference2-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_ATTACHMENT_REFERENCE_2'
--
-- -   #VUID-VkAttachmentReference2-pNext-pNext# @pNext@ /must/ be @NULL@
--     or a pointer to a valid instance of
--     'Vulkan.Core12.Promoted_From_VK_KHR_separate_depth_stencil_layouts.AttachmentReferenceStencilLayout'
--
-- -   #VUID-VkAttachmentReference2-sType-unique# The @sType@ value of each
--     struct in the @pNext@ chain /must/ be unique
--
-- -   #VUID-VkAttachmentReference2-layout-parameter# @layout@ /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_create_renderpass2 VK_KHR_create_renderpass2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_2 VK_VERSION_1_2>,
-- 'Vulkan.Extensions.VK_KHR_fragment_shading_rate.FragmentShadingRateAttachmentInfoKHR',
-- 'Vulkan.Core10.Enums.ImageAspectFlagBits.ImageAspectFlags',
-- 'Vulkan.Core10.Enums.ImageLayout.ImageLayout',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'SubpassDescription2',
-- 'Vulkan.Core12.Promoted_From_VK_KHR_depth_stencil_resolve.SubpassDescriptionDepthStencilResolve'
data AttachmentReference2 (es :: [Type]) = AttachmentReference2
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    AttachmentReference2 es -> Chain es
next :: Chain es
  , -- | @attachment@ is either an integer value identifying an attachment at the
    -- corresponding index in 'RenderPassCreateInfo2'::@pAttachments@, or
    -- 'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED' to signify that this
    -- attachment is not used.
    AttachmentReference2 es -> Word32
attachment :: Word32
  , -- | @layout@ is a 'Vulkan.Core10.Enums.ImageLayout.ImageLayout' value
    -- specifying the layout the attachment uses during the subpass.
    AttachmentReference2 es -> ImageLayout
layout :: ImageLayout
  , -- | @aspectMask@ is a mask of which aspect(s) /can/ be accessed within the
    -- specified subpass as an input attachment.
    AttachmentReference2 es -> ImageAspectFlags
aspectMask :: ImageAspectFlags
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (AttachmentReference2 (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (AttachmentReference2 es)

instance Extensible AttachmentReference2 where
  extensibleTypeName :: String
extensibleTypeName = String
"AttachmentReference2"
  setNext :: AttachmentReference2 ds -> Chain es -> AttachmentReference2 es
setNext AttachmentReference2{Word32
Chain ds
ImageLayout
ImageAspectFlags
aspectMask :: ImageAspectFlags
layout :: ImageLayout
attachment :: Word32
next :: Chain ds
$sel:aspectMask:AttachmentReference2 :: forall (es :: [*]). AttachmentReference2 es -> ImageAspectFlags
$sel:layout:AttachmentReference2 :: forall (es :: [*]). AttachmentReference2 es -> ImageLayout
$sel:attachment:AttachmentReference2 :: forall (es :: [*]). AttachmentReference2 es -> Word32
$sel:next:AttachmentReference2 :: forall (es :: [*]). AttachmentReference2 es -> Chain es
..} Chain es
next' = AttachmentReference2 :: forall (es :: [*]).
Chain es
-> Word32
-> ImageLayout
-> ImageAspectFlags
-> AttachmentReference2 es
AttachmentReference2{$sel:next:AttachmentReference2 :: Chain es
next = Chain es
next', Word32
ImageLayout
ImageAspectFlags
aspectMask :: ImageAspectFlags
layout :: ImageLayout
attachment :: Word32
$sel:aspectMask:AttachmentReference2 :: ImageAspectFlags
$sel:layout:AttachmentReference2 :: ImageLayout
$sel:attachment:AttachmentReference2 :: Word32
..}
  getNext :: AttachmentReference2 es -> Chain es
getNext AttachmentReference2{Word32
Chain es
ImageLayout
ImageAspectFlags
aspectMask :: ImageAspectFlags
layout :: ImageLayout
attachment :: Word32
next :: Chain es
$sel:aspectMask:AttachmentReference2 :: forall (es :: [*]). AttachmentReference2 es -> ImageAspectFlags
$sel:layout:AttachmentReference2 :: forall (es :: [*]). AttachmentReference2 es -> ImageLayout
$sel:attachment:AttachmentReference2 :: forall (es :: [*]). AttachmentReference2 es -> Word32
$sel:next:AttachmentReference2 :: forall (es :: [*]). AttachmentReference2 es -> Chain es
..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends AttachmentReference2 e => b) -> Maybe b
  extends :: proxy e -> (Extends AttachmentReference2 e => b) -> Maybe b
extends proxy e
_ Extends AttachmentReference2 e => b
f
    | Just e :~: AttachmentReferenceStencilLayout
Refl <- (Typeable e, Typeable AttachmentReferenceStencilLayout) =>
Maybe (e :~: AttachmentReferenceStencilLayout)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @AttachmentReferenceStencilLayout = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends AttachmentReference2 e => b
f
    | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing

instance (Extendss AttachmentReference2 es, PokeChain es) => ToCStruct (AttachmentReference2 es) where
  withCStruct :: AttachmentReference2 es
-> (Ptr (AttachmentReference2 es) -> IO b) -> IO b
withCStruct AttachmentReference2 es
x Ptr (AttachmentReference2 es) -> IO b
f = Int -> (Ptr (AttachmentReference2 es) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr (AttachmentReference2 es) -> IO b) -> IO b)
-> (Ptr (AttachmentReference2 es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr (AttachmentReference2 es)
p -> Ptr (AttachmentReference2 es)
-> AttachmentReference2 es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (AttachmentReference2 es)
p AttachmentReference2 es
x (Ptr (AttachmentReference2 es) -> IO b
f Ptr (AttachmentReference2 es)
p)
  pokeCStruct :: Ptr (AttachmentReference2 es)
-> AttachmentReference2 es -> IO b -> IO b
pokeCStruct Ptr (AttachmentReference2 es)
p AttachmentReference2{Word32
Chain es
ImageLayout
ImageAspectFlags
aspectMask :: ImageAspectFlags
layout :: ImageLayout
attachment :: Word32
next :: Chain es
$sel:aspectMask:AttachmentReference2 :: forall (es :: [*]). AttachmentReference2 es -> ImageAspectFlags
$sel:layout:AttachmentReference2 :: forall (es :: [*]). AttachmentReference2 es -> ImageLayout
$sel:attachment:AttachmentReference2 :: forall (es :: [*]). AttachmentReference2 es -> Word32
$sel:next:AttachmentReference2 :: forall (es :: [*]). AttachmentReference2 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 (AttachmentReference2 es)
p Ptr (AttachmentReference2 es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_ATTACHMENT_REFERENCE_2)
    Ptr ()
pNext'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (AttachmentReference2 es)
p Ptr (AttachmentReference2 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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (AttachmentReference2 es)
p Ptr (AttachmentReference2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
attachment)
    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 (AttachmentReference2 es)
p Ptr (AttachmentReference2 es) -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr ImageLayout)) (ImageLayout
layout)
    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 ImageAspectFlags -> ImageAspectFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (AttachmentReference2 es)
p Ptr (AttachmentReference2 es) -> Int -> Ptr ImageAspectFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageAspectFlags)) (ImageAspectFlags
aspectMask)
    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
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr (AttachmentReference2 es) -> IO b -> IO b
pokeZeroCStruct Ptr (AttachmentReference2 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 (AttachmentReference2 es)
p Ptr (AttachmentReference2 es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_ATTACHMENT_REFERENCE_2)
    Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall 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 (AttachmentReference2 es)
p Ptr (AttachmentReference2 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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (AttachmentReference2 es)
p Ptr (AttachmentReference2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: 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 ImageLayout -> ImageLayout -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (AttachmentReference2 es)
p Ptr (AttachmentReference2 es) -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: 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 ImageAspectFlags -> ImageAspectFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (AttachmentReference2 es)
p Ptr (AttachmentReference2 es) -> Int -> Ptr ImageAspectFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageAspectFlags)) (ImageAspectFlags
forall a. Zero a => a
zero)
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

instance (Extendss AttachmentReference2 es, PeekChain es) => FromCStruct (AttachmentReference2 es) where
  peekCStruct :: Ptr (AttachmentReference2 es) -> IO (AttachmentReference2 es)
peekCStruct Ptr (AttachmentReference2 es)
p = do
    Ptr ()
pNext <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (AttachmentReference2 es)
p Ptr (AttachmentReference2 es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ())))
    Chain es
next <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
    Word32
attachment <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (AttachmentReference2 es)
p Ptr (AttachmentReference2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    ImageLayout
layout <- Ptr ImageLayout -> IO ImageLayout
forall a. Storable a => Ptr a -> IO a
peek @ImageLayout ((Ptr (AttachmentReference2 es)
p Ptr (AttachmentReference2 es) -> Int -> Ptr ImageLayout
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr ImageLayout))
    ImageAspectFlags
aspectMask <- Ptr ImageAspectFlags -> IO ImageAspectFlags
forall a. Storable a => Ptr a -> IO a
peek @ImageAspectFlags ((Ptr (AttachmentReference2 es)
p Ptr (AttachmentReference2 es) -> Int -> Ptr ImageAspectFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr ImageAspectFlags))
    AttachmentReference2 es -> IO (AttachmentReference2 es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AttachmentReference2 es -> IO (AttachmentReference2 es))
-> AttachmentReference2 es -> IO (AttachmentReference2 es)
forall a b. (a -> b) -> a -> b
$ Chain es
-> Word32
-> ImageLayout
-> ImageAspectFlags
-> AttachmentReference2 es
forall (es :: [*]).
Chain es
-> Word32
-> ImageLayout
-> ImageAspectFlags
-> AttachmentReference2 es
AttachmentReference2
             Chain es
next Word32
attachment ImageLayout
layout ImageAspectFlags
aspectMask

instance es ~ '[] => Zero (AttachmentReference2 es) where
  zero :: AttachmentReference2 es
zero = Chain es
-> Word32
-> ImageLayout
-> ImageAspectFlags
-> AttachmentReference2 es
forall (es :: [*]).
Chain es
-> Word32
-> ImageLayout
-> ImageAspectFlags
-> AttachmentReference2 es
AttachmentReference2
           ()
           Word32
forall a. Zero a => a
zero
           ImageLayout
forall a. Zero a => a
zero
           ImageAspectFlags
forall a. Zero a => a
zero


-- | VkSubpassDescription2 - Structure specifying a subpass description
--
-- = Description
--
-- Parameters defined by this structure with the same name as those in
-- 'Vulkan.Core10.Pass.SubpassDescription' have the identical effect to
-- those parameters.
--
-- @viewMask@ has the same effect for the described subpass as
-- 'Vulkan.Core11.Promoted_From_VK_KHR_multiview.RenderPassMultiviewCreateInfo'::@pViewMasks@
-- has on each corresponding subpass.
--
-- If a
-- 'Vulkan.Extensions.VK_KHR_fragment_shading_rate.FragmentShadingRateAttachmentInfoKHR'
-- structure is included in the @pNext@ chain,
-- @pFragmentShadingRateAttachment@ is not @NULL@, and its @attachment@
-- member is not 'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED', the
-- identified attachment defines a fragment shading rate attachment for
-- that subpass.
--
-- == Valid Usage
--
-- -   #VUID-VkSubpassDescription2-pipelineBindPoint-04953#
--     @pipelineBindPoint@ /must/ be
--     'Vulkan.Core10.Enums.PipelineBindPoint.PIPELINE_BIND_POINT_GRAPHICS'
--     or
--     'Vulkan.Core10.Enums.PipelineBindPoint.PIPELINE_BIND_POINT_SUBPASS_SHADING_HUAWEI'
--
-- -   #VUID-VkSubpassDescription2-colorAttachmentCount-03063#
--     @colorAttachmentCount@ /must/ be less than or equal to
--     'Vulkan.Core10.DeviceInitialization.PhysicalDeviceLimits'::@maxColorAttachments@
--
-- -   #VUID-VkSubpassDescription2-loadOp-03064# If the first use of an
--     attachment in this render pass is as an input attachment, and the
--     attachment is not also used as a color or depth\/stencil attachment
--     in the same subpass, then @loadOp@ /must/ not be
--     'Vulkan.Core10.Enums.AttachmentLoadOp.ATTACHMENT_LOAD_OP_CLEAR'
--
-- -   #VUID-VkSubpassDescription2-pResolveAttachments-03065# If
--     @pResolveAttachments@ is not @NULL@, for each resolve attachment
--     that does not have the value
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED', the corresponding
--     color attachment /must/ not have the value
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED'
--
-- -   #VUID-VkSubpassDescription2-pResolveAttachments-03066# If
--     @pResolveAttachments@ is not @NULL@, for each resolve attachment
--     that is not 'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED', the
--     corresponding color attachment /must/ not have a sample count of
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SAMPLE_COUNT_1_BIT'
--
-- -   #VUID-VkSubpassDescription2-pResolveAttachments-03067# If
--     @pResolveAttachments@ is not @NULL@, each resolve attachment that is
--     not 'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED' /must/ have a
--     sample count of
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SAMPLE_COUNT_1_BIT'
--
-- -   #VUID-VkSubpassDescription2-pResolveAttachments-03068# Any given
--     element of @pResolveAttachments@ /must/ have the same
--     'Vulkan.Core10.Enums.Format.Format' as its corresponding color
--     attachment
--
-- -   #VUID-VkSubpassDescription2-pColorAttachments-03069# All attachments
--     in @pColorAttachments@ that are not
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED' /must/ have the same
--     sample count
--
-- -   #VUID-VkSubpassDescription2-pInputAttachments-02897# All attachments
--     in @pInputAttachments@ that are not
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED' /must/ have image
--     formats whose
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#potential-format-features potential format features>
--     contain at least
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_COLOR_ATTACHMENT_BIT'
--     or
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_DEPTH_STENCIL_ATTACHMENT_BIT'
--
-- -   #VUID-VkSubpassDescription2-pColorAttachments-02898# All attachments
--     in @pColorAttachments@ that are not
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED' /must/ have image
--     formats whose
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#potential-format-features potential format features>
--     contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_COLOR_ATTACHMENT_BIT'
--
-- -   #VUID-VkSubpassDescription2-pResolveAttachments-02899# All
--     attachments in @pResolveAttachments@ that are not
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED' /must/ have image
--     formats whose
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#potential-format-features potential format features>
--     contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_COLOR_ATTACHMENT_BIT'
--
-- -   #VUID-VkSubpassDescription2-pDepthStencilAttachment-02900# If
--     @pDepthStencilAttachment@ is not @NULL@ and the attachment is not
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED' then it /must/ have
--     an image format whose
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#potential-format-features potential format features>
--     contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_DEPTH_STENCIL_ATTACHMENT_BIT'
--
-- -   #VUID-VkSubpassDescription2-linearColorAttachment-06499# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#features-linearColorAttachment linearColorAttachment>
--     feature is enabled and the image is created with
--     'Vulkan.Core10.Enums.ImageTiling.IMAGE_TILING_LINEAR', all
--     attachments in @pInputAttachments@ that are not
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED' /must/ have image
--     formats whose
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#potential-format-features potential format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_LINEAR_COLOR_ATTACHMENT_BIT_NV'
--
-- -   #VUID-VkSubpassDescription2-linearColorAttachment-06500# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#features-linearColorAttachment linearColorAttachment>
--     feature is enabled and the image is created with
--     'Vulkan.Core10.Enums.ImageTiling.IMAGE_TILING_LINEAR', all
--     attachments in @pColorAttachments@ that are not
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED' /must/ have image
--     formats whose
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#potential-format-features potential format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_LINEAR_COLOR_ATTACHMENT_BIT_NV'
--
-- -   #VUID-VkSubpassDescription2-linearColorAttachment-06501# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#features-linearColorAttachment linearColorAttachment>
--     feature is enabled and the image is created with
--     'Vulkan.Core10.Enums.ImageTiling.IMAGE_TILING_LINEAR', all
--     attachments in @pResolveAttachments@ that are not
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED' /must/ have image
--     formats whose
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#potential-format-features potential format features>
--     /must/ contain
--     'Vulkan.Core13.Enums.FormatFeatureFlags2.FORMAT_FEATURE_2_LINEAR_COLOR_ATTACHMENT_BIT_NV'
--
-- -   #VUID-VkSubpassDescription2-pColorAttachments-03070# If the
--     @VK_AMD_mixed_attachment_samples@ extension is enabled, all
--     attachments in @pColorAttachments@ that are not
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED' /must/ have a sample
--     count that is smaller than or equal to the sample count of
--     @pDepthStencilAttachment@ if it is not
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED'
--
-- -   #VUID-VkSubpassDescription2-pDepthStencilAttachment-03071# If
--     neither the @VK_AMD_mixed_attachment_samples@ nor the
--     @VK_NV_framebuffer_mixed_samples@ extensions are enabled, and if
--     @pDepthStencilAttachment@ is not
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED' and any attachments
--     in @pColorAttachments@ are not
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED', they /must/ have the
--     same sample count
--
-- -   #VUID-VkSubpassDescription2-attachment-03073# Each element of
--     @pPreserveAttachments@ /must/ not be
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED'
--
-- -   #VUID-VkSubpassDescription2-pPreserveAttachments-03074# Any given
--     element of @pPreserveAttachments@ /must/ not also be an element of
--     any other member of the subpass description
--
-- -   #VUID-VkSubpassDescription2-layout-02528# If any attachment is used
--     by more than one 'AttachmentReference2' member, then each use /must/
--     use the same @layout@
--
-- -   #VUID-VkSubpassDescription2-None-04439# Attachments /must/ follow
--     the
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#attachment-type-imagelayout image layout requirements>
--     based on the type of attachment it is being used as
--
-- -   #VUID-VkSubpassDescription2-flags-03076# If @flags@ includes
--     'Vulkan.Core10.Enums.SubpassDescriptionFlagBits.SUBPASS_DESCRIPTION_PER_VIEW_POSITION_X_ONLY_BIT_NVX',
--     it /must/ also include
--     'Vulkan.Core10.Enums.SubpassDescriptionFlagBits.SUBPASS_DESCRIPTION_PER_VIEW_ATTRIBUTES_BIT_NVX'
--
-- -   #VUID-VkSubpassDescription2-attachment-02799# If the @attachment@
--     member of any element of @pInputAttachments@ is not
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED', then the
--     @aspectMask@ member /must/ be a valid combination of
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.ImageAspectFlagBits'
--
-- -   #VUID-VkSubpassDescription2-attachment-02800# If the @attachment@
--     member of any element of @pInputAttachments@ is not
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED', then the
--     @aspectMask@ member /must/ not be @0@
--
-- -   #VUID-VkSubpassDescription2-attachment-02801# If the @attachment@
--     member of any element of @pInputAttachments@ is not
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED', then the
--     @aspectMask@ member /must/ not include
--     'Vulkan.Core10.Enums.ImageAspectFlagBits.IMAGE_ASPECT_METADATA_BIT'
--
-- -   #VUID-VkSubpassDescription2-attachment-04563# If the @attachment@
--     member of any element of @pInputAttachments@ is not
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED', then the
--     @aspectMask@ member /must/ not include
--     @VK_IMAGE_ASPECT_MEMORY_PLANE_i_BIT_EXT@ for any index /i/
--
-- -   #VUID-VkSubpassDescription2-pDepthStencilAttachment-04440# An
--     attachment /must/ not be used in both @pDepthStencilAttachment@ and
--     @pColorAttachments@
--
-- -   #VUID-VkSubpassDescription2-multiview-06558# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#features-multiview multiview>
--     feature is not enabled, @viewMask@ /must/ be @0@
--
-- -   #VUID-VkSubpassDescription2-viewMask-06706# The index of the most
--     significant bit in @viewMask@ /must/ be less than
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#limits-maxMultiviewViewCount maxMultiviewViewCount>
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkSubpassDescription2-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SUBPASS_DESCRIPTION_2'
--
-- -   #VUID-VkSubpassDescription2-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.Extensions.VK_KHR_fragment_shading_rate.FragmentShadingRateAttachmentInfoKHR'
--     or
--     'Vulkan.Core12.Promoted_From_VK_KHR_depth_stencil_resolve.SubpassDescriptionDepthStencilResolve'
--
-- -   #VUID-VkSubpassDescription2-sType-unique# The @sType@ value of each
--     struct in the @pNext@ chain /must/ be unique
--
-- -   #VUID-VkSubpassDescription2-flags-parameter# @flags@ /must/ be a
--     valid combination of
--     'Vulkan.Core10.Enums.SubpassDescriptionFlagBits.SubpassDescriptionFlagBits'
--     values
--
-- -   #VUID-VkSubpassDescription2-pipelineBindPoint-parameter#
--     @pipelineBindPoint@ /must/ be a valid
--     'Vulkan.Core10.Enums.PipelineBindPoint.PipelineBindPoint' value
--
-- -   #VUID-VkSubpassDescription2-pInputAttachments-parameter# If
--     @inputAttachmentCount@ is not @0@, @pInputAttachments@ /must/ be a
--     valid pointer to an array of @inputAttachmentCount@ valid
--     'AttachmentReference2' structures
--
-- -   #VUID-VkSubpassDescription2-pColorAttachments-parameter# If
--     @colorAttachmentCount@ is not @0@, @pColorAttachments@ /must/ be a
--     valid pointer to an array of @colorAttachmentCount@ valid
--     'AttachmentReference2' structures
--
-- -   #VUID-VkSubpassDescription2-pResolveAttachments-parameter# If
--     @colorAttachmentCount@ is not @0@, and @pResolveAttachments@ is not
--     @NULL@, @pResolveAttachments@ /must/ be a valid pointer to an array
--     of @colorAttachmentCount@ valid 'AttachmentReference2' structures
--
-- -   #VUID-VkSubpassDescription2-pDepthStencilAttachment-parameter# If
--     @pDepthStencilAttachment@ is not @NULL@, @pDepthStencilAttachment@
--     /must/ be a valid pointer to a valid 'AttachmentReference2'
--     structure
--
-- -   #VUID-VkSubpassDescription2-pPreserveAttachments-parameter# If
--     @preserveAttachmentCount@ is not @0@, @pPreserveAttachments@ /must/
--     be a valid pointer to an array of @preserveAttachmentCount@
--     @uint32_t@ values
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_create_renderpass2 VK_KHR_create_renderpass2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_2 VK_VERSION_1_2>,
-- 'AttachmentReference2',
-- 'Vulkan.Core10.Enums.PipelineBindPoint.PipelineBindPoint',
-- 'RenderPassCreateInfo2',
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'Vulkan.Core10.Enums.SubpassDescriptionFlagBits.SubpassDescriptionFlags'
data SubpassDescription2 (es :: [Type]) = SubpassDescription2
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    SubpassDescription2 es -> Chain es
next :: Chain es
  , -- | @flags@ is a bitmask of
    -- 'Vulkan.Core10.Enums.SubpassDescriptionFlagBits.SubpassDescriptionFlagBits'
    -- specifying usage of the subpass.
    SubpassDescription2 es -> SubpassDescriptionFlags
flags :: SubpassDescriptionFlags
  , -- | @pipelineBindPoint@ is a
    -- 'Vulkan.Core10.Enums.PipelineBindPoint.PipelineBindPoint' value
    -- specifying the pipeline type supported for this subpass.
    SubpassDescription2 es -> PipelineBindPoint
pipelineBindPoint :: PipelineBindPoint
  , -- | @viewMask@ is a bitfield of view indices describing which views
    -- rendering is broadcast to in this subpass, when multiview is enabled.
    SubpassDescription2 es -> Word32
viewMask :: Word32
  , -- | @pInputAttachments@ is a pointer to an array of 'AttachmentReference2'
    -- structures defining the input attachments for this subpass and their
    -- layouts.
    SubpassDescription2 es -> Vector (SomeStruct AttachmentReference2)
inputAttachments :: Vector (SomeStruct AttachmentReference2)
  , -- | @pColorAttachments@ is a pointer to an array of @colorAttachmentCount@
    -- 'AttachmentReference2' structures defining the color attachments for
    -- this subpass and their layouts.
    SubpassDescription2 es -> Vector (SomeStruct AttachmentReference2)
colorAttachments :: Vector (SomeStruct AttachmentReference2)
  , -- | @pResolveAttachments@ is @NULL@ or a pointer to an array of
    -- @colorAttachmentCount@ 'AttachmentReference2' structures defining the
    -- resolve attachments for this subpass and their layouts.
    SubpassDescription2 es -> Vector (SomeStruct AttachmentReference2)
resolveAttachments :: Vector (SomeStruct AttachmentReference2)
  , -- | @pDepthStencilAttachment@ is a pointer to a 'AttachmentReference2'
    -- structure specifying the depth\/stencil attachment for this subpass and
    -- its layout.
    SubpassDescription2 es -> Maybe (SomeStruct AttachmentReference2)
depthStencilAttachment :: Maybe (SomeStruct AttachmentReference2)
  , -- | @pPreserveAttachments@ is a pointer to an array of
    -- @preserveAttachmentCount@ render pass attachment indices identifying
    -- attachments that are not used by this subpass, but whose contents /must/
    -- be preserved throughout the subpass.
    SubpassDescription2 es -> Vector Word32
preserveAttachments :: Vector Word32
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SubpassDescription2 (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (SubpassDescription2 es)

instance Extensible SubpassDescription2 where
  extensibleTypeName :: String
extensibleTypeName = String
"SubpassDescription2"
  setNext :: SubpassDescription2 ds -> Chain es -> SubpassDescription2 es
setNext SubpassDescription2{Maybe (SomeStruct AttachmentReference2)
Word32
Vector Word32
Vector (SomeStruct AttachmentReference2)
Chain ds
PipelineBindPoint
SubpassDescriptionFlags
preserveAttachments :: Vector Word32
depthStencilAttachment :: Maybe (SomeStruct AttachmentReference2)
resolveAttachments :: Vector (SomeStruct AttachmentReference2)
colorAttachments :: Vector (SomeStruct AttachmentReference2)
inputAttachments :: Vector (SomeStruct AttachmentReference2)
viewMask :: Word32
pipelineBindPoint :: PipelineBindPoint
flags :: SubpassDescriptionFlags
next :: Chain ds
$sel:preserveAttachments:SubpassDescription2 :: forall (es :: [*]). SubpassDescription2 es -> Vector Word32
$sel:depthStencilAttachment:SubpassDescription2 :: forall (es :: [*]).
SubpassDescription2 es -> Maybe (SomeStruct AttachmentReference2)
$sel:resolveAttachments:SubpassDescription2 :: forall (es :: [*]).
SubpassDescription2 es -> Vector (SomeStruct AttachmentReference2)
$sel:colorAttachments:SubpassDescription2 :: forall (es :: [*]).
SubpassDescription2 es -> Vector (SomeStruct AttachmentReference2)
$sel:inputAttachments:SubpassDescription2 :: forall (es :: [*]).
SubpassDescription2 es -> Vector (SomeStruct AttachmentReference2)
$sel:viewMask:SubpassDescription2 :: forall (es :: [*]). SubpassDescription2 es -> Word32
$sel:pipelineBindPoint:SubpassDescription2 :: forall (es :: [*]). SubpassDescription2 es -> PipelineBindPoint
$sel:flags:SubpassDescription2 :: forall (es :: [*]).
SubpassDescription2 es -> SubpassDescriptionFlags
$sel:next:SubpassDescription2 :: forall (es :: [*]). SubpassDescription2 es -> Chain es
..} Chain es
next' = SubpassDescription2 :: forall (es :: [*]).
Chain es
-> SubpassDescriptionFlags
-> PipelineBindPoint
-> Word32
-> Vector (SomeStruct AttachmentReference2)
-> Vector (SomeStruct AttachmentReference2)
-> Vector (SomeStruct AttachmentReference2)
-> Maybe (SomeStruct AttachmentReference2)
-> Vector Word32
-> SubpassDescription2 es
SubpassDescription2{$sel:next:SubpassDescription2 :: Chain es
next = Chain es
next', Maybe (SomeStruct AttachmentReference2)
Word32
Vector Word32
Vector (SomeStruct AttachmentReference2)
PipelineBindPoint
SubpassDescriptionFlags
preserveAttachments :: Vector Word32
depthStencilAttachment :: Maybe (SomeStruct AttachmentReference2)
resolveAttachments :: Vector (SomeStruct AttachmentReference2)
colorAttachments :: Vector (SomeStruct AttachmentReference2)
inputAttachments :: Vector (SomeStruct AttachmentReference2)
viewMask :: Word32
pipelineBindPoint :: PipelineBindPoint
flags :: SubpassDescriptionFlags
$sel:preserveAttachments:SubpassDescription2 :: Vector Word32
$sel:depthStencilAttachment:SubpassDescription2 :: Maybe (SomeStruct AttachmentReference2)
$sel:resolveAttachments:SubpassDescription2 :: Vector (SomeStruct AttachmentReference2)
$sel:colorAttachments:SubpassDescription2 :: Vector (SomeStruct AttachmentReference2)
$sel:inputAttachments:SubpassDescription2 :: Vector (SomeStruct AttachmentReference2)
$sel:viewMask:SubpassDescription2 :: Word32
$sel:pipelineBindPoint:SubpassDescription2 :: PipelineBindPoint
$sel:flags:SubpassDescription2 :: SubpassDescriptionFlags
..}
  getNext :: SubpassDescription2 es -> Chain es
getNext SubpassDescription2{Maybe (SomeStruct AttachmentReference2)
Word32
Vector Word32
Vector (SomeStruct AttachmentReference2)
Chain es
PipelineBindPoint
SubpassDescriptionFlags
preserveAttachments :: Vector Word32
depthStencilAttachment :: Maybe (SomeStruct AttachmentReference2)
resolveAttachments :: Vector (SomeStruct AttachmentReference2)
colorAttachments :: Vector (SomeStruct AttachmentReference2)
inputAttachments :: Vector (SomeStruct AttachmentReference2)
viewMask :: Word32
pipelineBindPoint :: PipelineBindPoint
flags :: SubpassDescriptionFlags
next :: Chain es
$sel:preserveAttachments:SubpassDescription2 :: forall (es :: [*]). SubpassDescription2 es -> Vector Word32
$sel:depthStencilAttachment:SubpassDescription2 :: forall (es :: [*]).
SubpassDescription2 es -> Maybe (SomeStruct AttachmentReference2)
$sel:resolveAttachments:SubpassDescription2 :: forall (es :: [*]).
SubpassDescription2 es -> Vector (SomeStruct AttachmentReference2)
$sel:colorAttachments:SubpassDescription2 :: forall (es :: [*]).
SubpassDescription2 es -> Vector (SomeStruct AttachmentReference2)
$sel:inputAttachments:SubpassDescription2 :: forall (es :: [*]).
SubpassDescription2 es -> Vector (SomeStruct AttachmentReference2)
$sel:viewMask:SubpassDescription2 :: forall (es :: [*]). SubpassDescription2 es -> Word32
$sel:pipelineBindPoint:SubpassDescription2 :: forall (es :: [*]). SubpassDescription2 es -> PipelineBindPoint
$sel:flags:SubpassDescription2 :: forall (es :: [*]).
SubpassDescription2 es -> SubpassDescriptionFlags
$sel:next:SubpassDescription2 :: forall (es :: [*]). SubpassDescription2 es -> Chain es
..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends SubpassDescription2 e => b) -> Maybe b
  extends :: proxy e -> (Extends SubpassDescription2 e => b) -> Maybe b
extends proxy e
_ Extends SubpassDescription2 e => b
f
    | Just e :~: FragmentShadingRateAttachmentInfoKHR
Refl <- (Typeable e, Typeable FragmentShadingRateAttachmentInfoKHR) =>
Maybe (e :~: FragmentShadingRateAttachmentInfoKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @FragmentShadingRateAttachmentInfoKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SubpassDescription2 e => b
f
    | Just e :~: SubpassDescriptionDepthStencilResolve
Refl <- (Typeable e, Typeable SubpassDescriptionDepthStencilResolve) =>
Maybe (e :~: SubpassDescriptionDepthStencilResolve)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @SubpassDescriptionDepthStencilResolve = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SubpassDescription2 e => b
f
    | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing

instance (Extendss SubpassDescription2 es, PokeChain es) => ToCStruct (SubpassDescription2 es) where
  withCStruct :: SubpassDescription2 es
-> (Ptr (SubpassDescription2 es) -> IO b) -> IO b
withCStruct SubpassDescription2 es
x Ptr (SubpassDescription2 es) -> IO b
f = Int -> (Ptr (SubpassDescription2 es) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
88 ((Ptr (SubpassDescription2 es) -> IO b) -> IO b)
-> (Ptr (SubpassDescription2 es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr (SubpassDescription2 es)
p -> Ptr (SubpassDescription2 es)
-> SubpassDescription2 es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (SubpassDescription2 es)
p SubpassDescription2 es
x (Ptr (SubpassDescription2 es) -> IO b
f Ptr (SubpassDescription2 es)
p)
  pokeCStruct :: Ptr (SubpassDescription2 es)
-> SubpassDescription2 es -> IO b -> IO b
pokeCStruct Ptr (SubpassDescription2 es)
p SubpassDescription2{Maybe (SomeStruct AttachmentReference2)
Word32
Vector Word32
Vector (SomeStruct AttachmentReference2)
Chain es
PipelineBindPoint
SubpassDescriptionFlags
preserveAttachments :: Vector Word32
depthStencilAttachment :: Maybe (SomeStruct AttachmentReference2)
resolveAttachments :: Vector (SomeStruct AttachmentReference2)
colorAttachments :: Vector (SomeStruct AttachmentReference2)
inputAttachments :: Vector (SomeStruct AttachmentReference2)
viewMask :: Word32
pipelineBindPoint :: PipelineBindPoint
flags :: SubpassDescriptionFlags
next :: Chain es
$sel:preserveAttachments:SubpassDescription2 :: forall (es :: [*]). SubpassDescription2 es -> Vector Word32
$sel:depthStencilAttachment:SubpassDescription2 :: forall (es :: [*]).
SubpassDescription2 es -> Maybe (SomeStruct AttachmentReference2)
$sel:resolveAttachments:SubpassDescription2 :: forall (es :: [*]).
SubpassDescription2 es -> Vector (SomeStruct AttachmentReference2)
$sel:colorAttachments:SubpassDescription2 :: forall (es :: [*]).
SubpassDescription2 es -> Vector (SomeStruct AttachmentReference2)
$sel:inputAttachments:SubpassDescription2 :: forall (es :: [*]).
SubpassDescription2 es -> Vector (SomeStruct AttachmentReference2)
$sel:viewMask:SubpassDescription2 :: forall (es :: [*]). SubpassDescription2 es -> Word32
$sel:pipelineBindPoint:SubpassDescription2 :: forall (es :: [*]). SubpassDescription2 es -> PipelineBindPoint
$sel:flags:SubpassDescription2 :: forall (es :: [*]).
SubpassDescription2 es -> SubpassDescriptionFlags
$sel:next:SubpassDescription2 :: forall (es :: [*]). SubpassDescription2 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 (SubpassDescription2 es)
p Ptr (SubpassDescription2 es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SUBPASS_DESCRIPTION_2)
    Ptr ()
pNext'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SubpassDescription2 es)
p Ptr (SubpassDescription2 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 SubpassDescriptionFlags -> SubpassDescriptionFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SubpassDescription2 es)
p Ptr (SubpassDescription2 es) -> Int -> Ptr SubpassDescriptionFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr SubpassDescriptionFlags)) (SubpassDescriptionFlags
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 PipelineBindPoint -> PipelineBindPoint -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SubpassDescription2 es)
p Ptr (SubpassDescription2 es) -> Int -> Ptr PipelineBindPoint
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr PipelineBindPoint)) (PipelineBindPoint
pipelineBindPoint)
    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 (SubpassDescription2 es)
p Ptr (SubpassDescription2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: 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 (SubpassDescription2 es)
p Ptr (SubpassDescription2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector (SomeStruct AttachmentReference2) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (SomeStruct AttachmentReference2) -> Int)
-> Vector (SomeStruct AttachmentReference2) -> Int
forall a b. (a -> b) -> a -> b
$ (Vector (SomeStruct AttachmentReference2)
inputAttachments)) :: Word32))
    Ptr (AttachmentReference2 Any)
pPInputAttachments' <- ((Ptr (AttachmentReference2 Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (AttachmentReference2 Any))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (AttachmentReference2 Any) -> IO b) -> IO b)
 -> ContT b IO (Ptr (AttachmentReference2 Any)))
-> ((Ptr (AttachmentReference2 Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (AttachmentReference2 Any))
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr (AttachmentReference2 Any) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @(AttachmentReference2 _) ((Vector (SomeStruct AttachmentReference2) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (SomeStruct AttachmentReference2)
inputAttachments)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
32)
    (Int -> SomeStruct AttachmentReference2 -> ContT b IO ())
-> Vector (SomeStruct AttachmentReference2) -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i SomeStruct AttachmentReference2
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (SomeStruct AttachmentReference2)
-> SomeStruct AttachmentReference2 -> IO b -> IO b
forall (a :: [*] -> *) b.
(forall (es :: [*]).
 (Extendss a es, PokeChain es) =>
 ToCStruct (a es)) =>
Ptr (SomeStruct a) -> SomeStruct a -> IO b -> IO b
pokeSomeCStruct (Ptr (AttachmentReference2 Any)
-> Ptr (SomeStruct AttachmentReference2)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (AttachmentReference2 Any)
pPInputAttachments' Ptr (AttachmentReference2 Any)
-> Int -> Ptr (AttachmentReference2 _)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (AttachmentReference2 _))) (SomeStruct AttachmentReference2
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector (SomeStruct AttachmentReference2)
inputAttachments)
    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 (AttachmentReference2 Any))
-> Ptr (AttachmentReference2 Any) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SubpassDescription2 es)
p Ptr (SubpassDescription2 es)
-> Int -> Ptr (Ptr (AttachmentReference2 _))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr (AttachmentReference2 _)))) (Ptr (AttachmentReference2 Any)
pPInputAttachments')
    let pColorAttachmentsLength :: Int
pColorAttachmentsLength = Vector (SomeStruct AttachmentReference2) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (SomeStruct AttachmentReference2) -> Int)
-> Vector (SomeStruct AttachmentReference2) -> Int
forall a b. (a -> b) -> a -> b
$ (Vector (SomeStruct AttachmentReference2)
colorAttachments)
    let pResolveAttachmentsLength :: Int
pResolveAttachmentsLength = Vector (SomeStruct AttachmentReference2) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (SomeStruct AttachmentReference2) -> Int)
-> Vector (SomeStruct AttachmentReference2) -> Int
forall a b. (a -> b) -> a -> b
$ (Vector (SomeStruct AttachmentReference2)
resolveAttachments)
    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
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pResolveAttachmentsLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
pColorAttachmentsLength Bool -> Bool -> Bool
|| Int
pResolveAttachmentsLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (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
"pResolveAttachments and pColorAttachments must have the same length" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
    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 (SubpassDescription2 es)
p Ptr (SubpassDescription2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pColorAttachmentsLength :: Word32))
    Ptr (AttachmentReference2 Any)
pPColorAttachments' <- ((Ptr (AttachmentReference2 Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (AttachmentReference2 Any))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (AttachmentReference2 Any) -> IO b) -> IO b)
 -> ContT b IO (Ptr (AttachmentReference2 Any)))
-> ((Ptr (AttachmentReference2 Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (AttachmentReference2 Any))
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr (AttachmentReference2 Any) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @(AttachmentReference2 _) ((Vector (SomeStruct AttachmentReference2) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (SomeStruct AttachmentReference2)
colorAttachments)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
32)
    (Int -> SomeStruct AttachmentReference2 -> ContT b IO ())
-> Vector (SomeStruct AttachmentReference2) -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i SomeStruct AttachmentReference2
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (SomeStruct AttachmentReference2)
-> SomeStruct AttachmentReference2 -> IO b -> IO b
forall (a :: [*] -> *) b.
(forall (es :: [*]).
 (Extendss a es, PokeChain es) =>
 ToCStruct (a es)) =>
Ptr (SomeStruct a) -> SomeStruct a -> IO b -> IO b
pokeSomeCStruct (Ptr (AttachmentReference2 Any)
-> Ptr (SomeStruct AttachmentReference2)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (AttachmentReference2 Any)
pPColorAttachments' Ptr (AttachmentReference2 Any)
-> Int -> Ptr (AttachmentReference2 _)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (AttachmentReference2 _))) (SomeStruct AttachmentReference2
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector (SomeStruct AttachmentReference2)
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 (AttachmentReference2 Any))
-> Ptr (AttachmentReference2 Any) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SubpassDescription2 es)
p Ptr (SubpassDescription2 es)
-> Int -> Ptr (Ptr (AttachmentReference2 _))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr (Ptr (AttachmentReference2 _)))) (Ptr (AttachmentReference2 Any)
pPColorAttachments')
    Ptr (AttachmentReference2 Any)
pResolveAttachments'' <- if Vector (SomeStruct AttachmentReference2) -> Bool
forall a. Vector a -> Bool
Data.Vector.null (Vector (SomeStruct AttachmentReference2)
resolveAttachments)
      then Ptr (AttachmentReference2 Any)
-> ContT b IO (Ptr (AttachmentReference2 Any))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr (AttachmentReference2 Any)
forall a. Ptr a
nullPtr
      else do
        Ptr (AttachmentReference2 Any)
pPResolveAttachments <- ((Ptr (AttachmentReference2 Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (AttachmentReference2 Any))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (AttachmentReference2 Any) -> IO b) -> IO b)
 -> ContT b IO (Ptr (AttachmentReference2 Any)))
-> ((Ptr (AttachmentReference2 Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (AttachmentReference2 Any))
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr (AttachmentReference2 Any) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @(AttachmentReference2 _) (((Vector (SomeStruct AttachmentReference2) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (SomeStruct AttachmentReference2)
resolveAttachments))) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
32)
        (Int -> SomeStruct AttachmentReference2 -> ContT b IO ())
-> Vector (SomeStruct AttachmentReference2) -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i SomeStruct AttachmentReference2
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (SomeStruct AttachmentReference2)
-> SomeStruct AttachmentReference2 -> IO b -> IO b
forall (a :: [*] -> *) b.
(forall (es :: [*]).
 (Extendss a es, PokeChain es) =>
 ToCStruct (a es)) =>
Ptr (SomeStruct a) -> SomeStruct a -> IO b -> IO b
pokeSomeCStruct (Ptr (AttachmentReference2 Any)
-> Ptr (SomeStruct AttachmentReference2)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (AttachmentReference2 Any)
pPResolveAttachments Ptr (AttachmentReference2 Any)
-> Int -> Ptr (AttachmentReference2 _)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (AttachmentReference2 _))) (SomeStruct AttachmentReference2
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) ((Vector (SomeStruct AttachmentReference2)
resolveAttachments))
        Ptr (AttachmentReference2 Any)
-> ContT b IO (Ptr (AttachmentReference2 Any))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr (AttachmentReference2 Any)
 -> ContT b IO (Ptr (AttachmentReference2 Any)))
-> Ptr (AttachmentReference2 Any)
-> ContT b IO (Ptr (AttachmentReference2 Any))
forall a b. (a -> b) -> a -> b
$ Ptr (AttachmentReference2 Any)
pPResolveAttachments
    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 (AttachmentReference2 Any))
-> Ptr (AttachmentReference2 Any) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SubpassDescription2 es)
p Ptr (SubpassDescription2 es)
-> Int -> Ptr (Ptr (AttachmentReference2 _))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr (Ptr (AttachmentReference2 _)))) Ptr (AttachmentReference2 Any)
pResolveAttachments''
    Ptr (AttachmentReference2 '[])
pDepthStencilAttachment'' <- case (Maybe (SomeStruct AttachmentReference2)
depthStencilAttachment) of
      Maybe (SomeStruct AttachmentReference2)
Nothing -> Ptr (AttachmentReference2 '[])
-> ContT b IO (Ptr (AttachmentReference2 '[]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr (AttachmentReference2 '[])
forall a. Ptr a
nullPtr
      Just SomeStruct AttachmentReference2
j -> ((Ptr (AttachmentReference2 '[]) -> IO b) -> IO b)
-> ContT b IO (Ptr (AttachmentReference2 '[]))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT @_ @_ @(Ptr (AttachmentReference2 '[])) (((Ptr (AttachmentReference2 '[]) -> IO b) -> IO b)
 -> ContT b IO (Ptr (AttachmentReference2 '[])))
-> ((Ptr (AttachmentReference2 '[]) -> IO b) -> IO b)
-> ContT b IO (Ptr (AttachmentReference2 '[]))
forall a b. (a -> b) -> a -> b
$ \Ptr (AttachmentReference2 '[]) -> IO b
cont -> SomeStruct AttachmentReference2
-> (forall (es :: [*]).
    (Extendss AttachmentReference2 es, PokeChain es) =>
    Ptr (AttachmentReference2 es) -> IO b)
-> IO b
forall (a :: [*] -> *) b.
(forall (es :: [*]).
 (Extendss a es, PokeChain es) =>
 ToCStruct (a es)) =>
SomeStruct a
-> (forall (es :: [*]).
    (Extendss a es, PokeChain es) =>
    Ptr (a es) -> IO b)
-> IO b
withSomeCStruct @AttachmentReference2 (SomeStruct AttachmentReference2
j) (Ptr (AttachmentReference2 '[]) -> IO b
cont (Ptr (AttachmentReference2 '[]) -> IO b)
-> (Ptr (AttachmentReference2 es)
    -> Ptr (AttachmentReference2 '[]))
-> Ptr (AttachmentReference2 es)
-> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (AttachmentReference2 es) -> Ptr (AttachmentReference2 '[])
forall a b. Ptr a -> Ptr b
castPtr)
    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 (AttachmentReference2 '[]))
-> Ptr (AttachmentReference2 '[]) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SubpassDescription2 es)
p Ptr (SubpassDescription2 es)
-> Int -> Ptr (Ptr (AttachmentReference2 _))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr (Ptr (AttachmentReference2 _)))) Ptr (AttachmentReference2 '[])
pDepthStencilAttachment''
    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 (SubpassDescription2 es)
p Ptr (SubpassDescription2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word32 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Word32 -> Int) -> Vector Word32 -> Int
forall a b. (a -> b) -> a -> b
$ (Vector Word32
preserveAttachments)) :: Word32))
    Ptr Word32
pPPreserveAttachments' <- ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32))
-> ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr Word32 -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @Word32 ((Vector Word32 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Word32
preserveAttachments)) 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 -> Word32 -> IO ()) -> Vector Word32 -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Word32
e -> Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word32
pPPreserveAttachments' Ptr Word32 -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32) (Word32
e)) (Vector Word32
preserveAttachments)
    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 Word32) -> Ptr Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SubpassDescription2 es)
p Ptr (SubpassDescription2 es) -> Int -> Ptr (Ptr Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80 :: Ptr (Ptr Word32))) (Ptr Word32
pPPreserveAttachments')
    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
88
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr (SubpassDescription2 es) -> IO b -> IO b
pokeZeroCStruct Ptr (SubpassDescription2 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 (SubpassDescription2 es)
p Ptr (SubpassDescription2 es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SUBPASS_DESCRIPTION_2)
    Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall 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 (SubpassDescription2 es)
p Ptr (SubpassDescription2 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 PipelineBindPoint -> PipelineBindPoint -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SubpassDescription2 es)
p Ptr (SubpassDescription2 es) -> Int -> Ptr PipelineBindPoint
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr PipelineBindPoint)) (PipelineBindPoint
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 (SubpassDescription2 es)
p Ptr (SubpassDescription2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

instance (Extendss SubpassDescription2 es, PeekChain es) => FromCStruct (SubpassDescription2 es) where
  peekCStruct :: Ptr (SubpassDescription2 es) -> IO (SubpassDescription2 es)
peekCStruct Ptr (SubpassDescription2 es)
p = do
    Ptr ()
pNext <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (SubpassDescription2 es)
p Ptr (SubpassDescription2 es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ())))
    Chain es
next <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
    SubpassDescriptionFlags
flags <- Ptr SubpassDescriptionFlags -> IO SubpassDescriptionFlags
forall a. Storable a => Ptr a -> IO a
peek @SubpassDescriptionFlags ((Ptr (SubpassDescription2 es)
p Ptr (SubpassDescription2 es) -> Int -> Ptr SubpassDescriptionFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr SubpassDescriptionFlags))
    PipelineBindPoint
pipelineBindPoint <- Ptr PipelineBindPoint -> IO PipelineBindPoint
forall a. Storable a => Ptr a -> IO a
peek @PipelineBindPoint ((Ptr (SubpassDescription2 es)
p Ptr (SubpassDescription2 es) -> Int -> Ptr PipelineBindPoint
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr PipelineBindPoint))
    Word32
viewMask <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (SubpassDescription2 es)
p Ptr (SubpassDescription2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32))
    Word32
inputAttachmentCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (SubpassDescription2 es)
p Ptr (SubpassDescription2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32))
    Ptr (AttachmentReference2 Any)
pInputAttachments <- Ptr (Ptr (AttachmentReference2 Any))
-> IO (Ptr (AttachmentReference2 Any))
forall a. Storable a => Ptr a -> IO a
peek @(Ptr (AttachmentReference2 _)) ((Ptr (SubpassDescription2 es)
p Ptr (SubpassDescription2 es)
-> Int -> Ptr (Ptr (AttachmentReference2 _))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr (AttachmentReference2 _))))
    Vector (SomeStruct AttachmentReference2)
pInputAttachments' <- Int
-> (Int -> IO (SomeStruct AttachmentReference2))
-> IO (Vector (SomeStruct AttachmentReference2))
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
inputAttachmentCount) (\Int
i -> Ptr (SomeStruct AttachmentReference2)
-> IO (SomeStruct AttachmentReference2)
forall (a :: [*] -> *).
(Extensible a,
 forall (es :: [*]).
 (Extendss a es, PeekChain es) =>
 FromCStruct (a es)) =>
Ptr (SomeStruct a) -> IO (SomeStruct a)
peekSomeCStruct (Ptr (AttachmentReference2 Any)
-> Ptr (SomeStruct AttachmentReference2)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions ((Ptr (AttachmentReference2 Any)
pInputAttachments Ptr (AttachmentReference2 Any)
-> Int -> Ptr (AttachmentReference2 Any)
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (AttachmentReference2 _)))))
    Word32
colorAttachmentCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (SubpassDescription2 es)
p Ptr (SubpassDescription2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word32))
    Ptr (AttachmentReference2 Any)
pColorAttachments <- Ptr (Ptr (AttachmentReference2 Any))
-> IO (Ptr (AttachmentReference2 Any))
forall a. Storable a => Ptr a -> IO a
peek @(Ptr (AttachmentReference2 _)) ((Ptr (SubpassDescription2 es)
p Ptr (SubpassDescription2 es)
-> Int -> Ptr (Ptr (AttachmentReference2 _))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr (Ptr (AttachmentReference2 _))))
    Vector (SomeStruct AttachmentReference2)
pColorAttachments' <- Int
-> (Int -> IO (SomeStruct AttachmentReference2))
-> IO (Vector (SomeStruct AttachmentReference2))
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 (SomeStruct AttachmentReference2)
-> IO (SomeStruct AttachmentReference2)
forall (a :: [*] -> *).
(Extensible a,
 forall (es :: [*]).
 (Extendss a es, PeekChain es) =>
 FromCStruct (a es)) =>
Ptr (SomeStruct a) -> IO (SomeStruct a)
peekSomeCStruct (Ptr (AttachmentReference2 Any)
-> Ptr (SomeStruct AttachmentReference2)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions ((Ptr (AttachmentReference2 Any)
pColorAttachments Ptr (AttachmentReference2 Any)
-> Int -> Ptr (AttachmentReference2 Any)
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (AttachmentReference2 _)))))
    Ptr (AttachmentReference2 Any)
pResolveAttachments <- Ptr (Ptr (AttachmentReference2 Any))
-> IO (Ptr (AttachmentReference2 Any))
forall a. Storable a => Ptr a -> IO a
peek @(Ptr (AttachmentReference2 _)) ((Ptr (SubpassDescription2 es)
p Ptr (SubpassDescription2 es)
-> Int -> Ptr (Ptr (AttachmentReference2 _))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr (Ptr (AttachmentReference2 _))))
    let pResolveAttachmentsLength :: Int
pResolveAttachmentsLength = if Ptr (AttachmentReference2 Any)
pResolveAttachments Ptr (AttachmentReference2 Any)
-> Ptr (AttachmentReference2 Any) -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr (AttachmentReference2 Any)
forall a. Ptr a
nullPtr then Int
0 else (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
colorAttachmentCount)
    Vector (SomeStruct AttachmentReference2)
pResolveAttachments' <- Int
-> (Int -> IO (SomeStruct AttachmentReference2))
-> IO (Vector (SomeStruct AttachmentReference2))
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM Int
pResolveAttachmentsLength (\Int
i -> Ptr (SomeStruct AttachmentReference2)
-> IO (SomeStruct AttachmentReference2)
forall (a :: [*] -> *).
(Extensible a,
 forall (es :: [*]).
 (Extendss a es, PeekChain es) =>
 FromCStruct (a es)) =>
Ptr (SomeStruct a) -> IO (SomeStruct a)
peekSomeCStruct (Ptr (AttachmentReference2 Any)
-> Ptr (SomeStruct AttachmentReference2)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions ((Ptr (AttachmentReference2 Any)
pResolveAttachments Ptr (AttachmentReference2 Any)
-> Int -> Ptr (AttachmentReference2 Any)
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (AttachmentReference2 _)))))
    Ptr (AttachmentReference2 Any)
pDepthStencilAttachment <- Ptr (Ptr (AttachmentReference2 Any))
-> IO (Ptr (AttachmentReference2 Any))
forall a. Storable a => Ptr a -> IO a
peek @(Ptr (AttachmentReference2 _)) ((Ptr (SubpassDescription2 es)
p Ptr (SubpassDescription2 es)
-> Int -> Ptr (Ptr (AttachmentReference2 _))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr (Ptr (AttachmentReference2 _))))
    Maybe (SomeStruct AttachmentReference2)
pDepthStencilAttachment' <- (Ptr (AttachmentReference2 Any)
 -> IO (SomeStruct AttachmentReference2))
-> Ptr (AttachmentReference2 Any)
-> IO (Maybe (SomeStruct AttachmentReference2))
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek (\Ptr (AttachmentReference2 Any)
j -> Ptr (SomeStruct AttachmentReference2)
-> IO (SomeStruct AttachmentReference2)
forall (a :: [*] -> *).
(Extensible a,
 forall (es :: [*]).
 (Extendss a es, PeekChain es) =>
 FromCStruct (a es)) =>
Ptr (SomeStruct a) -> IO (SomeStruct a)
peekSomeCStruct (Ptr (AttachmentReference2 Any)
-> Ptr (SomeStruct AttachmentReference2)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (AttachmentReference2 Any)
j))) Ptr (AttachmentReference2 Any)
pDepthStencilAttachment
    Word32
preserveAttachmentCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (SubpassDescription2 es)
p Ptr (SubpassDescription2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr Word32))
    Ptr Word32
pPreserveAttachments <- Ptr (Ptr Word32) -> IO (Ptr Word32)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Word32) ((Ptr (SubpassDescription2 es)
p Ptr (SubpassDescription2 es) -> Int -> Ptr (Ptr Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80 :: Ptr (Ptr Word32)))
    Vector Word32
pPreserveAttachments' <- Int -> (Int -> IO Word32) -> IO (Vector Word32)
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
preserveAttachmentCount) (\Int
i -> Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr Word32
pPreserveAttachments Ptr Word32 -> Int -> Ptr Word32
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32)))
    SubpassDescription2 es -> IO (SubpassDescription2 es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubpassDescription2 es -> IO (SubpassDescription2 es))
-> SubpassDescription2 es -> IO (SubpassDescription2 es)
forall a b. (a -> b) -> a -> b
$ Chain es
-> SubpassDescriptionFlags
-> PipelineBindPoint
-> Word32
-> Vector (SomeStruct AttachmentReference2)
-> Vector (SomeStruct AttachmentReference2)
-> Vector (SomeStruct AttachmentReference2)
-> Maybe (SomeStruct AttachmentReference2)
-> Vector Word32
-> SubpassDescription2 es
forall (es :: [*]).
Chain es
-> SubpassDescriptionFlags
-> PipelineBindPoint
-> Word32
-> Vector (SomeStruct AttachmentReference2)
-> Vector (SomeStruct AttachmentReference2)
-> Vector (SomeStruct AttachmentReference2)
-> Maybe (SomeStruct AttachmentReference2)
-> Vector Word32
-> SubpassDescription2 es
SubpassDescription2
             Chain es
next SubpassDescriptionFlags
flags PipelineBindPoint
pipelineBindPoint Word32
viewMask Vector (SomeStruct AttachmentReference2)
pInputAttachments' Vector (SomeStruct AttachmentReference2)
pColorAttachments' Vector (SomeStruct AttachmentReference2)
pResolveAttachments' Maybe (SomeStruct AttachmentReference2)
pDepthStencilAttachment' Vector Word32
pPreserveAttachments'

instance es ~ '[] => Zero (SubpassDescription2 es) where
  zero :: SubpassDescription2 es
zero = Chain es
-> SubpassDescriptionFlags
-> PipelineBindPoint
-> Word32
-> Vector (SomeStruct AttachmentReference2)
-> Vector (SomeStruct AttachmentReference2)
-> Vector (SomeStruct AttachmentReference2)
-> Maybe (SomeStruct AttachmentReference2)
-> Vector Word32
-> SubpassDescription2 es
forall (es :: [*]).
Chain es
-> SubpassDescriptionFlags
-> PipelineBindPoint
-> Word32
-> Vector (SomeStruct AttachmentReference2)
-> Vector (SomeStruct AttachmentReference2)
-> Vector (SomeStruct AttachmentReference2)
-> Maybe (SomeStruct AttachmentReference2)
-> Vector Word32
-> SubpassDescription2 es
SubpassDescription2
           ()
           SubpassDescriptionFlags
forall a. Zero a => a
zero
           PipelineBindPoint
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           Vector (SomeStruct AttachmentReference2)
forall a. Monoid a => a
mempty
           Vector (SomeStruct AttachmentReference2)
forall a. Monoid a => a
mempty
           Vector (SomeStruct AttachmentReference2)
forall a. Monoid a => a
mempty
           Maybe (SomeStruct AttachmentReference2)
forall a. Maybe a
Nothing
           Vector Word32
forall a. Monoid a => a
mempty


-- | VkSubpassDependency2 - Structure specifying a subpass dependency
--
-- = Description
--
-- Parameters defined by this structure with the same name as those in
-- 'Vulkan.Core10.Pass.SubpassDependency' have the identical effect to
-- those parameters.
--
-- @viewOffset@ has the same effect for the described subpass dependency as
-- 'Vulkan.Core11.Promoted_From_VK_KHR_multiview.RenderPassMultiviewCreateInfo'::@pViewOffsets@
-- has on each corresponding subpass dependency.
--
-- If a
-- 'Vulkan.Core13.Promoted_From_VK_KHR_synchronization2.MemoryBarrier2' is
-- included in the @pNext@ chain, @srcStageMask@, @dstStageMask@,
-- @srcAccessMask@, and @dstAccessMask@ parameters are ignored. The
-- synchronization and access scopes instead are defined by the parameters
-- of 'Vulkan.Core13.Promoted_From_VK_KHR_synchronization2.MemoryBarrier2'.
--
-- == Valid Usage
--
-- -   #VUID-VkSubpassDependency2-srcStageMask-04090# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-geometryShader geometry shaders>
--     feature is not enabled, @srcStageMask@ /must/ not contain
--     'Vulkan.Core10.Enums.PipelineStageFlagBits.PIPELINE_STAGE_GEOMETRY_SHADER_BIT'
--
-- -   #VUID-VkSubpassDependency2-srcStageMask-04091# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-tessellationShader tessellation shaders>
--     feature is not enabled, @srcStageMask@ /must/ not contain
--     'Vulkan.Core10.Enums.PipelineStageFlagBits.PIPELINE_STAGE_TESSELLATION_CONTROL_SHADER_BIT'
--     or
--     'Vulkan.Core10.Enums.PipelineStageFlagBits.PIPELINE_STAGE_TESSELLATION_EVALUATION_SHADER_BIT'
--
-- -   #VUID-VkSubpassDependency2-srcStageMask-04092# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-conditionalRendering conditional rendering>
--     feature is not enabled, @srcStageMask@ /must/ not contain
--     'Vulkan.Core10.Enums.PipelineStageFlagBits.PIPELINE_STAGE_CONDITIONAL_RENDERING_BIT_EXT'
--
-- -   #VUID-VkSubpassDependency2-srcStageMask-04093# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-fragmentDensityMap fragment density map>
--     feature is not enabled, @srcStageMask@ /must/ not contain
--     'Vulkan.Core10.Enums.PipelineStageFlagBits.PIPELINE_STAGE_FRAGMENT_DENSITY_PROCESS_BIT_EXT'
--
-- -   #VUID-VkSubpassDependency2-srcStageMask-04094# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-transformFeedback transform feedback>
--     feature is not enabled, @srcStageMask@ /must/ not contain
--     'Vulkan.Core10.Enums.PipelineStageFlagBits.PIPELINE_STAGE_TRANSFORM_FEEDBACK_BIT_EXT'
--
-- -   #VUID-VkSubpassDependency2-srcStageMask-04095# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-meshShader mesh shaders>
--     feature is not enabled, @srcStageMask@ /must/ not contain
--     'Vulkan.Core10.Enums.PipelineStageFlagBits.PIPELINE_STAGE_MESH_SHADER_BIT_NV'
--
-- -   #VUID-VkSubpassDependency2-srcStageMask-04096# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-taskShader task shaders>
--     feature is not enabled, @srcStageMask@ /must/ not contain
--     'Vulkan.Core10.Enums.PipelineStageFlagBits.PIPELINE_STAGE_TASK_SHADER_BIT_NV'
--
-- -   #VUID-VkSubpassDependency2-srcStageMask-04097# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-shadingRateImage shading rate image>
--     feature is not enabled, @srcStageMask@ /must/ not contain
--     'Vulkan.Extensions.VK_NV_shading_rate_image.PIPELINE_STAGE_SHADING_RATE_IMAGE_BIT_NV'
--
-- -   #VUID-VkSubpassDependency2-srcStageMask-03937# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-synchronization2 synchronization2>
--     feature is not enabled, @srcStageMask@ /must/ not be @0@
--
-- -   #VUID-VkSubpassDependency2-dstStageMask-04090# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-geometryShader geometry shaders>
--     feature is not enabled, @dstStageMask@ /must/ not contain
--     'Vulkan.Core10.Enums.PipelineStageFlagBits.PIPELINE_STAGE_GEOMETRY_SHADER_BIT'
--
-- -   #VUID-VkSubpassDependency2-dstStageMask-04091# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-tessellationShader tessellation shaders>
--     feature is not enabled, @dstStageMask@ /must/ not contain
--     'Vulkan.Core10.Enums.PipelineStageFlagBits.PIPELINE_STAGE_TESSELLATION_CONTROL_SHADER_BIT'
--     or
--     'Vulkan.Core10.Enums.PipelineStageFlagBits.PIPELINE_STAGE_TESSELLATION_EVALUATION_SHADER_BIT'
--
-- -   #VUID-VkSubpassDependency2-dstStageMask-04092# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-conditionalRendering conditional rendering>
--     feature is not enabled, @dstStageMask@ /must/ not contain
--     'Vulkan.Core10.Enums.PipelineStageFlagBits.PIPELINE_STAGE_CONDITIONAL_RENDERING_BIT_EXT'
--
-- -   #VUID-VkSubpassDependency2-dstStageMask-04093# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-fragmentDensityMap fragment density map>
--     feature is not enabled, @dstStageMask@ /must/ not contain
--     'Vulkan.Core10.Enums.PipelineStageFlagBits.PIPELINE_STAGE_FRAGMENT_DENSITY_PROCESS_BIT_EXT'
--
-- -   #VUID-VkSubpassDependency2-dstStageMask-04094# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-transformFeedback transform feedback>
--     feature is not enabled, @dstStageMask@ /must/ not contain
--     'Vulkan.Core10.Enums.PipelineStageFlagBits.PIPELINE_STAGE_TRANSFORM_FEEDBACK_BIT_EXT'
--
-- -   #VUID-VkSubpassDependency2-dstStageMask-04095# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-meshShader mesh shaders>
--     feature is not enabled, @dstStageMask@ /must/ not contain
--     'Vulkan.Core10.Enums.PipelineStageFlagBits.PIPELINE_STAGE_MESH_SHADER_BIT_NV'
--
-- -   #VUID-VkSubpassDependency2-dstStageMask-04096# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-taskShader task shaders>
--     feature is not enabled, @dstStageMask@ /must/ not contain
--     'Vulkan.Core10.Enums.PipelineStageFlagBits.PIPELINE_STAGE_TASK_SHADER_BIT_NV'
--
-- -   #VUID-VkSubpassDependency2-dstStageMask-04097# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-shadingRateImage shading rate image>
--     feature is not enabled, @dstStageMask@ /must/ not contain
--     'Vulkan.Extensions.VK_NV_shading_rate_image.PIPELINE_STAGE_SHADING_RATE_IMAGE_BIT_NV'
--
-- -   #VUID-VkSubpassDependency2-dstStageMask-03937# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-synchronization2 synchronization2>
--     feature is not enabled, @dstStageMask@ /must/ not be @0@
--
-- -   #VUID-VkSubpassDependency2-srcSubpass-03084# @srcSubpass@ /must/ be
--     less than or equal to @dstSubpass@, unless one of them is
--     'Vulkan.Core10.APIConstants.SUBPASS_EXTERNAL', to avoid cyclic
--     dependencies and ensure a valid execution order
--
-- -   #VUID-VkSubpassDependency2-srcSubpass-03085# @srcSubpass@ and
--     @dstSubpass@ /must/ not both be equal to
--     'Vulkan.Core10.APIConstants.SUBPASS_EXTERNAL'
--
-- -   #VUID-VkSubpassDependency2-srcSubpass-03087# If @srcSubpass@ is
--     equal to @dstSubpass@ and not all of the stages in @srcStageMask@
--     and @dstStageMask@ are
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-framebuffer-regions framebuffer-space stages>,
--     the
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-pipeline-stages-order logically latest>
--     pipeline stage in @srcStageMask@ /must/ be
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-pipeline-stages-order logically earlier>
--     than or equal to the
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-pipeline-stages-order logically earliest>
--     pipeline stage in @dstStageMask@
--
-- -   #VUID-VkSubpassDependency2-srcAccessMask-03088# Any access flag
--     included in @srcAccessMask@ /must/ be supported by one of the
--     pipeline stages in @srcStageMask@, as specified in the
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-access-types-supported table of supported access types>
--
-- -   #VUID-VkSubpassDependency2-dstAccessMask-03089# Any access flag
--     included in @dstAccessMask@ /must/ be supported by one of the
--     pipeline stages in @dstStageMask@, as specified in the
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-access-types-supported table of supported access types>
--
-- -   #VUID-VkSubpassDependency2-dependencyFlags-03090# If
--     @dependencyFlags@ includes
--     'Vulkan.Core10.Enums.DependencyFlagBits.DEPENDENCY_VIEW_LOCAL_BIT',
--     @srcSubpass@ /must/ not be equal to
--     'Vulkan.Core10.APIConstants.SUBPASS_EXTERNAL'
--
-- -   #VUID-VkSubpassDependency2-dependencyFlags-03091# If
--     @dependencyFlags@ includes
--     'Vulkan.Core10.Enums.DependencyFlagBits.DEPENDENCY_VIEW_LOCAL_BIT',
--     @dstSubpass@ /must/ not be equal to
--     'Vulkan.Core10.APIConstants.SUBPASS_EXTERNAL'
--
-- -   #VUID-VkSubpassDependency2-srcSubpass-02245# If @srcSubpass@ equals
--     @dstSubpass@, and @srcStageMask@ and @dstStageMask@ both include a
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-framebuffer-regions framebuffer-space stage>,
--     then @dependencyFlags@ /must/ include
--     'Vulkan.Core10.Enums.DependencyFlagBits.DEPENDENCY_BY_REGION_BIT'
--
-- -   #VUID-VkSubpassDependency2-viewOffset-02530# If @viewOffset@ is not
--     equal to @0@, @srcSubpass@ /must/ not be equal to @dstSubpass@
--
-- -   #VUID-VkSubpassDependency2-dependencyFlags-03092# If
--     @dependencyFlags@ does not include
--     'Vulkan.Core10.Enums.DependencyFlagBits.DEPENDENCY_VIEW_LOCAL_BIT',
--     @viewOffset@ /must/ be @0@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkSubpassDependency2-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SUBPASS_DEPENDENCY_2'
--
-- -   #VUID-VkSubpassDependency2-pNext-pNext# @pNext@ /must/ be @NULL@ or
--     a pointer to a valid instance of
--     'Vulkan.Core13.Promoted_From_VK_KHR_synchronization2.MemoryBarrier2'
--
-- -   #VUID-VkSubpassDependency2-sType-unique# The @sType@ value of each
--     struct in the @pNext@ chain /must/ be unique
--
-- -   #VUID-VkSubpassDependency2-srcStageMask-parameter# @srcStageMask@
--     /must/ be a valid combination of
--     'Vulkan.Core10.Enums.PipelineStageFlagBits.PipelineStageFlagBits'
--     values
--
-- -   #VUID-VkSubpassDependency2-dstStageMask-parameter# @dstStageMask@
--     /must/ be a valid combination of
--     'Vulkan.Core10.Enums.PipelineStageFlagBits.PipelineStageFlagBits'
--     values
--
-- -   #VUID-VkSubpassDependency2-srcAccessMask-parameter# @srcAccessMask@
--     /must/ be a valid combination of
--     'Vulkan.Core10.Enums.AccessFlagBits.AccessFlagBits' values
--
-- -   #VUID-VkSubpassDependency2-dstAccessMask-parameter# @dstAccessMask@
--     /must/ be a valid combination of
--     'Vulkan.Core10.Enums.AccessFlagBits.AccessFlagBits' values
--
-- -   #VUID-VkSubpassDependency2-dependencyFlags-parameter#
--     @dependencyFlags@ /must/ be a valid combination of
--     'Vulkan.Core10.Enums.DependencyFlagBits.DependencyFlagBits' values
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_create_renderpass2 VK_KHR_create_renderpass2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_2 VK_VERSION_1_2>,
-- 'Vulkan.Core10.Enums.AccessFlagBits.AccessFlags',
-- 'Vulkan.Core10.Enums.DependencyFlagBits.DependencyFlags',
-- 'Vulkan.Core10.Enums.PipelineStageFlagBits.PipelineStageFlags',
-- 'RenderPassCreateInfo2',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data SubpassDependency2 (es :: [Type]) = SubpassDependency2
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    SubpassDependency2 es -> Chain es
next :: Chain es
  , -- | @srcSubpass@ is the subpass index of the first subpass in the
    -- dependency, or 'Vulkan.Core10.APIConstants.SUBPASS_EXTERNAL'.
    SubpassDependency2 es -> Word32
srcSubpass :: Word32
  , -- | @dstSubpass@ is the subpass index of the second subpass in the
    -- dependency, or 'Vulkan.Core10.APIConstants.SUBPASS_EXTERNAL'.
    SubpassDependency2 es -> Word32
dstSubpass :: Word32
  , -- | @srcStageMask@ is a bitmask of
    -- 'Vulkan.Core10.Enums.PipelineStageFlagBits.PipelineStageFlagBits'
    -- specifying the
    -- <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-pipeline-stages-masks source stage mask>.
    SubpassDependency2 es -> PipelineStageFlags
srcStageMask :: PipelineStageFlags
  , -- | @dstStageMask@ is a bitmask of
    -- 'Vulkan.Core10.Enums.PipelineStageFlagBits.PipelineStageFlagBits'
    -- specifying the
    -- <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-pipeline-stages-masks destination stage mask>
    SubpassDependency2 es -> PipelineStageFlags
dstStageMask :: PipelineStageFlags
  , -- | @srcAccessMask@ is a bitmask of
    -- 'Vulkan.Core10.Enums.AccessFlagBits.AccessFlagBits' specifying a
    -- <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-access-masks source access mask>.
    SubpassDependency2 es -> AccessFlags
srcAccessMask :: AccessFlags
  , -- | @dstAccessMask@ is a bitmask of
    -- 'Vulkan.Core10.Enums.AccessFlagBits.AccessFlagBits' specifying a
    -- <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-access-masks destination access mask>.
    SubpassDependency2 es -> AccessFlags
dstAccessMask :: AccessFlags
  , -- | @dependencyFlags@ is a bitmask of
    -- 'Vulkan.Core10.Enums.DependencyFlagBits.DependencyFlagBits'.
    SubpassDependency2 es -> DependencyFlags
dependencyFlags :: DependencyFlags
  , -- | @viewOffset@ controls which views in the source subpass the views in the
    -- destination subpass depend on.
    SubpassDependency2 es -> Int32
viewOffset :: Int32
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SubpassDependency2 (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (SubpassDependency2 es)

instance Extensible SubpassDependency2 where
  extensibleTypeName :: String
extensibleTypeName = String
"SubpassDependency2"
  setNext :: SubpassDependency2 ds -> Chain es -> SubpassDependency2 es
setNext SubpassDependency2{Int32
Word32
Chain ds
DependencyFlags
PipelineStageFlags
AccessFlags
viewOffset :: Int32
dependencyFlags :: DependencyFlags
dstAccessMask :: AccessFlags
srcAccessMask :: AccessFlags
dstStageMask :: PipelineStageFlags
srcStageMask :: PipelineStageFlags
dstSubpass :: Word32
srcSubpass :: Word32
next :: Chain ds
$sel:viewOffset:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> Int32
$sel:dependencyFlags:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> DependencyFlags
$sel:dstAccessMask:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> AccessFlags
$sel:srcAccessMask:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> AccessFlags
$sel:dstStageMask:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> PipelineStageFlags
$sel:srcStageMask:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> PipelineStageFlags
$sel:dstSubpass:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> Word32
$sel:srcSubpass:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> Word32
$sel:next:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> Chain es
..} Chain es
next' = SubpassDependency2 :: forall (es :: [*]).
Chain es
-> Word32
-> Word32
-> PipelineStageFlags
-> PipelineStageFlags
-> AccessFlags
-> AccessFlags
-> DependencyFlags
-> Int32
-> SubpassDependency2 es
SubpassDependency2{$sel:next:SubpassDependency2 :: Chain es
next = Chain es
next', Int32
Word32
DependencyFlags
PipelineStageFlags
AccessFlags
viewOffset :: Int32
dependencyFlags :: DependencyFlags
dstAccessMask :: AccessFlags
srcAccessMask :: AccessFlags
dstStageMask :: PipelineStageFlags
srcStageMask :: PipelineStageFlags
dstSubpass :: Word32
srcSubpass :: Word32
$sel:viewOffset:SubpassDependency2 :: Int32
$sel:dependencyFlags:SubpassDependency2 :: DependencyFlags
$sel:dstAccessMask:SubpassDependency2 :: AccessFlags
$sel:srcAccessMask:SubpassDependency2 :: AccessFlags
$sel:dstStageMask:SubpassDependency2 :: PipelineStageFlags
$sel:srcStageMask:SubpassDependency2 :: PipelineStageFlags
$sel:dstSubpass:SubpassDependency2 :: Word32
$sel:srcSubpass:SubpassDependency2 :: Word32
..}
  getNext :: SubpassDependency2 es -> Chain es
getNext SubpassDependency2{Int32
Word32
Chain es
DependencyFlags
PipelineStageFlags
AccessFlags
viewOffset :: Int32
dependencyFlags :: DependencyFlags
dstAccessMask :: AccessFlags
srcAccessMask :: AccessFlags
dstStageMask :: PipelineStageFlags
srcStageMask :: PipelineStageFlags
dstSubpass :: Word32
srcSubpass :: Word32
next :: Chain es
$sel:viewOffset:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> Int32
$sel:dependencyFlags:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> DependencyFlags
$sel:dstAccessMask:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> AccessFlags
$sel:srcAccessMask:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> AccessFlags
$sel:dstStageMask:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> PipelineStageFlags
$sel:srcStageMask:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> PipelineStageFlags
$sel:dstSubpass:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> Word32
$sel:srcSubpass:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> Word32
$sel:next:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> Chain es
..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends SubpassDependency2 e => b) -> Maybe b
  extends :: proxy e -> (Extends SubpassDependency2 e => b) -> Maybe b
extends proxy e
_ Extends SubpassDependency2 e => b
f
    | Just e :~: MemoryBarrier2
Refl <- (Typeable e, Typeable MemoryBarrier2) =>
Maybe (e :~: MemoryBarrier2)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @MemoryBarrier2 = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends SubpassDependency2 e => b
f
    | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing

instance (Extendss SubpassDependency2 es, PokeChain es) => ToCStruct (SubpassDependency2 es) where
  withCStruct :: SubpassDependency2 es
-> (Ptr (SubpassDependency2 es) -> IO b) -> IO b
withCStruct SubpassDependency2 es
x Ptr (SubpassDependency2 es) -> IO b
f = Int -> (Ptr (SubpassDependency2 es) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
48 ((Ptr (SubpassDependency2 es) -> IO b) -> IO b)
-> (Ptr (SubpassDependency2 es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr (SubpassDependency2 es)
p -> Ptr (SubpassDependency2 es)
-> SubpassDependency2 es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (SubpassDependency2 es)
p SubpassDependency2 es
x (Ptr (SubpassDependency2 es) -> IO b
f Ptr (SubpassDependency2 es)
p)
  pokeCStruct :: Ptr (SubpassDependency2 es)
-> SubpassDependency2 es -> IO b -> IO b
pokeCStruct Ptr (SubpassDependency2 es)
p SubpassDependency2{Int32
Word32
Chain es
DependencyFlags
PipelineStageFlags
AccessFlags
viewOffset :: Int32
dependencyFlags :: DependencyFlags
dstAccessMask :: AccessFlags
srcAccessMask :: AccessFlags
dstStageMask :: PipelineStageFlags
srcStageMask :: PipelineStageFlags
dstSubpass :: Word32
srcSubpass :: Word32
next :: Chain es
$sel:viewOffset:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> Int32
$sel:dependencyFlags:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> DependencyFlags
$sel:dstAccessMask:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> AccessFlags
$sel:srcAccessMask:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> AccessFlags
$sel:dstStageMask:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> PipelineStageFlags
$sel:srcStageMask:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> PipelineStageFlags
$sel:dstSubpass:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> Word32
$sel:srcSubpass:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 es -> Word32
$sel:next:SubpassDependency2 :: forall (es :: [*]). SubpassDependency2 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 (SubpassDependency2 es)
p Ptr (SubpassDependency2 es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SUBPASS_DEPENDENCY_2)
    Ptr ()
pNext'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SubpassDependency2 es)
p Ptr (SubpassDependency2 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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SubpassDependency2 es)
p Ptr (SubpassDependency2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
srcSubpass)
    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 (SubpassDependency2 es)
p Ptr (SubpassDependency2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (Word32
dstSubpass)
    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 PipelineStageFlags -> PipelineStageFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SubpassDependency2 es)
p Ptr (SubpassDependency2 es) -> Int -> Ptr PipelineStageFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr PipelineStageFlags)) (PipelineStageFlags
srcStageMask)
    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 PipelineStageFlags -> PipelineStageFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SubpassDependency2 es)
p Ptr (SubpassDependency2 es) -> Int -> Ptr PipelineStageFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr PipelineStageFlags)) (PipelineStageFlags
dstStageMask)
    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 AccessFlags -> AccessFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SubpassDependency2 es)
p Ptr (SubpassDependency2 es) -> Int -> Ptr AccessFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr AccessFlags)) (AccessFlags
srcAccessMask)
    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 AccessFlags -> AccessFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SubpassDependency2 es)
p Ptr (SubpassDependency2 es) -> Int -> Ptr AccessFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr AccessFlags)) (AccessFlags
dstAccessMask)
    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 DependencyFlags -> DependencyFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SubpassDependency2 es)
p Ptr (SubpassDependency2 es) -> Int -> Ptr DependencyFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr DependencyFlags)) (DependencyFlags
dependencyFlags)
    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 Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SubpassDependency2 es)
p Ptr (SubpassDependency2 es) -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Int32)) (Int32
viewOffset)
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = Int
48
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr (SubpassDependency2 es) -> IO b -> IO b
pokeZeroCStruct Ptr (SubpassDependency2 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 (SubpassDependency2 es)
p Ptr (SubpassDependency2 es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SUBPASS_DEPENDENCY_2)
    Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall 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 (SubpassDependency2 es)
p Ptr (SubpassDependency2 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 Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SubpassDependency2 es)
p Ptr (SubpassDependency2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: 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 (SubpassDependency2 es)
p Ptr (SubpassDependency2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: 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 Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SubpassDependency2 es)
p Ptr (SubpassDependency2 es) -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Int32)) (Int32
forall a. Zero a => a
zero)
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

instance (Extendss SubpassDependency2 es, PeekChain es) => FromCStruct (SubpassDependency2 es) where
  peekCStruct :: Ptr (SubpassDependency2 es) -> IO (SubpassDependency2 es)
peekCStruct Ptr (SubpassDependency2 es)
p = do
    Ptr ()
pNext <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (SubpassDependency2 es)
p Ptr (SubpassDependency2 es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ())))
    Chain es
next <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
    Word32
srcSubpass <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (SubpassDependency2 es)
p Ptr (SubpassDependency2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    Word32
dstSubpass <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (SubpassDependency2 es)
p Ptr (SubpassDependency2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
    PipelineStageFlags
srcStageMask <- Ptr PipelineStageFlags -> IO PipelineStageFlags
forall a. Storable a => Ptr a -> IO a
peek @PipelineStageFlags ((Ptr (SubpassDependency2 es)
p Ptr (SubpassDependency2 es) -> Int -> Ptr PipelineStageFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr PipelineStageFlags))
    PipelineStageFlags
dstStageMask <- Ptr PipelineStageFlags -> IO PipelineStageFlags
forall a. Storable a => Ptr a -> IO a
peek @PipelineStageFlags ((Ptr (SubpassDependency2 es)
p Ptr (SubpassDependency2 es) -> Int -> Ptr PipelineStageFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr PipelineStageFlags))
    AccessFlags
srcAccessMask <- Ptr AccessFlags -> IO AccessFlags
forall a. Storable a => Ptr a -> IO a
peek @AccessFlags ((Ptr (SubpassDependency2 es)
p Ptr (SubpassDependency2 es) -> Int -> Ptr AccessFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr AccessFlags))
    AccessFlags
dstAccessMask <- Ptr AccessFlags -> IO AccessFlags
forall a. Storable a => Ptr a -> IO a
peek @AccessFlags ((Ptr (SubpassDependency2 es)
p Ptr (SubpassDependency2 es) -> Int -> Ptr AccessFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr AccessFlags))
    DependencyFlags
dependencyFlags <- Ptr DependencyFlags -> IO DependencyFlags
forall a. Storable a => Ptr a -> IO a
peek @DependencyFlags ((Ptr (SubpassDependency2 es)
p Ptr (SubpassDependency2 es) -> Int -> Ptr DependencyFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr DependencyFlags))
    Int32
viewOffset <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek @Int32 ((Ptr (SubpassDependency2 es)
p Ptr (SubpassDependency2 es) -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Int32))
    SubpassDependency2 es -> IO (SubpassDependency2 es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubpassDependency2 es -> IO (SubpassDependency2 es))
-> SubpassDependency2 es -> IO (SubpassDependency2 es)
forall a b. (a -> b) -> a -> b
$ Chain es
-> Word32
-> Word32
-> PipelineStageFlags
-> PipelineStageFlags
-> AccessFlags
-> AccessFlags
-> DependencyFlags
-> Int32
-> SubpassDependency2 es
forall (es :: [*]).
Chain es
-> Word32
-> Word32
-> PipelineStageFlags
-> PipelineStageFlags
-> AccessFlags
-> AccessFlags
-> DependencyFlags
-> Int32
-> SubpassDependency2 es
SubpassDependency2
             Chain es
next Word32
srcSubpass Word32
dstSubpass PipelineStageFlags
srcStageMask PipelineStageFlags
dstStageMask AccessFlags
srcAccessMask AccessFlags
dstAccessMask DependencyFlags
dependencyFlags Int32
viewOffset

instance es ~ '[] => Zero (SubpassDependency2 es) where
  zero :: SubpassDependency2 es
zero = Chain es
-> Word32
-> Word32
-> PipelineStageFlags
-> PipelineStageFlags
-> AccessFlags
-> AccessFlags
-> DependencyFlags
-> Int32
-> SubpassDependency2 es
forall (es :: [*]).
Chain es
-> Word32
-> Word32
-> PipelineStageFlags
-> PipelineStageFlags
-> AccessFlags
-> AccessFlags
-> DependencyFlags
-> Int32
-> SubpassDependency2 es
SubpassDependency2
           ()
           Word32
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero
           PipelineStageFlags
forall a. Zero a => a
zero
           PipelineStageFlags
forall a. Zero a => a
zero
           AccessFlags
forall a. Zero a => a
zero
           AccessFlags
forall a. Zero a => a
zero
           DependencyFlags
forall a. Zero a => a
zero
           Int32
forall a. Zero a => a
zero


-- | VkRenderPassCreateInfo2 - Structure specifying parameters of a newly
-- created render pass
--
-- = Description
--
-- Parameters defined by this structure with the same name as those in
-- 'Vulkan.Core10.Pass.RenderPassCreateInfo' have the identical effect to
-- those parameters; the child structures are variants of those used in
-- 'Vulkan.Core10.Pass.RenderPassCreateInfo' which add @sType@ and @pNext@
-- parameters, allowing them to be extended.
--
-- If the 'SubpassDescription2'::@viewMask@ member of any element of
-- @pSubpasses@ is not zero, /multiview/ functionality is considered to be
-- enabled for this render pass.
--
-- @correlatedViewMaskCount@ and @pCorrelatedViewMasks@ have the same
-- effect as
-- 'Vulkan.Core11.Promoted_From_VK_KHR_multiview.RenderPassMultiviewCreateInfo'::@correlationMaskCount@
-- and
-- 'Vulkan.Core11.Promoted_From_VK_KHR_multiview.RenderPassMultiviewCreateInfo'::@pCorrelationMasks@,
-- respectively.
--
-- == Valid Usage
--
-- -   #VUID-VkRenderPassCreateInfo2-None-03049# If any two subpasses
--     operate on attachments with overlapping ranges of the same
--     'Vulkan.Core10.Handles.DeviceMemory' object, and at least one
--     subpass writes to that area of 'Vulkan.Core10.Handles.DeviceMemory',
--     a subpass dependency /must/ be included (either directly or via some
--     intermediate subpasses) between them
--
-- -   #VUID-VkRenderPassCreateInfo2-attachment-03050# If the @attachment@
--     member of any element of @pInputAttachments@, @pColorAttachments@,
--     @pResolveAttachments@ or @pDepthStencilAttachment@, or the
--     attachment indexed by any element of @pPreserveAttachments@ in any
--     given element of @pSubpasses@ is bound to a range of a
--     'Vulkan.Core10.Handles.DeviceMemory' object that overlaps with any
--     other attachment in any subpass (including the same subpass), the
--     'AttachmentDescription2' structures describing them /must/ include
--     'Vulkan.Core10.Enums.AttachmentDescriptionFlagBits.ATTACHMENT_DESCRIPTION_MAY_ALIAS_BIT'
--     in @flags@
--
-- -   #VUID-VkRenderPassCreateInfo2-attachment-03051# If the @attachment@
--     member of any element of @pInputAttachments@, @pColorAttachments@,
--     @pResolveAttachments@ or @pDepthStencilAttachment@, or any element
--     of @pPreserveAttachments@ in any given element of @pSubpasses@ is
--     not 'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED', then it /must/
--     be less than @attachmentCount@
--
-- -   #VUID-VkRenderPassCreateInfo2-fragmentDensityMapAttachment-06472# If
--     the pNext chain includes a
--     'Vulkan.Extensions.VK_EXT_fragment_density_map.RenderPassFragmentDensityMapCreateInfoEXT'
--     structure and the @fragmentDensityMapAttachment@ member is not
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED', then @attachment@
--     /must/ be less than @attachmentCount@
--
-- -   #VUID-VkRenderPassCreateInfo2-pSubpasses-06473# If the @pSubpasses@
--     pNext chain includes a
--     'Vulkan.Core12.Promoted_From_VK_KHR_depth_stencil_resolve.SubpassDescriptionDepthStencilResolve'
--     structure and the @pDepthStencilResolveAttachment@ member is not
--     @NULL@ and does not have the value
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED', then @attachment@
--     /must/ be less than @attachmentCount@
--
-- -   #VUID-VkRenderPassCreateInfo2-pAttachments-02522# For any member of
--     @pAttachments@ with a @loadOp@ equal to
--     'Vulkan.Core10.Enums.AttachmentLoadOp.ATTACHMENT_LOAD_OP_CLEAR', the
--     first use of that attachment /must/ not specify a @layout@ equal to
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_STENCIL_READ_ONLY_OPTIMAL',
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_READ_ONLY_STENCIL_ATTACHMENT_OPTIMAL'
--
-- -   #VUID-VkRenderPassCreateInfo2-pAttachments-02523# For any member of
--     @pAttachments@ with a @stencilLoadOp@ equal to
--     'Vulkan.Core10.Enums.AttachmentLoadOp.ATTACHMENT_LOAD_OP_CLEAR', the
--     first use of that attachment /must/ not specify a @layout@ equal to
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL',
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_STENCIL_READ_ONLY_OPTIMAL',
--     or
--     'Vulkan.Core10.Enums.ImageLayout.IMAGE_LAYOUT_DEPTH_ATTACHMENT_STENCIL_READ_ONLY_OPTIMAL'
--
-- -   #VUID-VkRenderPassCreateInfo2-pDependencies-03054# For any element
--     of @pDependencies@, if the @srcSubpass@ is not
--     'Vulkan.Core10.APIConstants.SUBPASS_EXTERNAL', all stage flags
--     included in the @srcStageMask@ member of that dependency /must/ be a
--     pipeline stage supported by the
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-pipeline-stages-types pipeline>
--     identified by the @pipelineBindPoint@ member of the source subpass
--
-- -   #VUID-VkRenderPassCreateInfo2-pDependencies-03055# For any element
--     of @pDependencies@, if the @dstSubpass@ is not
--     'Vulkan.Core10.APIConstants.SUBPASS_EXTERNAL', all stage flags
--     included in the @dstStageMask@ member of that dependency /must/ be a
--     pipeline stage supported by the
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-pipeline-stages-types pipeline>
--     identified by the @pipelineBindPoint@ member of the destination
--     subpass
--
-- -   #VUID-VkRenderPassCreateInfo2-pCorrelatedViewMasks-03056# The set of
--     bits included in any element of @pCorrelatedViewMasks@ /must/ not
--     overlap with the set of bits included in any other element of
--     @pCorrelatedViewMasks@
--
-- -   #VUID-VkRenderPassCreateInfo2-viewMask-03057# If the
--     'SubpassDescription2'::@viewMask@ member of all elements of
--     @pSubpasses@ is @0@, @correlatedViewMaskCount@ /must/ be @0@
--
-- -   #VUID-VkRenderPassCreateInfo2-viewMask-03058# The
--     'SubpassDescription2'::@viewMask@ member of all elements of
--     @pSubpasses@ /must/ either all be @0@, or all not be @0@
--
-- -   #VUID-VkRenderPassCreateInfo2-viewMask-03059# If the
--     'SubpassDescription2'::@viewMask@ member of all elements of
--     @pSubpasses@ is @0@, the @dependencyFlags@ member of any element of
--     @pDependencies@ /must/ not include
--     'Vulkan.Core10.Enums.DependencyFlagBits.DEPENDENCY_VIEW_LOCAL_BIT'
--
-- -   #VUID-VkRenderPassCreateInfo2-pDependencies-03060# For any element
--     of @pDependencies@ where its @srcSubpass@ member equals its
--     @dstSubpass@ member, if the @viewMask@ member of the corresponding
--     element of @pSubpasses@ includes more than one bit, its
--     @dependencyFlags@ member /must/ include
--     'Vulkan.Core10.Enums.DependencyFlagBits.DEPENDENCY_VIEW_LOCAL_BIT'
--
-- -   #VUID-VkRenderPassCreateInfo2-attachment-02525# If the @attachment@
--     member of any element of the @pInputAttachments@ member of any
--     element of @pSubpasses@ is not
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED', the @aspectMask@
--     member of that element of @pInputAttachments@ /must/ only include
--     aspects that are present in images of the format specified by the
--     element of @pAttachments@ specified by @attachment@
--
-- -   #VUID-VkRenderPassCreateInfo2-srcSubpass-02526# The @srcSubpass@
--     member of each element of @pDependencies@ /must/ be less than
--     @subpassCount@
--
-- -   #VUID-VkRenderPassCreateInfo2-dstSubpass-02527# The @dstSubpass@
--     member of each element of @pDependencies@ /must/ be less than
--     @subpassCount@
--
-- -   #VUID-VkRenderPassCreateInfo2-pAttachments-04585# If any element of
--     @pAttachments@ is used as a fragment shading rate attachment in any
--     subpass, it /must/ not be used as any other attachment in the render
--     pass
--
-- -   #VUID-VkRenderPassCreateInfo2-flags-04521# If @flags@ includes
--     'Vulkan.Core10.Enums.RenderPassCreateFlagBits.RENDER_PASS_CREATE_TRANSFORM_BIT_QCOM',
--     an element of @pSubpasses@ includes an instance of
--     'Vulkan.Extensions.VK_KHR_fragment_shading_rate.FragmentShadingRateAttachmentInfoKHR'
--     in its @pNext@ chain, and the @pFragmentShadingRateAttachment@
--     member of that structure is not equal to @NULL@, the @attachment@
--     member of @pFragmentShadingRateAttachment@ /must/ be
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED'
--
-- -   #VUID-VkRenderPassCreateInfo2-pAttachments-04586# If any element of
--     @pAttachments@ is used as a fragment shading rate attachment in any
--     subpass, it /must/ have an image format whose
--     <https://www.khronos.org/registry/vulkan/specs/1.3-extensions/html/vkspec.html#potential-format-features potential format features>
--     contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_FRAGMENT_SHADING_RATE_ATTACHMENT_BIT_KHR'
--
-- -   #VUID-VkRenderPassCreateInfo2-rasterizationSamples-04905# If the
--     pipeline is being created with fragment shader state, and the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_QCOM_render_pass_shader_resolve VK_QCOM_render_pass_shader_resolve>
--     extension is enabled, and if subpass has any input attachments, and
--     if the subpass description contains
--     'Vulkan.Core10.Enums.SubpassDescriptionFlagBits.SUBPASS_DESCRIPTION_FRAGMENT_REGION_BIT_QCOM',
--     then the sample count of the input attachments /must/ equal
--     @rasterizationSamples@
--
-- -   #VUID-VkRenderPassCreateInfo2-sampleShadingEnable-04906# If the
--     pipeline is being created with fragment shader state, and the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_QCOM_render_pass_shader_resolve VK_QCOM_render_pass_shader_resolve>
--     extension is enabled, and if the subpass description contains
--     'Vulkan.Core10.Enums.SubpassDescriptionFlagBits.SUBPASS_DESCRIPTION_FRAGMENT_REGION_BIT_QCOM',
--     then @sampleShadingEnable@ /must/ be false
--
-- -   #VUID-VkRenderPassCreateInfo2-flags-04907# If @flags@ includes
--     'Vulkan.Core10.Enums.SubpassDescriptionFlagBits.SUBPASS_DESCRIPTION_SHADER_RESOLVE_BIT_QCOM',
--     and if @pResolveAttachments@ is not @NULL@, then each resolve
--     attachment /must/ be 'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED'
--
-- -   #VUID-VkRenderPassCreateInfo2-flags-04908# If @flags@ includes
--     'Vulkan.Core10.Enums.SubpassDescriptionFlagBits.SUBPASS_DESCRIPTION_SHADER_RESOLVE_BIT_QCOM',
--     and if @pDepthStencilResolveAttachment@ is not @NULL@, then the
--     depth\/stencil resolve attachment /must/ be
--     'Vulkan.Core10.APIConstants.ATTACHMENT_UNUSED'
--
-- -   #VUID-VkRenderPassCreateInfo2-flags-04909# If @flags@ includes
--     'Vulkan.Core10.Enums.SubpassDescriptionFlagBits.SUBPASS_DESCRIPTION_SHADER_RESOLVE_BIT_QCOM',
--     then the subpass /must/ be the last subpass in a subpass dependency
--     chain
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkRenderPassCreateInfo2-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_RENDER_PASS_CREATE_INFO_2'
--
-- -   #VUID-VkRenderPassCreateInfo2-pNext-pNext# @pNext@ /must/ be @NULL@
--     or a pointer to a valid instance of
--     'Vulkan.Extensions.VK_EXT_fragment_density_map.RenderPassFragmentDensityMapCreateInfoEXT'
--
-- -   #VUID-VkRenderPassCreateInfo2-sType-unique# The @sType@ value of
--     each struct in the @pNext@ chain /must/ be unique
--
-- -   #VUID-VkRenderPassCreateInfo2-flags-parameter# @flags@ /must/ be a
--     valid combination of
--     'Vulkan.Core10.Enums.RenderPassCreateFlagBits.RenderPassCreateFlagBits'
--     values
--
-- -   #VUID-VkRenderPassCreateInfo2-pAttachments-parameter# If
--     @attachmentCount@ is not @0@, @pAttachments@ /must/ be a valid
--     pointer to an array of @attachmentCount@ valid
--     'AttachmentDescription2' structures
--
-- -   #VUID-VkRenderPassCreateInfo2-pSubpasses-parameter# @pSubpasses@
--     /must/ be a valid pointer to an array of @subpassCount@ valid
--     'SubpassDescription2' structures
--
-- -   #VUID-VkRenderPassCreateInfo2-pDependencies-parameter# If
--     @dependencyCount@ is not @0@, @pDependencies@ /must/ be a valid
--     pointer to an array of @dependencyCount@ valid 'SubpassDependency2'
--     structures
--
-- -   #VUID-VkRenderPassCreateInfo2-pCorrelatedViewMasks-parameter# If
--     @correlatedViewMaskCount@ is not @0@, @pCorrelatedViewMasks@ /must/
--     be a valid pointer to an array of @correlatedViewMaskCount@
--     @uint32_t@ values
--
-- -   #VUID-VkRenderPassCreateInfo2-subpassCount-arraylength#
--     @subpassCount@ /must/ be greater than @0@
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_create_renderpass2 VK_KHR_create_renderpass2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_2 VK_VERSION_1_2>,
-- 'AttachmentDescription2',
-- 'Vulkan.Core10.Enums.RenderPassCreateFlagBits.RenderPassCreateFlags',
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'SubpassDependency2',
-- 'SubpassDescription2', 'createRenderPass2',
-- 'Vulkan.Extensions.VK_KHR_create_renderpass2.createRenderPass2KHR'
data RenderPassCreateInfo2 (es :: [Type]) = RenderPassCreateInfo2
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    RenderPassCreateInfo2 es -> Chain es
next :: Chain es
  , -- | @flags@ is reserved for future use.
    RenderPassCreateInfo2 es -> RenderPassCreateFlags
flags :: RenderPassCreateFlags
  , -- | @pAttachments@ is a pointer to an array of @attachmentCount@
    -- 'AttachmentDescription2' structures describing the attachments used by
    -- the render pass.
    RenderPassCreateInfo2 es
-> Vector (SomeStruct AttachmentDescription2)
attachments :: Vector (SomeStruct AttachmentDescription2)
  , -- | @pSubpasses@ is a pointer to an array of @subpassCount@
    -- 'SubpassDescription2' structures describing each subpass.
    RenderPassCreateInfo2 es -> Vector (SomeStruct SubpassDescription2)
subpasses :: Vector (SomeStruct SubpassDescription2)
  , -- | @pDependencies@ is a pointer to an array of @dependencyCount@
    -- 'SubpassDependency2' structures describing dependencies between pairs of
    -- subpasses.
    RenderPassCreateInfo2 es -> Vector (SomeStruct SubpassDependency2)
dependencies :: Vector (SomeStruct SubpassDependency2)
  , -- | @pCorrelatedViewMasks@ is a pointer to an array of view masks indicating
    -- sets of views that /may/ be more efficient to render concurrently.
    RenderPassCreateInfo2 es -> Vector Word32
correlatedViewMasks :: Vector Word32
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (RenderPassCreateInfo2 (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (RenderPassCreateInfo2 es)

instance Extensible RenderPassCreateInfo2 where
  extensibleTypeName :: String
extensibleTypeName = String
"RenderPassCreateInfo2"
  setNext :: RenderPassCreateInfo2 ds -> Chain es -> RenderPassCreateInfo2 es
setNext RenderPassCreateInfo2{Vector Word32
Vector (SomeStruct SubpassDescription2)
Vector (SomeStruct SubpassDependency2)
Vector (SomeStruct AttachmentDescription2)
Chain ds
RenderPassCreateFlags
correlatedViewMasks :: Vector Word32
dependencies :: Vector (SomeStruct SubpassDependency2)
subpasses :: Vector (SomeStruct SubpassDescription2)
attachments :: Vector (SomeStruct AttachmentDescription2)
flags :: RenderPassCreateFlags
next :: Chain ds
$sel:correlatedViewMasks:RenderPassCreateInfo2 :: forall (es :: [*]). RenderPassCreateInfo2 es -> Vector Word32
$sel:dependencies:RenderPassCreateInfo2 :: forall (es :: [*]).
RenderPassCreateInfo2 es -> Vector (SomeStruct SubpassDependency2)
$sel:subpasses:RenderPassCreateInfo2 :: forall (es :: [*]).
RenderPassCreateInfo2 es -> Vector (SomeStruct SubpassDescription2)
$sel:attachments:RenderPassCreateInfo2 :: forall (es :: [*]).
RenderPassCreateInfo2 es
-> Vector (SomeStruct AttachmentDescription2)
$sel:flags:RenderPassCreateInfo2 :: forall (es :: [*]).
RenderPassCreateInfo2 es -> RenderPassCreateFlags
$sel:next:RenderPassCreateInfo2 :: forall (es :: [*]). RenderPassCreateInfo2 es -> Chain es
..} Chain es
next' = RenderPassCreateInfo2 :: forall (es :: [*]).
Chain es
-> RenderPassCreateFlags
-> Vector (SomeStruct AttachmentDescription2)
-> Vector (SomeStruct SubpassDescription2)
-> Vector (SomeStruct SubpassDependency2)
-> Vector Word32
-> RenderPassCreateInfo2 es
RenderPassCreateInfo2{$sel:next:RenderPassCreateInfo2 :: Chain es
next = Chain es
next', Vector Word32
Vector (SomeStruct SubpassDescription2)
Vector (SomeStruct SubpassDependency2)
Vector (SomeStruct AttachmentDescription2)
RenderPassCreateFlags
correlatedViewMasks :: Vector Word32
dependencies :: Vector (SomeStruct SubpassDependency2)
subpasses :: Vector (SomeStruct SubpassDescription2)
attachments :: Vector (SomeStruct AttachmentDescription2)
flags :: RenderPassCreateFlags
$sel:correlatedViewMasks:RenderPassCreateInfo2 :: Vector Word32
$sel:dependencies:RenderPassCreateInfo2 :: Vector (SomeStruct SubpassDependency2)
$sel:subpasses:RenderPassCreateInfo2 :: Vector (SomeStruct SubpassDescription2)
$sel:attachments:RenderPassCreateInfo2 :: Vector (SomeStruct AttachmentDescription2)
$sel:flags:RenderPassCreateInfo2 :: RenderPassCreateFlags
..}
  getNext :: RenderPassCreateInfo2 es -> Chain es
getNext RenderPassCreateInfo2{Vector Word32
Vector (SomeStruct SubpassDescription2)
Vector (SomeStruct SubpassDependency2)
Vector (SomeStruct AttachmentDescription2)
Chain es
RenderPassCreateFlags
correlatedViewMasks :: Vector Word32
dependencies :: Vector (SomeStruct SubpassDependency2)
subpasses :: Vector (SomeStruct SubpassDescription2)
attachments :: Vector (SomeStruct AttachmentDescription2)
flags :: RenderPassCreateFlags
next :: Chain es
$sel:correlatedViewMasks:RenderPassCreateInfo2 :: forall (es :: [*]). RenderPassCreateInfo2 es -> Vector Word32
$sel:dependencies:RenderPassCreateInfo2 :: forall (es :: [*]).
RenderPassCreateInfo2 es -> Vector (SomeStruct SubpassDependency2)
$sel:subpasses:RenderPassCreateInfo2 :: forall (es :: [*]).
RenderPassCreateInfo2 es -> Vector (SomeStruct SubpassDescription2)
$sel:attachments:RenderPassCreateInfo2 :: forall (es :: [*]).
RenderPassCreateInfo2 es
-> Vector (SomeStruct AttachmentDescription2)
$sel:flags:RenderPassCreateInfo2 :: forall (es :: [*]).
RenderPassCreateInfo2 es -> RenderPassCreateFlags
$sel:next:RenderPassCreateInfo2 :: forall (es :: [*]). RenderPassCreateInfo2 es -> Chain es
..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends RenderPassCreateInfo2 e => b) -> Maybe b
  extends :: proxy e -> (Extends RenderPassCreateInfo2 e => b) -> Maybe b
extends proxy e
_ Extends RenderPassCreateInfo2 e => b
f
    | Just e :~: RenderPassFragmentDensityMapCreateInfoEXT
Refl <- (Typeable e, Typeable RenderPassFragmentDensityMapCreateInfoEXT) =>
Maybe (e :~: RenderPassFragmentDensityMapCreateInfoEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @RenderPassFragmentDensityMapCreateInfoEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends RenderPassCreateInfo2 e => b
f
    | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing

instance (Extendss RenderPassCreateInfo2 es, PokeChain es) => ToCStruct (RenderPassCreateInfo2 es) where
  withCStruct :: RenderPassCreateInfo2 es
-> (Ptr (RenderPassCreateInfo2 es) -> IO b) -> IO b
withCStruct RenderPassCreateInfo2 es
x Ptr (RenderPassCreateInfo2 es) -> IO b
f = Int -> (Ptr (RenderPassCreateInfo2 es) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
80 ((Ptr (RenderPassCreateInfo2 es) -> IO b) -> IO b)
-> (Ptr (RenderPassCreateInfo2 es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr (RenderPassCreateInfo2 es)
p -> Ptr (RenderPassCreateInfo2 es)
-> RenderPassCreateInfo2 es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (RenderPassCreateInfo2 es)
p RenderPassCreateInfo2 es
x (Ptr (RenderPassCreateInfo2 es) -> IO b
f Ptr (RenderPassCreateInfo2 es)
p)
  pokeCStruct :: Ptr (RenderPassCreateInfo2 es)
-> RenderPassCreateInfo2 es -> IO b -> IO b
pokeCStruct Ptr (RenderPassCreateInfo2 es)
p RenderPassCreateInfo2{Vector Word32
Vector (SomeStruct SubpassDescription2)
Vector (SomeStruct SubpassDependency2)
Vector (SomeStruct AttachmentDescription2)
Chain es
RenderPassCreateFlags
correlatedViewMasks :: Vector Word32
dependencies :: Vector (SomeStruct SubpassDependency2)
subpasses :: Vector (SomeStruct SubpassDescription2)
attachments :: Vector (SomeStruct AttachmentDescription2)
flags :: RenderPassCreateFlags
next :: Chain es
$sel:correlatedViewMasks:RenderPassCreateInfo2 :: forall (es :: [*]). RenderPassCreateInfo2 es -> Vector Word32
$sel:dependencies:RenderPassCreateInfo2 :: forall (es :: [*]).
RenderPassCreateInfo2 es -> Vector (SomeStruct SubpassDependency2)
$sel:subpasses:RenderPassCreateInfo2 :: forall (es :: [*]).
RenderPassCreateInfo2 es -> Vector (SomeStruct SubpassDescription2)
$sel:attachments:RenderPassCreateInfo2 :: forall (es :: [*]).
RenderPassCreateInfo2 es
-> Vector (SomeStruct AttachmentDescription2)
$sel:flags:RenderPassCreateInfo2 :: forall (es :: [*]).
RenderPassCreateInfo2 es -> RenderPassCreateFlags
$sel:next:RenderPassCreateInfo2 :: forall (es :: [*]). RenderPassCreateInfo2 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 (RenderPassCreateInfo2 es)
p Ptr (RenderPassCreateInfo2 es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_RENDER_PASS_CREATE_INFO_2)
    Ptr ()
pNext'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (RenderPassCreateInfo2 es)
p Ptr (RenderPassCreateInfo2 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 RenderPassCreateFlags -> RenderPassCreateFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (RenderPassCreateInfo2 es)
p Ptr (RenderPassCreateInfo2 es) -> Int -> Ptr RenderPassCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr RenderPassCreateFlags)) (RenderPassCreateFlags
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 (RenderPassCreateInfo2 es)
p Ptr (RenderPassCreateInfo2 es) -> 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 (SomeStruct AttachmentDescription2) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (SomeStruct AttachmentDescription2) -> Int)
-> Vector (SomeStruct AttachmentDescription2) -> Int
forall a b. (a -> b) -> a -> b
$ (Vector (SomeStruct AttachmentDescription2)
attachments)) :: Word32))
    Ptr (AttachmentDescription2 Any)
pPAttachments' <- ((Ptr (AttachmentDescription2 Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (AttachmentDescription2 Any))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (AttachmentDescription2 Any) -> IO b) -> IO b)
 -> ContT b IO (Ptr (AttachmentDescription2 Any)))
-> ((Ptr (AttachmentDescription2 Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (AttachmentDescription2 Any))
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr (AttachmentDescription2 Any) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @(AttachmentDescription2 _) ((Vector (SomeStruct AttachmentDescription2) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (SomeStruct AttachmentDescription2)
attachments)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
56)
    (Int -> SomeStruct AttachmentDescription2 -> ContT b IO ())
-> Vector (SomeStruct AttachmentDescription2) -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i SomeStruct AttachmentDescription2
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (SomeStruct AttachmentDescription2)
-> SomeStruct AttachmentDescription2 -> IO b -> IO b
forall (a :: [*] -> *) b.
(forall (es :: [*]).
 (Extendss a es, PokeChain es) =>
 ToCStruct (a es)) =>
Ptr (SomeStruct a) -> SomeStruct a -> IO b -> IO b
pokeSomeCStruct (Ptr (AttachmentDescription2 Any)
-> Ptr (SomeStruct AttachmentDescription2)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (AttachmentDescription2 Any)
pPAttachments' Ptr (AttachmentDescription2 Any)
-> Int -> Ptr (AttachmentDescription2 _)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
56 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (AttachmentDescription2 _))) (SomeStruct AttachmentDescription2
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector (SomeStruct AttachmentDescription2)
attachments)
    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 (AttachmentDescription2 Any))
-> Ptr (AttachmentDescription2 Any) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (RenderPassCreateInfo2 es)
p Ptr (RenderPassCreateInfo2 es)
-> Int -> Ptr (Ptr (AttachmentDescription2 _))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr (AttachmentDescription2 _)))) (Ptr (AttachmentDescription2 Any)
pPAttachments')
    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 (RenderPassCreateInfo2 es)
p Ptr (RenderPassCreateInfo2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector (SomeStruct SubpassDescription2) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (SomeStruct SubpassDescription2) -> Int)
-> Vector (SomeStruct SubpassDescription2) -> Int
forall a b. (a -> b) -> a -> b
$ (Vector (SomeStruct SubpassDescription2)
subpasses)) :: Word32))
    Ptr (SubpassDescription2 Any)
pPSubpasses' <- ((Ptr (SubpassDescription2 Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (SubpassDescription2 Any))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (SubpassDescription2 Any) -> IO b) -> IO b)
 -> ContT b IO (Ptr (SubpassDescription2 Any)))
-> ((Ptr (SubpassDescription2 Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (SubpassDescription2 Any))
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr (SubpassDescription2 Any) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @(SubpassDescription2 _) ((Vector (SomeStruct SubpassDescription2) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (SomeStruct SubpassDescription2)
subpasses)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
88)
    (Int -> SomeStruct SubpassDescription2 -> ContT b IO ())
-> Vector (SomeStruct SubpassDescription2) -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i SomeStruct SubpassDescription2
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (SomeStruct SubpassDescription2)
-> SomeStruct SubpassDescription2 -> IO b -> IO b
forall (a :: [*] -> *) b.
(forall (es :: [*]).
 (Extendss a es, PokeChain es) =>
 ToCStruct (a es)) =>
Ptr (SomeStruct a) -> SomeStruct a -> IO b -> IO b
pokeSomeCStruct (Ptr (SubpassDescription2 Any)
-> Ptr (SomeStruct SubpassDescription2)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (SubpassDescription2 Any)
pPSubpasses' Ptr (SubpassDescription2 Any) -> Int -> Ptr (SubpassDescription2 _)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
88 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (SubpassDescription2 _))) (SomeStruct SubpassDescription2
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector (SomeStruct SubpassDescription2)
subpasses)
    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 (SubpassDescription2 Any))
-> Ptr (SubpassDescription2 Any) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (RenderPassCreateInfo2 es)
p Ptr (RenderPassCreateInfo2 es)
-> Int -> Ptr (Ptr (SubpassDescription2 _))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr (SubpassDescription2 _)))) (Ptr (SubpassDescription2 Any)
pPSubpasses')
    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 (RenderPassCreateInfo2 es)
p Ptr (RenderPassCreateInfo2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector (SomeStruct SubpassDependency2) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (SomeStruct SubpassDependency2) -> Int)
-> Vector (SomeStruct SubpassDependency2) -> Int
forall a b. (a -> b) -> a -> b
$ (Vector (SomeStruct SubpassDependency2)
dependencies)) :: Word32))
    Ptr (SubpassDependency2 Any)
pPDependencies' <- ((Ptr (SubpassDependency2 Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (SubpassDependency2 Any))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (SubpassDependency2 Any) -> IO b) -> IO b)
 -> ContT b IO (Ptr (SubpassDependency2 Any)))
-> ((Ptr (SubpassDependency2 Any) -> IO b) -> IO b)
-> ContT b IO (Ptr (SubpassDependency2 Any))
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr (SubpassDependency2 Any) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @(SubpassDependency2 _) ((Vector (SomeStruct SubpassDependency2) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (SomeStruct SubpassDependency2)
dependencies)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
48)
    (Int -> SomeStruct SubpassDependency2 -> ContT b IO ())
-> Vector (SomeStruct SubpassDependency2) -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i SomeStruct SubpassDependency2
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (SomeStruct SubpassDependency2)
-> SomeStruct SubpassDependency2 -> IO b -> IO b
forall (a :: [*] -> *) b.
(forall (es :: [*]).
 (Extendss a es, PokeChain es) =>
 ToCStruct (a es)) =>
Ptr (SomeStruct a) -> SomeStruct a -> IO b -> IO b
pokeSomeCStruct (Ptr (SubpassDependency2 Any) -> Ptr (SomeStruct SubpassDependency2)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions (Ptr (SubpassDependency2 Any)
pPDependencies' Ptr (SubpassDependency2 Any) -> Int -> Ptr (SubpassDependency2 _)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
48 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (SubpassDependency2 _))) (SomeStruct SubpassDependency2
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector (SomeStruct SubpassDependency2)
dependencies)
    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 (SubpassDependency2 Any))
-> Ptr (SubpassDependency2 Any) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (RenderPassCreateInfo2 es)
p Ptr (RenderPassCreateInfo2 es)
-> Int -> Ptr (Ptr (SubpassDependency2 _))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr (Ptr (SubpassDependency2 _)))) (Ptr (SubpassDependency2 Any)
pPDependencies')
    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 (RenderPassCreateInfo2 es)
p Ptr (RenderPassCreateInfo2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word32 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Word32 -> Int) -> Vector Word32 -> Int
forall a b. (a -> b) -> a -> b
$ (Vector Word32
correlatedViewMasks)) :: Word32))
    Ptr Word32
pPCorrelatedViewMasks' <- ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32))
-> ((Ptr Word32 -> IO b) -> IO b) -> ContT b IO (Ptr Word32)
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr Word32 -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @Word32 ((Vector Word32 -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Word32
correlatedViewMasks)) 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 -> Word32 -> IO ()) -> Vector Word32 -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i Word32
e -> Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word32
pPCorrelatedViewMasks' Ptr Word32 -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32) (Word32
e)) (Vector Word32
correlatedViewMasks)
    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 Word32) -> Ptr Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (RenderPassCreateInfo2 es)
p Ptr (RenderPassCreateInfo2 es) -> Int -> Ptr (Ptr Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr (Ptr Word32))) (Ptr Word32
pPCorrelatedViewMasks')
    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
80
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr (RenderPassCreateInfo2 es) -> IO b -> IO b
pokeZeroCStruct Ptr (RenderPassCreateInfo2 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 (RenderPassCreateInfo2 es)
p Ptr (RenderPassCreateInfo2 es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_RENDER_PASS_CREATE_INFO_2)
    Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall 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 (RenderPassCreateInfo2 es)
p Ptr (RenderPassCreateInfo2 es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext'
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

instance (Extendss RenderPassCreateInfo2 es, PeekChain es) => FromCStruct (RenderPassCreateInfo2 es) where
  peekCStruct :: Ptr (RenderPassCreateInfo2 es) -> IO (RenderPassCreateInfo2 es)
peekCStruct Ptr (RenderPassCreateInfo2 es)
p = do
    Ptr ()
pNext <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (RenderPassCreateInfo2 es)
p Ptr (RenderPassCreateInfo2 es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ())))
    Chain es
next <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
    RenderPassCreateFlags
flags <- Ptr RenderPassCreateFlags -> IO RenderPassCreateFlags
forall a. Storable a => Ptr a -> IO a
peek @RenderPassCreateFlags ((Ptr (RenderPassCreateInfo2 es)
p Ptr (RenderPassCreateInfo2 es) -> Int -> Ptr RenderPassCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr RenderPassCreateFlags))
    Word32
attachmentCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (RenderPassCreateInfo2 es)
p Ptr (RenderPassCreateInfo2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
    Ptr (AttachmentDescription2 Any)
pAttachments <- Ptr (Ptr (AttachmentDescription2 Any))
-> IO (Ptr (AttachmentDescription2 Any))
forall a. Storable a => Ptr a -> IO a
peek @(Ptr (AttachmentDescription2 _)) ((Ptr (RenderPassCreateInfo2 es)
p Ptr (RenderPassCreateInfo2 es)
-> Int -> Ptr (Ptr (AttachmentDescription2 _))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr (AttachmentDescription2 _))))
    Vector (SomeStruct AttachmentDescription2)
pAttachments' <- Int
-> (Int -> IO (SomeStruct AttachmentDescription2))
-> IO (Vector (SomeStruct AttachmentDescription2))
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
attachmentCount) (\Int
i -> Ptr (SomeStruct AttachmentDescription2)
-> IO (SomeStruct AttachmentDescription2)
forall (a :: [*] -> *).
(Extensible a,
 forall (es :: [*]).
 (Extendss a es, PeekChain es) =>
 FromCStruct (a es)) =>
Ptr (SomeStruct a) -> IO (SomeStruct a)
peekSomeCStruct (Ptr (AttachmentDescription2 Any)
-> Ptr (SomeStruct AttachmentDescription2)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions ((Ptr (AttachmentDescription2 Any)
pAttachments Ptr (AttachmentDescription2 Any)
-> Int -> Ptr (AttachmentDescription2 Any)
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
56 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (AttachmentDescription2 _)))))
    Word32
subpassCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (RenderPassCreateInfo2 es)
p Ptr (RenderPassCreateInfo2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32))
    Ptr (SubpassDescription2 Any)
pSubpasses <- Ptr (Ptr (SubpassDescription2 Any))
-> IO (Ptr (SubpassDescription2 Any))
forall a. Storable a => Ptr a -> IO a
peek @(Ptr (SubpassDescription2 _)) ((Ptr (RenderPassCreateInfo2 es)
p Ptr (RenderPassCreateInfo2 es)
-> Int -> Ptr (Ptr (SubpassDescription2 _))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr (SubpassDescription2 _))))
    Vector (SomeStruct SubpassDescription2)
pSubpasses' <- Int
-> (Int -> IO (SomeStruct SubpassDescription2))
-> IO (Vector (SomeStruct SubpassDescription2))
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
subpassCount) (\Int
i -> Ptr (SomeStruct SubpassDescription2)
-> IO (SomeStruct SubpassDescription2)
forall (a :: [*] -> *).
(Extensible a,
 forall (es :: [*]).
 (Extendss a es, PeekChain es) =>
 FromCStruct (a es)) =>
Ptr (SomeStruct a) -> IO (SomeStruct a)
peekSomeCStruct (Ptr (SubpassDescription2 Any)
-> Ptr (SomeStruct SubpassDescription2)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions ((Ptr (SubpassDescription2 Any)
pSubpasses Ptr (SubpassDescription2 Any)
-> Int -> Ptr (SubpassDescription2 Any)
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
88 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (SubpassDescription2 _)))))
    Word32
dependencyCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (RenderPassCreateInfo2 es)
p Ptr (RenderPassCreateInfo2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Word32))
    Ptr (SubpassDependency2 Any)
pDependencies <- Ptr (Ptr (SubpassDependency2 Any))
-> IO (Ptr (SubpassDependency2 Any))
forall a. Storable a => Ptr a -> IO a
peek @(Ptr (SubpassDependency2 _)) ((Ptr (RenderPassCreateInfo2 es)
p Ptr (RenderPassCreateInfo2 es)
-> Int -> Ptr (Ptr (SubpassDependency2 _))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr (Ptr (SubpassDependency2 _))))
    Vector (SomeStruct SubpassDependency2)
pDependencies' <- Int
-> (Int -> IO (SomeStruct SubpassDependency2))
-> IO (Vector (SomeStruct SubpassDependency2))
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
dependencyCount) (\Int
i -> Ptr (SomeStruct SubpassDependency2)
-> IO (SomeStruct SubpassDependency2)
forall (a :: [*] -> *).
(Extensible a,
 forall (es :: [*]).
 (Extendss a es, PeekChain es) =>
 FromCStruct (a es)) =>
Ptr (SomeStruct a) -> IO (SomeStruct a)
peekSomeCStruct (Ptr (SubpassDependency2 Any) -> Ptr (SomeStruct SubpassDependency2)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions ((Ptr (SubpassDependency2 Any)
pDependencies Ptr (SubpassDependency2 Any) -> Int -> Ptr (SubpassDependency2 Any)
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
48 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (SubpassDependency2 _)))))
    Word32
correlatedViewMaskCount <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (RenderPassCreateInfo2 es)
p Ptr (RenderPassCreateInfo2 es) -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr Word32))
    Ptr Word32
pCorrelatedViewMasks <- Ptr (Ptr Word32) -> IO (Ptr Word32)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Word32) ((Ptr (RenderPassCreateInfo2 es)
p Ptr (RenderPassCreateInfo2 es) -> Int -> Ptr (Ptr Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr (Ptr Word32)))
    Vector Word32
pCorrelatedViewMasks' <- Int -> (Int -> IO Word32) -> IO (Vector Word32)
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
correlatedViewMaskCount) (\Int
i -> Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr Word32
pCorrelatedViewMasks Ptr Word32 -> Int -> Ptr Word32
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Word32)))
    RenderPassCreateInfo2 es -> IO (RenderPassCreateInfo2 es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RenderPassCreateInfo2 es -> IO (RenderPassCreateInfo2 es))
-> RenderPassCreateInfo2 es -> IO (RenderPassCreateInfo2 es)
forall a b. (a -> b) -> a -> b
$ Chain es
-> RenderPassCreateFlags
-> Vector (SomeStruct AttachmentDescription2)
-> Vector (SomeStruct SubpassDescription2)
-> Vector (SomeStruct SubpassDependency2)
-> Vector Word32
-> RenderPassCreateInfo2 es
forall (es :: [*]).
Chain es
-> RenderPassCreateFlags
-> Vector (SomeStruct AttachmentDescription2)
-> Vector (SomeStruct SubpassDescription2)
-> Vector (SomeStruct SubpassDependency2)
-> Vector Word32
-> RenderPassCreateInfo2 es
RenderPassCreateInfo2
             Chain es
next RenderPassCreateFlags
flags Vector (SomeStruct AttachmentDescription2)
pAttachments' Vector (SomeStruct SubpassDescription2)
pSubpasses' Vector (SomeStruct SubpassDependency2)
pDependencies' Vector Word32
pCorrelatedViewMasks'

instance es ~ '[] => Zero (RenderPassCreateInfo2 es) where
  zero :: RenderPassCreateInfo2 es
zero = Chain es
-> RenderPassCreateFlags
-> Vector (SomeStruct AttachmentDescription2)
-> Vector (SomeStruct SubpassDescription2)
-> Vector (SomeStruct SubpassDependency2)
-> Vector Word32
-> RenderPassCreateInfo2 es
forall (es :: [*]).
Chain es
-> RenderPassCreateFlags
-> Vector (SomeStruct AttachmentDescription2)
-> Vector (SomeStruct SubpassDescription2)
-> Vector (SomeStruct SubpassDependency2)
-> Vector Word32
-> RenderPassCreateInfo2 es
RenderPassCreateInfo2
           ()
           RenderPassCreateFlags
forall a. Zero a => a
zero
           Vector (SomeStruct AttachmentDescription2)
forall a. Monoid a => a
mempty
           Vector (SomeStruct SubpassDescription2)
forall a. Monoid a => a
mempty
           Vector (SomeStruct SubpassDependency2)
forall a. Monoid a => a
mempty
           Vector Word32
forall a. Monoid a => a
mempty


-- | VkSubpassBeginInfo - Structure specifying subpass begin information
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_create_renderpass2 VK_KHR_create_renderpass2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_2 VK_VERSION_1_2>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType',
-- 'Vulkan.Core10.Enums.SubpassContents.SubpassContents',
-- 'cmdBeginRenderPass2',
-- 'Vulkan.Extensions.VK_KHR_create_renderpass2.cmdBeginRenderPass2KHR',
-- 'cmdNextSubpass2',
-- 'Vulkan.Extensions.VK_KHR_create_renderpass2.cmdNextSubpass2KHR'
data SubpassBeginInfo = SubpassBeginInfo
  { -- | @contents@ is a 'Vulkan.Core10.Enums.SubpassContents.SubpassContents'
    -- value specifying how the commands in the next subpass will be provided.
    --
    -- #VUID-VkSubpassBeginInfo-contents-parameter# @contents@ /must/ be a
    -- valid 'Vulkan.Core10.Enums.SubpassContents.SubpassContents' value
    SubpassBeginInfo -> SubpassContents
contents :: SubpassContents }
  deriving (Typeable, SubpassBeginInfo -> SubpassBeginInfo -> Bool
(SubpassBeginInfo -> SubpassBeginInfo -> Bool)
-> (SubpassBeginInfo -> SubpassBeginInfo -> Bool)
-> Eq SubpassBeginInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubpassBeginInfo -> SubpassBeginInfo -> Bool
$c/= :: SubpassBeginInfo -> SubpassBeginInfo -> Bool
== :: SubpassBeginInfo -> SubpassBeginInfo -> Bool
$c== :: SubpassBeginInfo -> SubpassBeginInfo -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SubpassBeginInfo)
#endif
deriving instance Show SubpassBeginInfo

instance ToCStruct SubpassBeginInfo where
  withCStruct :: SubpassBeginInfo
-> (("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo) -> IO b) -> IO b
withCStruct SubpassBeginInfo
x ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo) -> IO b
f = Int
-> (("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 ((("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo) -> IO b) -> IO b)
-> (("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \"pSubpassBeginInfo" ::: Ptr SubpassBeginInfo
p -> ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
-> SubpassBeginInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pSubpassBeginInfo" ::: Ptr SubpassBeginInfo
p SubpassBeginInfo
x (("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo) -> IO b
f "pSubpassBeginInfo" ::: Ptr SubpassBeginInfo
p)
  pokeCStruct :: ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
-> SubpassBeginInfo -> IO b -> IO b
pokeCStruct "pSubpassBeginInfo" ::: Ptr SubpassBeginInfo
p SubpassBeginInfo{SubpassContents
contents :: SubpassContents
$sel:contents:SubpassBeginInfo :: SubpassBeginInfo -> SubpassContents
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo
p ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SUBPASS_BEGIN_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo
p ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr SubpassContents -> SubpassContents -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo
p ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
-> Int -> Ptr SubpassContents
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr SubpassContents)) (SubpassContents
contents)
    IO b
f
  cStructSize :: Int
cStructSize = Int
24
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo) -> IO b -> IO b
pokeZeroCStruct "pSubpassBeginInfo" ::: Ptr SubpassBeginInfo
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo
p ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SUBPASS_BEGIN_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo
p ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
-> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr SubpassContents -> SubpassContents -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo
p ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
-> Int -> Ptr SubpassContents
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr SubpassContents)) (SubpassContents
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct SubpassBeginInfo where
  peekCStruct :: ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
-> IO SubpassBeginInfo
peekCStruct "pSubpassBeginInfo" ::: Ptr SubpassBeginInfo
p = do
    SubpassContents
contents <- Ptr SubpassContents -> IO SubpassContents
forall a. Storable a => Ptr a -> IO a
peek @SubpassContents (("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo
p ("pSubpassBeginInfo" ::: Ptr SubpassBeginInfo)
-> Int -> Ptr SubpassContents
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr SubpassContents))
    SubpassBeginInfo -> IO SubpassBeginInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubpassBeginInfo -> IO SubpassBeginInfo)
-> SubpassBeginInfo -> IO SubpassBeginInfo
forall a b. (a -> b) -> a -> b
$ SubpassContents -> SubpassBeginInfo
SubpassBeginInfo
             SubpassContents
contents

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

instance Zero SubpassBeginInfo where
  zero :: SubpassBeginInfo
zero = SubpassContents -> SubpassBeginInfo
SubpassBeginInfo
           SubpassContents
forall a. Zero a => a
zero


-- | VkSubpassEndInfo - Structure specifying subpass end information
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkSubpassEndInfo-sType-sType# @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SUBPASS_END_INFO'
--
-- -   #VUID-VkSubpassEndInfo-pNext-pNext# @pNext@ /must/ be @NULL@ or a
--     pointer to a valid instance of
--     'Vulkan.Extensions.VK_QCOM_fragment_density_map_offset.SubpassFragmentDensityMapOffsetEndInfoQCOM'
--
-- -   #VUID-VkSubpassEndInfo-sType-unique# The @sType@ value of each
--     struct in the @pNext@ chain /must/ be unique
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_create_renderpass2 VK_KHR_create_renderpass2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_2 VK_VERSION_1_2>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType', 'cmdEndRenderPass2',
-- 'Vulkan.Extensions.VK_KHR_create_renderpass2.cmdEndRenderPass2KHR',
-- 'cmdNextSubpass2',
-- 'Vulkan.Extensions.VK_KHR_create_renderpass2.cmdNextSubpass2KHR'
data SubpassEndInfo (es :: [Type]) = SubpassEndInfo
  { -- | @pNext@ is @NULL@ or a pointer to a structure extending this structure.
    SubpassEndInfo es -> Chain es
next :: Chain es }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SubpassEndInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (SubpassEndInfo es)

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

instance (Extendss SubpassEndInfo es, PokeChain es) => ToCStruct (SubpassEndInfo es) where
  withCStruct :: SubpassEndInfo es -> (Ptr (SubpassEndInfo es) -> IO b) -> IO b
withCStruct SubpassEndInfo es
x Ptr (SubpassEndInfo es) -> IO b
f = Int -> (Ptr (SubpassEndInfo es) -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
16 ((Ptr (SubpassEndInfo es) -> IO b) -> IO b)
-> (Ptr (SubpassEndInfo es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr (SubpassEndInfo es)
p -> Ptr (SubpassEndInfo es) -> SubpassEndInfo es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (SubpassEndInfo es)
p SubpassEndInfo es
x (Ptr (SubpassEndInfo es) -> IO b
f Ptr (SubpassEndInfo es)
p)
  pokeCStruct :: Ptr (SubpassEndInfo es) -> SubpassEndInfo es -> IO b -> IO b
pokeCStruct Ptr (SubpassEndInfo es)
p SubpassEndInfo{Chain es
next :: Chain es
$sel:next:SubpassEndInfo :: forall (es :: [*]). SubpassEndInfo 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 (SubpassEndInfo es)
p Ptr (SubpassEndInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SUBPASS_END_INFO)
    Ptr ()
pNext'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SubpassEndInfo es)
p Ptr (SubpassEndInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext''
    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
16
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr (SubpassEndInfo es) -> IO b -> IO b
pokeZeroCStruct Ptr (SubpassEndInfo 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 (SubpassEndInfo es)
p Ptr (SubpassEndInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SUBPASS_END_INFO)
    Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall a. PokeChain es => (Ptr (Chain es) -> IO a) -> IO a
forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (SubpassEndInfo es)
p Ptr (SubpassEndInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext'
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

instance (Extendss SubpassEndInfo es, PeekChain es) => FromCStruct (SubpassEndInfo es) where
  peekCStruct :: Ptr (SubpassEndInfo es) -> IO (SubpassEndInfo es)
peekCStruct Ptr (SubpassEndInfo es)
p = do
    Ptr ()
pNext <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (SubpassEndInfo es)
p Ptr (SubpassEndInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ())))
    Chain es
next <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
    SubpassEndInfo es -> IO (SubpassEndInfo es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubpassEndInfo es -> IO (SubpassEndInfo es))
-> SubpassEndInfo es -> IO (SubpassEndInfo es)
forall a b. (a -> b) -> a -> b
$ Chain es -> SubpassEndInfo es
forall (es :: [*]). Chain es -> SubpassEndInfo es
SubpassEndInfo
             Chain es
next

instance es ~ '[] => Zero (SubpassEndInfo es) where
  zero :: SubpassEndInfo es
zero = Chain es -> SubpassEndInfo es
forall (es :: [*]). Chain es -> SubpassEndInfo es
SubpassEndInfo
           ()