{-# language CPP #-}
-- | = Name
--
-- VK_HUAWEI_subpass_shading - device extension
--
-- == VK_HUAWEI_subpass_shading
--
-- [__Name String__]
--     @VK_HUAWEI_subpass_shading@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     370
--
-- [__Revision__]
--     2
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires Vulkan 1.0
--
--     -   Requires @VK_KHR_create_renderpass2@
--
--     -   Requires @VK_KHR_synchronization2@
--
-- [__Contact__]
--
--     -   Hueilong Wang
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_HUAWEI_subpass_shading] @wyvernathuawei%0A<<Here describe the issue or question you have about the VK_HUAWEI_subpass_shading extension>> >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2021-06-01
--
-- [__Interactions and External Dependencies__]
--
--     -   This extension requires
--         <https://github.com/KhronosGroup/GLSL/blob/master/extensions/huawei/GLSL_HUAWEI_subpass_shading.txt GL_HUAWEI_subpass_shading>.
--
--     -   This extension requires
--         <https://htmlpreview.github.io/?https://github.com/KhronosGroup/SPIRV-Registry/blob/master/extensions/HUAWEI/SPV_HUAWEI_subpass_shading.html SPV_HUAWEI_subpass_shading>.
--
-- [__Contributors__]
--
--     -   Hueilong Wang
--
-- == Description
--
-- This extension allows applications to execute a subpass shading pipeline
-- in a subpass of a render pass in order to save memory bandwidth for
-- algorithms like tile-based deferred rendering and forward plus. A
-- subpass shading pipeline is a pipeline with the compute pipeline
-- ability, allowed to read values from input attachments, and only allowed
-- to be dispatched inside a stand-alone subpass. Its work dimension is
-- defined by the render pass’s render area size. Its workgroup size
-- (width, height) shall be a power-of-two number in width or height, with
-- minimum value from 8, and maximum value shall be decided from the render
-- pass attachments and sample counts but depends on implementation.
--
-- The @GlobalInvocationId.xy@ of a subpass shading pipeline is equal to
-- the @FragCoord.xy@ of a graphic pipeline in the same render pass
-- subtracted the <VkRect2D.html offset> of the
-- 'Vulkan.Core10.CommandBufferBuilding.RenderPassBeginInfo'::@renderArea@.
-- @GlobalInvocationId.z@ is mapped to the Layer if
-- @VK_EXT_shader_viewport_index_layer@ is supported. The
-- @GlobalInvocationId.xy@ is equal to the index of the local workgroup
-- multiplied by the size of the local workgroup plus the
-- @LocalInvocationId@ and the <VkRect2D.html offset> of the
-- 'Vulkan.Core10.CommandBufferBuilding.RenderPassBeginInfo'::@renderArea@.
--
-- This extension allows a subpass’s pipeline bind point to be
-- 'Vulkan.Core10.Enums.PipelineBindPoint.PIPELINE_BIND_POINT_SUBPASS_SHADING_HUAWEI'.
--
-- == New Commands
--
-- -   'cmdSubpassShadingHUAWEI'
--
-- -   'getDeviceSubpassShadingMaxWorkgroupSizeHUAWEI'
--
-- == New Structures
--
-- -   Extending 'Vulkan.Core10.Pipeline.ComputePipelineCreateInfo':
--
--     -   'SubpassShadingPipelineCreateInfoHUAWEI'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDeviceSubpassShadingFeaturesHUAWEI'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2':
--
--     -   'PhysicalDeviceSubpassShadingPropertiesHUAWEI'
--
-- == New Enum Constants
--
-- -   'HUAWEI_SUBPASS_SHADING_EXTENSION_NAME'
--
-- -   'HUAWEI_SUBPASS_SHADING_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.PipelineBindPoint.PipelineBindPoint':
--
--     -   'Vulkan.Core10.Enums.PipelineBindPoint.PIPELINE_BIND_POINT_SUBPASS_SHADING_HUAWEI'
--
-- -   Extending
--     'Vulkan.Extensions.VK_KHR_synchronization2.PipelineStageFlagBits2KHR':
--
--     -   'Vulkan.Extensions.VK_KHR_synchronization2.PIPELINE_STAGE_2_SUBPASS_SHADING_BIT_HUAWEI'
--
-- -   Extending
--     'Vulkan.Core10.Enums.ShaderStageFlagBits.ShaderStageFlagBits':
--
--     -   'Vulkan.Core10.Enums.ShaderStageFlagBits.SHADER_STAGE_SUBPASS_SHADING_BIT_HUAWEI'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_SUBPASS_SHADING_FEATURES_HUAWEI'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_SUBPASS_SHADING_PROPERTIES_HUAWEI'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SUBPASS_SHADING_PIPELINE_CREATE_INFO_HUAWEI'
--
-- == Sample Code
--
-- Example of subpass shading in a GLSL shader
--
-- > #extension GL_HUAWEI_subpass_shading: enable
-- > #extension GL_KHR_shader_subgroup_arithmetic: enable
-- >
-- > layout(constant_id = 0) const uint tileWidth = 8;
-- > layout(constant_id = 1) const uint tileHeight = 8;
-- > layout(local_size_x_id = 0, local_size_y_id = 1, local_size_z = 1) in;
-- > layout (set=0, binding=0, input_attachment_index=0) uniform subpassInput depth;
-- >
-- > void main()
-- > {
-- >   float d = subpassLoad(depth).x;
-- >   float minD = subgroupMin(d);
-- >   float maxD = subgroupMax(d);
-- > }
--
-- Example of subpass shading dispatching in a subpass
--
-- > vkCmdNextSubpass(commandBuffer, VK_SUBPASS_CONTENTS_INLINE);
-- > vkCmdBindPipeline(commandBuffer, VK_PIPELINE_BIND_POINT_SUBPASS_SHADING_HUAWEI, subpassShadingPipeline);
-- > vkCmdBindDescriptorSets(commandBuffer, VK_PIPELINE_BIND_POINT_SUBPASS_SHADING_HUAWEI, subpassShadingPipelineLayout,
-- >   firstSet, descriptorSetCount, pDescriptorSets, dynamicOffsetCount, pDynamicOffsets);
-- > vkCmdSubpassShadingHUAWEI(commandBuffer)
-- > vkCmdEndRenderPass(commandBuffer);
--
-- Example of subpass shading render pass creation
--
-- > VkAttachmentDescription2 attachments[] = {
-- >   {
-- >     VK_STRUCTURE_TYPE_ATTACHMENT_DESCRIPTION_2, NULL,
-- >     0, VK_FORMAT_R8G8B8A8_UNORM, VK_SAMPLE_COUNT_1_BIT,
-- >     VK_ATTACHMENT_LOAD_OP_CLEAR, VK_ATTACHMENT_STORE_OP_DONT_CARE,
-- >     VK_ATTACHMENT_LOAD_OP_DONT_CARE, VK_ATTACHMENT_LOAD_OP_DONT_CARE,
-- >     VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL, VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL
-- >   },
-- >   {
-- >     VK_STRUCTURE_TYPE_ATTACHMENT_DESCRIPTION_2, NULL,
-- >     0, VK_FORMAT_R8G8B8A8_UNORM, VK_SAMPLE_COUNT_1_BIT,
-- >     VK_ATTACHMENT_LOAD_OP_CLEAR, VK_ATTACHMENT_STORE_OP_DONT_CARE,
-- >     VK_ATTACHMENT_LOAD_OP_DONT_CARE, VK_ATTACHMENT_LOAD_OP_DONT_CARE,
-- >     VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL, VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL
-- >   },
-- >   {
-- >     VK_STRUCTURE_TYPE_ATTACHMENT_DESCRIPTION_2, NULL,
-- >     0, VK_FORMAT_R8G8B8A8_UNORM, VK_SAMPLE_COUNT_1_BIT,
-- >     VK_ATTACHMENT_LOAD_OP_CLEAR, VK_ATTACHMENT_STORE_OP_DONT_CARE,
-- >     VK_ATTACHMENT_LOAD_OP_DONT_CARE, VK_ATTACHMENT_LOAD_OP_DONT_CARE,
-- >     VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL, VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL
-- >   },
-- >   {
-- >     VK_STRUCTURE_TYPE_ATTACHMENT_DESCRIPTION_2, NULL,
-- >     0, VK_FORMAT_D24_UNORM_S8_UINT, VK_SAMPLE_COUNT_1_BIT,
-- >     VK_ATTACHMENT_LOAD_OP_CLEAR, VK_ATTACHMENT_STORE_OP_DONT_CARE,
-- >     VK_ATTACHMENT_LOAD_OP_CLEAR, VK_ATTACHMENT_LOAD_OP_DONT_CARE,
-- >     VK_IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL, VK_IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL
-- >   },
-- >   {
-- >     VK_STRUCTURE_TYPE_ATTACHMENT_DESCRIPTION_2, NULL,
-- >     0, VK_FORMAT_R8G8B8A8_UNORM, VK_SAMPLE_COUNT_1_BIT,
-- >     VK_ATTACHMENT_LOAD_OP_CLEAR, VK_ATTACHMENT_STORE_OP_STORE,
-- >     VK_ATTACHMENT_LOAD_OP_DONT_CARE, VK_ATTACHMENT_LOAD_OP_DONT_CARE,
-- >     VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL, VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL
-- >   }
-- > };
-- >
-- > VkAttachmentReference2 gBufferAttachmentReferences[] = {
-- >   { VK_STRUCTURE_TYPE_ATTACHMENT_REFERENCE_2, NULL, 0, VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL, VK_IMAGE_ASPECT_COLOR_BIT },
-- >   { VK_STRUCTURE_TYPE_ATTACHMENT_REFERENCE_2, NULL, 1, VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL, VK_IMAGE_ASPECT_COLOR_BIT },
-- >   { VK_STRUCTURE_TYPE_ATTACHMENT_REFERENCE_2, NULL, 2, VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL, VK_IMAGE_ASPECT_COLOR_BIT }
-- > };
-- > VkAttachmentReference2 gBufferDepthStencilAttachmentReferences =
-- >   { VK_STRUCTURE_TYPE_ATTACHMENT_REFERENCE_2, NULL, 3, VK_IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL, VK_IMAGE_ASPECT_DEPTH_BIT|VK_IMAGE_ASPECT_STENCIL_BIT };
-- > VkAttachmentReference2 depthInputAttachmentReferences[] = {
-- >   { VK_STRUCTURE_TYPE_ATTACHMENT_REFERENCE_2, NULL, 3, VK_IMAGE_LAYOUT_DEPTH_STENCIL_READ_ONLY_OPTIMAL, VK_IMAGE_ASPECT_DEPTH_BIT|VK_IMAGE_ASPECT_STENCIL_BIT };
-- > };
-- > VkAttachmentReference2 preserveAttachmentReferences[] = {
-- >   { VK_STRUCTURE_TYPE_ATTACHMENT_REFERENCE_2, NULL, 0, VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL, VK_IMAGE_ASPECT_COLOR_BIT },
-- >   { VK_STRUCTURE_TYPE_ATTACHMENT_REFERENCE_2, NULL, 1, VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL, VK_IMAGE_ASPECT_COLOR_BIT },
-- >   { VK_STRUCTURE_TYPE_ATTACHMENT_REFERENCE_2, NULL, 2, VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL, VK_IMAGE_ASPECT_COLOR_BIT },
-- >   { VK_STRUCTURE_TYPE_ATTACHMENT_REFERENCE_2, NULL, 3, VK_IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL, VK_IMAGE_ASPECT_DEPTH_BIT|VK_IMAGE_ASPECT_STENCIL_BIT }
-- > }; // G buffer including depth/stencil
-- > VkAttachmentReference2 colorAttachmentReferences[] = {
-- >   { VK_STRUCTURE_TYPE_ATTACHMENT_REFERENCE_2, NULL, 4, VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL, VK_IMAGE_ASPECT_COLOR_BIT }
-- > };
-- > VkAttachmentReference2 resolveAttachmentReference =
-- >   { VK_STRUCTURE_TYPE_ATTACHMENT_REFERENCE_2, NULL, 4, VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL, VK_IMAGE_ASPECT_COLOR_BIT };
-- >
-- > VkSubpassDescription2 subpasses[] = {
-- >   {
-- >     VK_STRUCTURE_TYPE_SUBPASS_DESCRIPTION_2, NULL, 0, VK_PIPELINE_BIND_POINT_GRAPHICS, 0,
-- >     0, NULL, // input
-- >     sizeof(gBufferAttachmentReferences)/sizeof(gBufferAttachmentReferences[0]), gBufferAttachmentReferences, // color
-- >     NULL, &gBufferDepthStencilAttachmentReferences, // resolve & DS
-- >     0, NULL
-- >   },
-- >   {
-- >     VK_STRUCTURE_TYPE_SUBPASS_DESCRIPTION_2, NULL, 0, VK_PIPELINE_BIND_POINT_SUBPASS_SHADING_HUAWEI , 0,
-- >     sizeof(depthInputAttachmentReferences)/sizeof(depthInputAttachmentReferences[0]), depthInputAttachmentReferences, // input
-- >     0, NULL, // color
-- >     NULL, NULL, // resolve & DS
-- >     sizeof(preserveAttachmentReferences)/sizeof(preserveAttachmentReferences[0]), preserveAttachmentReferences,
-- >   },
-- >   {
-- >     VK_STRUCTURE_TYPE_SUBPASS_DESCRIPTION_2, NULL, 0, VK_PIPELINE_BIND_POINT_GRAPHICS, 0,
-- >     sizeof(gBufferAttachmentReferences)/sizeof(gBufferAttachmentReferences[0]), gBufferAttachmentReferences, // input
-- >     sizeof(colorAttachmentReferences)/sizeof(colorAttachmentReferences[0]), colorAttachmentReferences, // color
-- >     &resolveAttachmentReference, &gBufferDepthStencilAttachmentReferences, // resolve & DS
-- >     0, NULL
-- >   },
-- > };
-- >
-- > VkMemoryBarrier2KHR fragmentToSubpassShading = {
-- >   VK_STRUCTURE_TYPE_MEMORY_BARRIER_2_KHR, NULL,
-- >   VK_PIPELINE_STAGE_2_FRAGMENT_SHADER_BIT_KHR, VK_ACCESS_COLOR_ATTACHMENT_WRITE_BIT|VK_ACCESS_DEPTH_STENCIL_ATTACHMENT_WRITE_BIT,
-- >   VK_PIPELINE_STAGE_2_SUBPASS_SHADING_BIT_HUAWEI, VK_ACCESS_INPUT_ATTACHMENT_READ_BIT
-- > };
-- >
-- > VkMemoryBarrier2KHR subpassShadingToFragment = {
-- >   VK_STRUCTURE_TYPE_MEMORY_BARRIER_2_KHR, NULL,
-- >   VK_PIPELINE_STAGE_2_SUBPASS_SHADING_BIT_HUAWEI, VK_ACCESS_SHADER_WRITE_BIT,
-- >   VK_PIPELINE_STAGE_2_FRAGMENT_SHADER_BIT_KHR, VK_ACCESS_SHADER_READ_BIT
-- > };
-- >
-- > VkSubpassDependency2 dependencies[] = {
-- >   {
-- >     VK_STRUCTURE_TYPE_SUBPASS_DEPENDENCY_2, &fragmentToSubpassShading,
-- >     0, 1,
-- >     0, 0, 0, 0,
-- >     0, 0
-- >   },
-- >   {
-- >     VK_STRUCTURE_TYPE_SUBPASS_DEPENDENCY_2, &subpassShadingToFragment,
-- >     1, 2,
-- >     0, 0, 0, 0,
-- >     0, 0
-- >   },
-- > };
-- >
-- > VkRenderPassCreateInfo2 renderPassCreateInfo = {
-- >   VK_STRUCTURE_TYPE_RENDER_PASS_CREATE_INFO_2, NULL, 0,
-- >     sizeof(attachments)/sizeof(attachments[0]), attachments,
-- >     sizeof(subpasses)/sizeof(subpasses[0]), subpasses,
-- >     sizeof(dependencies)/sizeof(dependencies[0]), dependencies,
-- >     0, NULL
-- > };
-- > VKRenderPass renderPass;
-- > vkCreateRenderPass2(device, &renderPassCreateInfo, NULL, &renderPass);
--
-- Example of subpass shading pipeline creation
--
-- > VkExtent2D maxWorkgroupSize;
-- >
-- > VkSpecializationMapEntry subpassShadingConstantMapEntries[] = {
-- >   { 0, 0 * sizeof(uint32_t), sizeof(uint32_t) },
-- >   { 1, 1 * sizeof(uint32_t), sizeof(uint32_t) }
-- > };
-- >
-- > VkSpecializationInfo subpassShadingConstants = {
-- >   2, subpassShadingConstantMapEntries,
-- >   sizeof(VkExtent2D), &maxWorkgroupSize
-- > };
-- >
-- > VkSubpassShadingPipelineCreateInfoHUAWEI subpassShadingPipelineCreateInfo {
-- >   VK_STRUCTURE_TYPE_SUBPASSS_SHADING_PIPELINE_CREATE_INFO_HUAWEI, NULL,
-- >   renderPass, 1
-- > };
-- >
-- > VkPipelineShaderStageCreateInfo subpassShadingPipelineStageCreateInfo {
-- >   VK_STRUCTURE_TYPE_PIPELINE_SHADER_STAGE_CREATE_INFO, NULL,
-- >   0, VK_SHADER_STAGE_SUBPASS_SHADING_BIT_HUAWEI,
-- >   shaderModule, "main",
-- >   &subpassShadingConstants
-- > };
-- >
-- > VkComputePipelineCreateInfo subpassShadingComputePipelineCreateInfo = {
-- >   VK_STRUCTURE_TYPE_COMPUTE_PIPELINE_CREATE_INFO, &subpassShadingPipelineCreateInfo,
-- >   0, &subpassShadingPipelineStageCreateInfo,
-- >   pipelineLayout, basePipelineHandle, basePipelineIndex
-- > };
-- >
-- > VKPipeline pipeline;
-- >
-- > vkGetDeviceSubpassShadingMaxWorkgroupSizeHUAWEI(device, renderPass, &maxWorkgroupSize);
-- > vkCreateComputePipelines(device, pipelineCache, 1, &subpassShadingComputePipelineCreateInfo, NULL, &pipeline);
--
-- == Version History
--
-- -   Revision 2, 2021-06-28 (Hueilong Wang)
--
--     -   Change vkGetSubpassShadingMaxWorkgroupSizeHUAWEI to
--         vkGetDeviceSubpassShadingMaxWorkgroupSizeHUAWEI to resolve issue
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/1564 pub1564>
--
-- -   Revision 1, 2020-12-15 (Hueilong Wang)
--
--     -   Initial draft.
--
-- == See Also
--
-- 'PhysicalDeviceSubpassShadingFeaturesHUAWEI',
-- 'PhysicalDeviceSubpassShadingPropertiesHUAWEI',
-- 'SubpassShadingPipelineCreateInfoHUAWEI', 'cmdSubpassShadingHUAWEI',
-- 'getDeviceSubpassShadingMaxWorkgroupSizeHUAWEI'
--
-- == Document Notes
--
-- For more information, see the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_HUAWEI_subpass_shading Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_HUAWEI_subpass_shading  ( getDeviceSubpassShadingMaxWorkgroupSizeHUAWEI
                                                    , cmdSubpassShadingHUAWEI
                                                    , SubpassShadingPipelineCreateInfoHUAWEI(..)
                                                    , PhysicalDeviceSubpassShadingPropertiesHUAWEI(..)
                                                    , PhysicalDeviceSubpassShadingFeaturesHUAWEI(..)
                                                    , HUAWEI_SUBPASS_SHADING_SPEC_VERSION
                                                    , pattern HUAWEI_SUBPASS_SHADING_SPEC_VERSION
                                                    , HUAWEI_SUBPASS_SHADING_EXTENSION_NAME
                                                    , pattern HUAWEI_SUBPASS_SHADING_EXTENSION_NAME
                                                    , PipelineStageFlagBits2KHR(..)
                                                    , PipelineStageFlags2KHR
                                                    , Flags64
                                                    ) where

import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Foreign.Marshal.Alloc (allocaBytes)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
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.String (IsString)
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.FundamentalTypes (Bool32)
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.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkCmdSubpassShadingHUAWEI))
import Vulkan.Dynamic (DeviceCmds(pVkGetDeviceSubpassShadingMaxWorkgroupSizeHUAWEI))
import Vulkan.Core10.Handles (Device_T)
import Vulkan.Core10.FundamentalTypes (Extent2D)
import Vulkan.Core10.Handles (RenderPass)
import Vulkan.Core10.Handles (RenderPass(..))
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_SUBPASS_SHADING_FEATURES_HUAWEI))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_SUBPASS_SHADING_PROPERTIES_HUAWEI))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SUBPASS_SHADING_PIPELINE_CREATE_INFO_HUAWEI))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Core10.FundamentalTypes (Flags64)
import Vulkan.Extensions.VK_KHR_synchronization2 (PipelineStageFlagBits2KHR(..))
import Vulkan.Extensions.VK_KHR_synchronization2 (PipelineStageFlags2KHR)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkVkGetDeviceSubpassShadingMaxWorkgroupSizeHUAWEI
  :: FunPtr (Ptr Device_T -> RenderPass -> Ptr Extent2D -> IO Result) -> Ptr Device_T -> RenderPass -> Ptr Extent2D -> IO Result

-- | vkGetDeviceSubpassShadingMaxWorkgroupSizeHUAWEI - Query maximum
-- supported subpass shading workgroup size for a give render pass
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fundamentals-successcodes Success>]
--
--     -   'Vulkan.Core10.Enums.Result.SUCCESS'
--
--     -   'Vulkan.Core10.Enums.Result.INCOMPLETE'
--
-- [<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'
--
--     -   'Vulkan.Core10.Enums.Result.ERROR_SURFACE_LOST_KHR'
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_HUAWEI_subpass_shading VK_HUAWEI_subpass_shading>,
-- 'Vulkan.Core10.Handles.Device',
-- 'Vulkan.Core10.FundamentalTypes.Extent2D',
-- 'Vulkan.Core10.Handles.RenderPass'
getDeviceSubpassShadingMaxWorkgroupSizeHUAWEI :: forall io
                                               . (MonadIO io)
                                              => -- | @device@ is a handle to a local device object that was used to create
                                                 -- the given render pass.
                                                 --
                                                 -- #VUID-vkGetDeviceSubpassShadingMaxWorkgroupSizeHUAWEI-device-parameter#
                                                 -- @device@ /must/ be a valid 'Vulkan.Core10.Handles.Device' handle
                                                 Device
                                              -> -- | #VUID-vkGetDeviceSubpassShadingMaxWorkgroupSizeHUAWEI-renderpass-parameter#
                                                 -- @renderpass@ /must/ be a valid 'Vulkan.Core10.Handles.RenderPass' handle
                                                 --
                                                 -- #VUID-vkGetDeviceSubpassShadingMaxWorkgroupSizeHUAWEI-renderpass-parent#
                                                 -- @renderpass@ /must/ have been created, allocated, or retrieved from
                                                 -- @device@
                                                 RenderPass
                                              -> io (Result, ("maxWorkgroupSize" ::: Extent2D))
getDeviceSubpassShadingMaxWorkgroupSizeHUAWEI :: Device
-> RenderPass -> io (Result, "maxWorkgroupSize" ::: Extent2D)
getDeviceSubpassShadingMaxWorkgroupSizeHUAWEI Device
device RenderPass
renderpass = IO (Result, "maxWorkgroupSize" ::: Extent2D)
-> io (Result, "maxWorkgroupSize" ::: Extent2D)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, "maxWorkgroupSize" ::: Extent2D)
 -> io (Result, "maxWorkgroupSize" ::: Extent2D))
-> (ContT
      (Result, "maxWorkgroupSize" ::: Extent2D)
      IO
      (Result, "maxWorkgroupSize" ::: Extent2D)
    -> IO (Result, "maxWorkgroupSize" ::: Extent2D))
-> ContT
     (Result, "maxWorkgroupSize" ::: Extent2D)
     IO
     (Result, "maxWorkgroupSize" ::: Extent2D)
-> io (Result, "maxWorkgroupSize" ::: Extent2D)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  (Result, "maxWorkgroupSize" ::: Extent2D)
  IO
  (Result, "maxWorkgroupSize" ::: Extent2D)
-> IO (Result, "maxWorkgroupSize" ::: Extent2D)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   (Result, "maxWorkgroupSize" ::: Extent2D)
   IO
   (Result, "maxWorkgroupSize" ::: Extent2D)
 -> io (Result, "maxWorkgroupSize" ::: Extent2D))
-> ContT
     (Result, "maxWorkgroupSize" ::: Extent2D)
     IO
     (Result, "maxWorkgroupSize" ::: Extent2D)
-> io (Result, "maxWorkgroupSize" ::: Extent2D)
forall a b. (a -> b) -> a -> b
$ do
  let vkGetDeviceSubpassShadingMaxWorkgroupSizeHUAWEIPtr :: FunPtr
  (Ptr Device_T
   -> RenderPass
   -> ("pMaxWorkgroupSize" ::: Ptr ("maxWorkgroupSize" ::: Extent2D))
   -> IO Result)
vkGetDeviceSubpassShadingMaxWorkgroupSizeHUAWEIPtr = DeviceCmds
-> FunPtr
     (Ptr Device_T
      -> RenderPass
      -> ("pMaxWorkgroupSize" ::: Ptr ("maxWorkgroupSize" ::: Extent2D))
      -> IO Result)
pVkGetDeviceSubpassShadingMaxWorkgroupSizeHUAWEI (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  IO () -> ContT (Result, "maxWorkgroupSize" ::: Extent2D) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, "maxWorkgroupSize" ::: Extent2D) IO ())
-> IO () -> ContT (Result, "maxWorkgroupSize" ::: Extent2D) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Device_T
   -> RenderPass
   -> ("pMaxWorkgroupSize" ::: Ptr ("maxWorkgroupSize" ::: Extent2D))
   -> IO Result)
vkGetDeviceSubpassShadingMaxWorkgroupSizeHUAWEIPtr FunPtr
  (Ptr Device_T
   -> RenderPass
   -> ("pMaxWorkgroupSize" ::: Ptr ("maxWorkgroupSize" ::: Extent2D))
   -> IO Result)
-> FunPtr
     (Ptr Device_T
      -> RenderPass
      -> ("pMaxWorkgroupSize" ::: Ptr ("maxWorkgroupSize" ::: Extent2D))
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Device_T
   -> RenderPass
   -> ("pMaxWorkgroupSize" ::: Ptr ("maxWorkgroupSize" ::: Extent2D))
   -> 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 vkGetDeviceSubpassShadingMaxWorkgroupSizeHUAWEI is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkGetDeviceSubpassShadingMaxWorkgroupSizeHUAWEI' :: Ptr Device_T
-> RenderPass
-> ("pMaxWorkgroupSize" ::: Ptr ("maxWorkgroupSize" ::: Extent2D))
-> IO Result
vkGetDeviceSubpassShadingMaxWorkgroupSizeHUAWEI' = FunPtr
  (Ptr Device_T
   -> RenderPass
   -> ("pMaxWorkgroupSize" ::: Ptr ("maxWorkgroupSize" ::: Extent2D))
   -> IO Result)
-> Ptr Device_T
-> RenderPass
-> ("pMaxWorkgroupSize" ::: Ptr ("maxWorkgroupSize" ::: Extent2D))
-> IO Result
mkVkGetDeviceSubpassShadingMaxWorkgroupSizeHUAWEI FunPtr
  (Ptr Device_T
   -> RenderPass
   -> ("pMaxWorkgroupSize" ::: Ptr ("maxWorkgroupSize" ::: Extent2D))
   -> IO Result)
vkGetDeviceSubpassShadingMaxWorkgroupSizeHUAWEIPtr
  "pMaxWorkgroupSize" ::: Ptr ("maxWorkgroupSize" ::: Extent2D)
pPMaxWorkgroupSize <- ((("pMaxWorkgroupSize" ::: Ptr ("maxWorkgroupSize" ::: Extent2D))
  -> IO (Result, "maxWorkgroupSize" ::: Extent2D))
 -> IO (Result, "maxWorkgroupSize" ::: Extent2D))
-> ContT
     (Result, "maxWorkgroupSize" ::: Extent2D)
     IO
     ("pMaxWorkgroupSize" ::: Ptr ("maxWorkgroupSize" ::: Extent2D))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct ("maxWorkgroupSize" ::: Extent2D) =>
(("pMaxWorkgroupSize" ::: Ptr ("maxWorkgroupSize" ::: Extent2D))
 -> IO b)
-> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @Extent2D)
  Result
r <- IO Result
-> ContT (Result, "maxWorkgroupSize" ::: Extent2D) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT (Result, "maxWorkgroupSize" ::: Extent2D) IO Result)
-> IO Result
-> ContT (Result, "maxWorkgroupSize" ::: Extent2D) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetDeviceSubpassShadingMaxWorkgroupSizeHUAWEI" (Ptr Device_T
-> RenderPass
-> ("pMaxWorkgroupSize" ::: Ptr ("maxWorkgroupSize" ::: Extent2D))
-> IO Result
vkGetDeviceSubpassShadingMaxWorkgroupSizeHUAWEI' (Device -> Ptr Device_T
deviceHandle (Device
device)) (RenderPass
renderpass) ("pMaxWorkgroupSize" ::: Ptr ("maxWorkgroupSize" ::: Extent2D)
pPMaxWorkgroupSize))
  IO () -> ContT (Result, "maxWorkgroupSize" ::: Extent2D) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, "maxWorkgroupSize" ::: Extent2D) IO ())
-> IO () -> ContT (Result, "maxWorkgroupSize" ::: Extent2D) 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))
  "maxWorkgroupSize" ::: Extent2D
pMaxWorkgroupSize <- IO ("maxWorkgroupSize" ::: Extent2D)
-> ContT
     (Result, "maxWorkgroupSize" ::: Extent2D)
     IO
     ("maxWorkgroupSize" ::: Extent2D)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("maxWorkgroupSize" ::: Extent2D)
 -> ContT
      (Result, "maxWorkgroupSize" ::: Extent2D)
      IO
      ("maxWorkgroupSize" ::: Extent2D))
-> IO ("maxWorkgroupSize" ::: Extent2D)
-> ContT
     (Result, "maxWorkgroupSize" ::: Extent2D)
     IO
     ("maxWorkgroupSize" ::: Extent2D)
forall a b. (a -> b) -> a -> b
$ ("pMaxWorkgroupSize" ::: Ptr ("maxWorkgroupSize" ::: Extent2D))
-> IO ("maxWorkgroupSize" ::: Extent2D)
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent2D "pMaxWorkgroupSize" ::: Ptr ("maxWorkgroupSize" ::: Extent2D)
pPMaxWorkgroupSize
  (Result, "maxWorkgroupSize" ::: Extent2D)
-> ContT
     (Result, "maxWorkgroupSize" ::: Extent2D)
     IO
     (Result, "maxWorkgroupSize" ::: Extent2D)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, "maxWorkgroupSize" ::: Extent2D)
 -> ContT
      (Result, "maxWorkgroupSize" ::: Extent2D)
      IO
      (Result, "maxWorkgroupSize" ::: Extent2D))
-> (Result, "maxWorkgroupSize" ::: Extent2D)
-> ContT
     (Result, "maxWorkgroupSize" ::: Extent2D)
     IO
     (Result, "maxWorkgroupSize" ::: Extent2D)
forall a b. (a -> b) -> a -> b
$ (Result
r, "maxWorkgroupSize" ::: Extent2D
pMaxWorkgroupSize)


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

-- | vkCmdSubpassShadingHUAWEI - Dispatch compute work items
--
-- = Description
--
-- When the command is executed, a global workgroup consisting of ceil
-- (render area size \/ local workgroup size) local workgroups is
-- assembled.
--
-- == Valid Usage
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-magFilter-04553# If a
--     'Vulkan.Core10.Handles.Sampler' created with @magFilter@ or
--     @minFilter@ equal to 'Vulkan.Core10.Enums.Filter.FILTER_LINEAR' and
--     @compareEnable@ equal to 'Vulkan.Core10.FundamentalTypes.FALSE' is
--     used to sample a 'Vulkan.Core10.Handles.ImageView' as a result of
--     this command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_SAMPLED_IMAGE_FILTER_LINEAR_BIT'
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-mipmapMode-04770# If a
--     'Vulkan.Core10.Handles.Sampler' created with @mipmapMode@ equal to
--     'Vulkan.Core10.Enums.SamplerMipmapMode.SAMPLER_MIPMAP_MODE_LINEAR'
--     and @compareEnable@ equal to 'Vulkan.Core10.FundamentalTypes.FALSE'
--     is used to sample a 'Vulkan.Core10.Handles.ImageView' as a result of
--     this command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_SAMPLED_IMAGE_FILTER_LINEAR_BIT'
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-None-06479# If a
--     'Vulkan.Core10.Handles.ImageView' is sampled with
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#textures-depth-compare-operation depth comparison>,
--     the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Extensions.VK_KHR_acceleration_structure.FORMAT_FEATURE_2_SAMPLED_IMAGE_DEPTH_COMPARISON_BIT_KHR'
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-None-02691# If a
--     'Vulkan.Core10.Handles.ImageView' is accessed using atomic
--     operations as a result of this command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Core10.Enums.FormatFeatureFlagBits.FORMAT_FEATURE_STORAGE_IMAGE_ATOMIC_BIT'
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-None-02692# If a
--     'Vulkan.Core10.Handles.ImageView' is sampled with
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FILTER_CUBIC_EXT' as a result
--     of this command, then the image view’s
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#resources-image-view-format-features format features>
--     /must/ contain
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FORMAT_FEATURE_SAMPLED_IMAGE_FILTER_CUBIC_BIT_EXT'
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-filterCubic-02694# Any
--     'Vulkan.Core10.Handles.ImageView' being sampled with
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FILTER_CUBIC_EXT' as a result
--     of this command /must/ have a
--     'Vulkan.Core10.Enums.ImageViewType.ImageViewType' and format that
--     supports cubic filtering, as specified by
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FilterCubicImageViewImageFormatPropertiesEXT'::@filterCubic@
--     returned by
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceImageFormatProperties2'
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-filterCubicMinmax-02695# Any
--     'Vulkan.Core10.Handles.ImageView' being sampled with
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FILTER_CUBIC_EXT' with a
--     reduction mode of either
--     'Vulkan.Core12.Enums.SamplerReductionMode.SAMPLER_REDUCTION_MODE_MIN'
--     or
--     'Vulkan.Core12.Enums.SamplerReductionMode.SAMPLER_REDUCTION_MODE_MAX'
--     as a result of this command /must/ have a
--     'Vulkan.Core10.Enums.ImageViewType.ImageViewType' and format that
--     supports cubic filtering together with minmax filtering, as
--     specified by
--     'Vulkan.Extensions.VK_EXT_filter_cubic.FilterCubicImageViewImageFormatPropertiesEXT'::@filterCubicMinmax@
--     returned by
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceImageFormatProperties2'
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-flags-02696# Any
--     'Vulkan.Core10.Handles.Image' created with a
--     'Vulkan.Core10.Image.ImageCreateInfo'::@flags@ containing
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_CORNER_SAMPLED_BIT_NV'
--     sampled as a result of this command /must/ only be sampled using a
--     'Vulkan.Core10.Enums.SamplerAddressMode.SamplerAddressMode' of
--     'Vulkan.Core10.Enums.SamplerAddressMode.SAMPLER_ADDRESS_MODE_CLAMP_TO_EDGE'
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-OpTypeImage-06423# Any
--     'Vulkan.Core10.Handles.ImageView' or
--     'Vulkan.Core10.Handles.BufferView' being written as a storage image
--     or storage texel buffer where the image format field of the
--     @OpTypeImage@ is @Unknown@ /must/ have image format features that
--     support
--     'Vulkan.Extensions.VK_KHR_acceleration_structure.FORMAT_FEATURE_2_STORAGE_WRITE_WITHOUT_FORMAT_BIT_KHR'
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-OpTypeImage-06424# Any
--     'Vulkan.Core10.Handles.ImageView' or
--     'Vulkan.Core10.Handles.BufferView' being read as a storage image or
--     storage texel buffer where the image format field of the
--     @OpTypeImage@ is @Unknown@ /must/ have image format features that
--     support
--     'Vulkan.Extensions.VK_KHR_acceleration_structure.FORMAT_FEATURE_2_STORAGE_READ_WITHOUT_FORMAT_BIT_KHR'
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-None-02697# For each set /n/ that is
--     statically used by the 'Vulkan.Core10.Handles.Pipeline' bound to the
--     pipeline bind point used by this command, a descriptor set /must/
--     have been bound to /n/ at the same pipeline bind point, with a
--     'Vulkan.Core10.Handles.PipelineLayout' that is compatible for set
--     /n/, with the 'Vulkan.Core10.Handles.PipelineLayout' used to create
--     the current 'Vulkan.Core10.Handles.Pipeline', as described in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#descriptorsets-compatibility ???>
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-maintenance4-06425# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-maintenance4 maintenance4>
--     feature is not enabled, then for each push constant that is
--     statically used by the 'Vulkan.Core10.Handles.Pipeline' bound to the
--     pipeline bind point used by this command, a push constant value
--     /must/ have been set for the same pipeline bind point, with a
--     'Vulkan.Core10.Handles.PipelineLayout' that is compatible for push
--     constants, with the 'Vulkan.Core10.Handles.PipelineLayout' used to
--     create the current 'Vulkan.Core10.Handles.Pipeline', as described in
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#descriptorsets-compatibility ???>
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-None-02699# Descriptors in each
--     bound descriptor set, specified via
--     'Vulkan.Core10.CommandBufferBuilding.cmdBindDescriptorSets', /must/
--     be valid if they are statically used by the
--     'Vulkan.Core10.Handles.Pipeline' bound to the pipeline bind point
--     used by this command
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-None-02700# A valid pipeline /must/
--     be bound to the pipeline bind point used by this command
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-commandBuffer-02701# If the
--     'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline bind
--     point used by this command requires any dynamic state, that state
--     /must/ have been set or inherited (if the
--     @VK_NV_inherited_viewport_scissor@ extension is enabled) for
--     @commandBuffer@, and done so after any previously bound pipeline
--     with the corresponding state not specified as dynamic
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-None-02859# There /must/ not have
--     been any calls to dynamic state setting commands for any state not
--     specified as dynamic in the 'Vulkan.Core10.Handles.Pipeline' object
--     bound to the pipeline bind point used by this command, since that
--     pipeline was bound
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-None-02702# If the
--     'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline bind
--     point used by this command accesses a
--     'Vulkan.Core10.Handles.Sampler' object that uses unnormalized
--     coordinates, that sampler /must/ not be used to sample from any
--     'Vulkan.Core10.Handles.Image' with a
--     'Vulkan.Core10.Handles.ImageView' of the type
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_3D',
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE',
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_1D_ARRAY',
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_2D_ARRAY' or
--     'Vulkan.Core10.Enums.ImageViewType.IMAGE_VIEW_TYPE_CUBE_ARRAY', in
--     any shader stage
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-None-02703# If the
--     'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline bind
--     point used by this command accesses a
--     'Vulkan.Core10.Handles.Sampler' object that uses unnormalized
--     coordinates, that sampler /must/ not be used with any of the SPIR-V
--     @OpImageSample*@ or @OpImageSparseSample*@ instructions with
--     @ImplicitLod@, @Dref@ or @Proj@ in their name, in any shader stage
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-None-02704# If the
--     'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline bind
--     point used by this command accesses a
--     'Vulkan.Core10.Handles.Sampler' object that uses unnormalized
--     coordinates, that sampler /must/ not be used with any of the SPIR-V
--     @OpImageSample*@ or @OpImageSparseSample*@ instructions that
--     includes a LOD bias or any offset values, in any shader stage
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-None-02705# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-robustBufferAccess robust buffer access>
--     feature is not enabled, and if the 'Vulkan.Core10.Handles.Pipeline'
--     object bound to the pipeline bind point used by this command
--     accesses a uniform buffer, it /must/ not access values outside of
--     the range of the buffer as specified in the descriptor set bound to
--     the same pipeline bind point
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-None-02706# If the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-robustBufferAccess robust buffer access>
--     feature is not enabled, and if the 'Vulkan.Core10.Handles.Pipeline'
--     object bound to the pipeline bind point used by this command
--     accesses a storage buffer, it /must/ not access values outside of
--     the range of the buffer as specified in the descriptor set bound to
--     the same pipeline bind point
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-commandBuffer-02707# If
--     @commandBuffer@ is an unprotected command buffer and
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#limits-protectedNoFault protectedNoFault>
--     is not supported, any resource accessed by the
--     'Vulkan.Core10.Handles.Pipeline' object bound to the pipeline bind
--     point used by this command /must/ not be a protected resource
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-None-04115# If a
--     'Vulkan.Core10.Handles.ImageView' is accessed using @OpImageWrite@
--     as a result of this command, then the @Type@ of the @Texel@ operand
--     of that instruction /must/ have at least as many components as the
--     image view’s format
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-OpImageWrite-04469# If a
--     'Vulkan.Core10.Handles.BufferView' is accessed using @OpImageWrite@
--     as a result of this command, then the @Type@ of the @Texel@ operand
--     of that instruction /must/ have at least as many components as the
--     buffer view’s format
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-SampledType-04470# If a
--     'Vulkan.Core10.Handles.ImageView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a 64-bit component
--     width is accessed as a result of this command, the @SampledType@ of
--     the @OpTypeImage@ operand of that instruction /must/ have a @Width@
--     of 64
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-SampledType-04471# If a
--     'Vulkan.Core10.Handles.ImageView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a component width less
--     than 64-bit is accessed as a result of this command, the
--     @SampledType@ of the @OpTypeImage@ operand of that instruction
--     /must/ have a @Width@ of 32
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-SampledType-04472# If a
--     'Vulkan.Core10.Handles.BufferView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a 64-bit component
--     width is accessed as a result of this command, the @SampledType@ of
--     the @OpTypeImage@ operand of that instruction /must/ have a @Width@
--     of 64
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-SampledType-04473# If a
--     'Vulkan.Core10.Handles.BufferView' with a
--     'Vulkan.Core10.Enums.Format.Format' that has a component width less
--     than 64-bit is accessed as a result of this command, the
--     @SampledType@ of the @OpTypeImage@ operand of that instruction
--     /must/ have a @Width@ of 32
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-sparseImageInt64Atomics-04474# If
--     the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-sparseImageInt64Atomics sparseImageInt64Atomics>
--     feature is not enabled, 'Vulkan.Core10.Handles.Image' objects
--     created with the
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_SPARSE_RESIDENCY_BIT'
--     flag /must/ not be accessed by atomic instructions through an
--     @OpTypeImage@ with a @SampledType@ with a @Width@ of 64 by this
--     command
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-sparseImageInt64Atomics-04475# If
--     the
--     <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-sparseImageInt64Atomics sparseImageInt64Atomics>
--     feature is not enabled, 'Vulkan.Core10.Handles.Buffer' objects
--     created with the
--     'Vulkan.Core10.Enums.BufferCreateFlagBits.BUFFER_CREATE_SPARSE_RESIDENCY_BIT'
--     flag /must/ not be accessed by atomic instructions through an
--     @OpTypeImage@ with a @SampledType@ with a @Width@ of 64 by this
--     command
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-None-04931# This command must be
--     called in a subpass with bind point
--     'Vulkan.Core10.Enums.PipelineBindPoint.PIPELINE_BIND_POINT_SUBPASS_SHADING_HUAWEI'.
--     No draw commands can be called in the same subpass. Only one
--     'cmdSubpassShadingHUAWEI' command can be called in a subpass
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-commandBuffer-parameter#
--     @commandBuffer@ /must/ be a valid
--     'Vulkan.Core10.Handles.CommandBuffer' handle
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-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-vkCmdSubpassShadingHUAWEI-commandBuffer-cmdpool# The
--     'Vulkan.Core10.Handles.CommandPool' that @commandBuffer@ was
--     allocated from /must/ support graphics operations
--
-- -   #VUID-vkCmdSubpassShadingHUAWEI-renderpass# This command /must/ only
--     be called inside of a render pass instance
--
-- == Host Synchronization
--
-- -   Host access to @commandBuffer@ /must/ be externally synchronized
--
-- -   Host access to the 'Vulkan.Core10.Handles.CommandPool' that
--     @commandBuffer@ was allocated from /must/ be externally synchronized
--
-- == Command Properties
--
-- \'
--
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+
-- | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkCommandBufferLevel Command Buffer Levels> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#vkCmdBeginRenderPass Render Pass Scope> | <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkQueueFlagBits Supported Queue Types> |
-- +============================================================================================================================+========================================================================================================================+=======================================================================================================================+
-- | Primary                                                                                                                    | Inside                                                                                                                 | Graphics                                                                                                              |
-- | Secondary                                                                                                                  |                                                                                                                        |                                                                                                                       |
-- +----------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------------------------------------------------------------------+-----------------------------------------------------------------------------------------------------------------------+
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_HUAWEI_subpass_shading VK_HUAWEI_subpass_shading>,
-- 'Vulkan.Core10.Handles.CommandBuffer'
cmdSubpassShadingHUAWEI :: forall io
                         . (MonadIO io)
                        => -- | @commandBuffer@ is the command buffer into which the command will be
                           -- recorded.
                           CommandBuffer
                        -> io ()
cmdSubpassShadingHUAWEI :: CommandBuffer -> io ()
cmdSubpassShadingHUAWEI CommandBuffer
commandBuffer = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let vkCmdSubpassShadingHUAWEIPtr :: FunPtr (Ptr CommandBuffer_T -> IO ())
vkCmdSubpassShadingHUAWEIPtr = DeviceCmds -> FunPtr (Ptr CommandBuffer_T -> IO ())
pVkCmdSubpassShadingHUAWEI (case CommandBuffer
commandBuffer of CommandBuffer{DeviceCmds
$sel:deviceCmds:CommandBuffer :: CommandBuffer -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr (Ptr CommandBuffer_T -> IO ())
vkCmdSubpassShadingHUAWEIPtr FunPtr (Ptr CommandBuffer_T -> IO ())
-> FunPtr (Ptr CommandBuffer_T -> IO ()) -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr (Ptr CommandBuffer_T -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCmdSubpassShadingHUAWEI is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let vkCmdSubpassShadingHUAWEI' :: Ptr CommandBuffer_T -> IO ()
vkCmdSubpassShadingHUAWEI' = FunPtr (Ptr CommandBuffer_T -> IO ())
-> Ptr CommandBuffer_T -> IO ()
mkVkCmdSubpassShadingHUAWEI FunPtr (Ptr CommandBuffer_T -> IO ())
vkCmdSubpassShadingHUAWEIPtr
  String -> IO () -> IO ()
forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCmdSubpassShadingHUAWEI" (Ptr CommandBuffer_T -> IO ()
vkCmdSubpassShadingHUAWEI' (CommandBuffer -> Ptr CommandBuffer_T
commandBufferHandle (CommandBuffer
commandBuffer)))
  () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ ()


-- | VkSubpassShadingPipelineCreateInfoHUAWEI - Structure specifying
-- parameters of a newly created subpass shading pipeline
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_HUAWEI_subpass_shading VK_HUAWEI_subpass_shading>,
-- 'Vulkan.Core10.Handles.RenderPass',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data SubpassShadingPipelineCreateInfoHUAWEI = SubpassShadingPipelineCreateInfoHUAWEI
  { -- | @renderPass@ is a handle to a render pass object describing the
    -- environment in which the pipeline will be used. The pipeline /must/ only
    -- be used with a render pass instance compatible with the one provided.
    -- See
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#renderpass-compatibility Render Pass Compatibility>
    -- for more information.
    SubpassShadingPipelineCreateInfoHUAWEI -> RenderPass
renderPass :: RenderPass
  , -- | @subpass@ is the index of the subpass in the render pass where this
    -- pipeline will be used.
    --
    -- #VUID-VkSubpassShadingPipelineCreateInfoHUAWEI-subpass-04946# @subpass@
    -- /must/ be created with
    -- 'Vulkan.Core10.Enums.PipelineBindPoint.PIPELINE_BIND_POINT_SUBPASS_SHADING_HUAWEI'
    -- bind point
    SubpassShadingPipelineCreateInfoHUAWEI -> Word32
subpass :: Word32
  }
  deriving (Typeable, SubpassShadingPipelineCreateInfoHUAWEI
-> SubpassShadingPipelineCreateInfoHUAWEI -> Bool
(SubpassShadingPipelineCreateInfoHUAWEI
 -> SubpassShadingPipelineCreateInfoHUAWEI -> Bool)
-> (SubpassShadingPipelineCreateInfoHUAWEI
    -> SubpassShadingPipelineCreateInfoHUAWEI -> Bool)
-> Eq SubpassShadingPipelineCreateInfoHUAWEI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubpassShadingPipelineCreateInfoHUAWEI
-> SubpassShadingPipelineCreateInfoHUAWEI -> Bool
$c/= :: SubpassShadingPipelineCreateInfoHUAWEI
-> SubpassShadingPipelineCreateInfoHUAWEI -> Bool
== :: SubpassShadingPipelineCreateInfoHUAWEI
-> SubpassShadingPipelineCreateInfoHUAWEI -> Bool
$c== :: SubpassShadingPipelineCreateInfoHUAWEI
-> SubpassShadingPipelineCreateInfoHUAWEI -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SubpassShadingPipelineCreateInfoHUAWEI)
#endif
deriving instance Show SubpassShadingPipelineCreateInfoHUAWEI

instance ToCStruct SubpassShadingPipelineCreateInfoHUAWEI where
  withCStruct :: SubpassShadingPipelineCreateInfoHUAWEI
-> (Ptr SubpassShadingPipelineCreateInfoHUAWEI -> IO b) -> IO b
withCStruct SubpassShadingPipelineCreateInfoHUAWEI
x Ptr SubpassShadingPipelineCreateInfoHUAWEI -> IO b
f = Int -> (Ptr SubpassShadingPipelineCreateInfoHUAWEI -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr SubpassShadingPipelineCreateInfoHUAWEI -> IO b) -> IO b)
-> (Ptr SubpassShadingPipelineCreateInfoHUAWEI -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr SubpassShadingPipelineCreateInfoHUAWEI
p -> Ptr SubpassShadingPipelineCreateInfoHUAWEI
-> SubpassShadingPipelineCreateInfoHUAWEI -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SubpassShadingPipelineCreateInfoHUAWEI
p SubpassShadingPipelineCreateInfoHUAWEI
x (Ptr SubpassShadingPipelineCreateInfoHUAWEI -> IO b
f Ptr SubpassShadingPipelineCreateInfoHUAWEI
p)
  pokeCStruct :: Ptr SubpassShadingPipelineCreateInfoHUAWEI
-> SubpassShadingPipelineCreateInfoHUAWEI -> IO b -> IO b
pokeCStruct Ptr SubpassShadingPipelineCreateInfoHUAWEI
p SubpassShadingPipelineCreateInfoHUAWEI{Word32
RenderPass
subpass :: Word32
renderPass :: RenderPass
$sel:subpass:SubpassShadingPipelineCreateInfoHUAWEI :: SubpassShadingPipelineCreateInfoHUAWEI -> Word32
$sel:renderPass:SubpassShadingPipelineCreateInfoHUAWEI :: SubpassShadingPipelineCreateInfoHUAWEI -> RenderPass
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SubpassShadingPipelineCreateInfoHUAWEI
p Ptr SubpassShadingPipelineCreateInfoHUAWEI
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SUBPASS_SHADING_PIPELINE_CREATE_INFO_HUAWEI)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SubpassShadingPipelineCreateInfoHUAWEI
p Ptr SubpassShadingPipelineCreateInfoHUAWEI -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr RenderPass -> RenderPass -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SubpassShadingPipelineCreateInfoHUAWEI
p Ptr SubpassShadingPipelineCreateInfoHUAWEI -> Int -> Ptr RenderPass
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr RenderPass)) (RenderPass
renderPass)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SubpassShadingPipelineCreateInfoHUAWEI
p Ptr SubpassShadingPipelineCreateInfoHUAWEI -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Word32
subpass)
    IO b
f
  cStructSize :: Int
cStructSize = Int
32
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: Ptr SubpassShadingPipelineCreateInfoHUAWEI -> IO b -> IO b
pokeZeroCStruct Ptr SubpassShadingPipelineCreateInfoHUAWEI
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SubpassShadingPipelineCreateInfoHUAWEI
p Ptr SubpassShadingPipelineCreateInfoHUAWEI
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_SUBPASS_SHADING_PIPELINE_CREATE_INFO_HUAWEI)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SubpassShadingPipelineCreateInfoHUAWEI
p Ptr SubpassShadingPipelineCreateInfoHUAWEI -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr RenderPass -> RenderPass -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SubpassShadingPipelineCreateInfoHUAWEI
p Ptr SubpassShadingPipelineCreateInfoHUAWEI -> Int -> Ptr RenderPass
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr RenderPass)) (RenderPass
forall a. Zero a => a
zero)
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SubpassShadingPipelineCreateInfoHUAWEI
p Ptr SubpassShadingPipelineCreateInfoHUAWEI -> 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
f

instance FromCStruct SubpassShadingPipelineCreateInfoHUAWEI where
  peekCStruct :: Ptr SubpassShadingPipelineCreateInfoHUAWEI
-> IO SubpassShadingPipelineCreateInfoHUAWEI
peekCStruct Ptr SubpassShadingPipelineCreateInfoHUAWEI
p = do
    RenderPass
renderPass <- Ptr RenderPass -> IO RenderPass
forall a. Storable a => Ptr a -> IO a
peek @RenderPass ((Ptr SubpassShadingPipelineCreateInfoHUAWEI
p Ptr SubpassShadingPipelineCreateInfoHUAWEI -> Int -> Ptr RenderPass
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr RenderPass))
    Word32
subpass <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr SubpassShadingPipelineCreateInfoHUAWEI
p Ptr SubpassShadingPipelineCreateInfoHUAWEI -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32))
    SubpassShadingPipelineCreateInfoHUAWEI
-> IO SubpassShadingPipelineCreateInfoHUAWEI
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubpassShadingPipelineCreateInfoHUAWEI
 -> IO SubpassShadingPipelineCreateInfoHUAWEI)
-> SubpassShadingPipelineCreateInfoHUAWEI
-> IO SubpassShadingPipelineCreateInfoHUAWEI
forall a b. (a -> b) -> a -> b
$ RenderPass -> Word32 -> SubpassShadingPipelineCreateInfoHUAWEI
SubpassShadingPipelineCreateInfoHUAWEI
             RenderPass
renderPass Word32
subpass

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

instance Zero SubpassShadingPipelineCreateInfoHUAWEI where
  zero :: SubpassShadingPipelineCreateInfoHUAWEI
zero = RenderPass -> Word32 -> SubpassShadingPipelineCreateInfoHUAWEI
SubpassShadingPipelineCreateInfoHUAWEI
           RenderPass
forall a. Zero a => a
zero
           Word32
forall a. Zero a => a
zero


-- | VkPhysicalDeviceSubpassShadingPropertiesHUAWEI - Structure describing
-- subpass shading properties supported by an implementation
--
-- = Description
--
-- If the 'PhysicalDeviceSubpassShadingPropertiesHUAWEI' structure is
-- included in the @pNext@ chain of the
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2'
-- structure passed to
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceProperties2',
-- it is filled in with each corresponding implementation-dependent
-- property.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_HUAWEI_subpass_shading VK_HUAWEI_subpass_shading>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceSubpassShadingPropertiesHUAWEI = PhysicalDeviceSubpassShadingPropertiesHUAWEI
  { -- | #limits-maxSubpassShadingWorkgroupSizeAspectRatio#
    -- @maxSubpassShadingWorkgroupSizeAspectRatio@ indicates the maximum ratio
    -- between the width and height of the portion of the subpass shading
    -- shader workgroup size. @maxSubpassShadingWorkgroupSizeAspectRatio@
    -- /must/ be a power-of-two value, and /must/ be less than or equal to
    -- max(@WorkgroupSize.x@ \/ @WorkgroupSize.y@, @WorkgroupSize.y@ \/
    -- @WorkgroupSize.x@).
    PhysicalDeviceSubpassShadingPropertiesHUAWEI -> Word32
maxSubpassShadingWorkgroupSizeAspectRatio :: Word32 }
  deriving (Typeable, PhysicalDeviceSubpassShadingPropertiesHUAWEI
-> PhysicalDeviceSubpassShadingPropertiesHUAWEI -> Bool
(PhysicalDeviceSubpassShadingPropertiesHUAWEI
 -> PhysicalDeviceSubpassShadingPropertiesHUAWEI -> Bool)
-> (PhysicalDeviceSubpassShadingPropertiesHUAWEI
    -> PhysicalDeviceSubpassShadingPropertiesHUAWEI -> Bool)
-> Eq PhysicalDeviceSubpassShadingPropertiesHUAWEI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceSubpassShadingPropertiesHUAWEI
-> PhysicalDeviceSubpassShadingPropertiesHUAWEI -> Bool
$c/= :: PhysicalDeviceSubpassShadingPropertiesHUAWEI
-> PhysicalDeviceSubpassShadingPropertiesHUAWEI -> Bool
== :: PhysicalDeviceSubpassShadingPropertiesHUAWEI
-> PhysicalDeviceSubpassShadingPropertiesHUAWEI -> Bool
$c== :: PhysicalDeviceSubpassShadingPropertiesHUAWEI
-> PhysicalDeviceSubpassShadingPropertiesHUAWEI -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceSubpassShadingPropertiesHUAWEI)
#endif
deriving instance Show PhysicalDeviceSubpassShadingPropertiesHUAWEI

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

instance FromCStruct PhysicalDeviceSubpassShadingPropertiesHUAWEI where
  peekCStruct :: Ptr PhysicalDeviceSubpassShadingPropertiesHUAWEI
-> IO PhysicalDeviceSubpassShadingPropertiesHUAWEI
peekCStruct Ptr PhysicalDeviceSubpassShadingPropertiesHUAWEI
p = do
    Word32
maxSubpassShadingWorkgroupSizeAspectRatio <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceSubpassShadingPropertiesHUAWEI
p Ptr PhysicalDeviceSubpassShadingPropertiesHUAWEI
-> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
    PhysicalDeviceSubpassShadingPropertiesHUAWEI
-> IO PhysicalDeviceSubpassShadingPropertiesHUAWEI
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceSubpassShadingPropertiesHUAWEI
 -> IO PhysicalDeviceSubpassShadingPropertiesHUAWEI)
-> PhysicalDeviceSubpassShadingPropertiesHUAWEI
-> IO PhysicalDeviceSubpassShadingPropertiesHUAWEI
forall a b. (a -> b) -> a -> b
$ Word32 -> PhysicalDeviceSubpassShadingPropertiesHUAWEI
PhysicalDeviceSubpassShadingPropertiesHUAWEI
             Word32
maxSubpassShadingWorkgroupSizeAspectRatio

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

instance Zero PhysicalDeviceSubpassShadingPropertiesHUAWEI where
  zero :: PhysicalDeviceSubpassShadingPropertiesHUAWEI
zero = Word32 -> PhysicalDeviceSubpassShadingPropertiesHUAWEI
PhysicalDeviceSubpassShadingPropertiesHUAWEI
           Word32
forall a. Zero a => a
zero


-- | VkPhysicalDeviceSubpassShadingFeaturesHUAWEI - Structure describing
-- whether subpass shading is enabled
--
-- = Members
--
-- If the 'PhysicalDeviceSubpassShadingFeaturesHUAWEI' structure is
-- included in the @pNext@ chain of the
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2'
-- structure passed to
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.getPhysicalDeviceFeatures2',
-- it is filled in to indicate whether each corresponding feature is
-- supported. 'PhysicalDeviceSubpassShadingFeaturesHUAWEI' /can/ also be
-- used in the @pNext@ chain of 'Vulkan.Core10.Device.DeviceCreateInfo' to
-- selectively enable these features.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_HUAWEI_subpass_shading VK_HUAWEI_subpass_shading>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceSubpassShadingFeaturesHUAWEI = PhysicalDeviceSubpassShadingFeaturesHUAWEI
  { -- No documentation found for Nested "VkPhysicalDeviceSubpassShadingFeaturesHUAWEI" "subpassShading"
    PhysicalDeviceSubpassShadingFeaturesHUAWEI -> Bool
subpassShading :: Bool }
  deriving (Typeable, PhysicalDeviceSubpassShadingFeaturesHUAWEI
-> PhysicalDeviceSubpassShadingFeaturesHUAWEI -> Bool
(PhysicalDeviceSubpassShadingFeaturesHUAWEI
 -> PhysicalDeviceSubpassShadingFeaturesHUAWEI -> Bool)
-> (PhysicalDeviceSubpassShadingFeaturesHUAWEI
    -> PhysicalDeviceSubpassShadingFeaturesHUAWEI -> Bool)
-> Eq PhysicalDeviceSubpassShadingFeaturesHUAWEI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceSubpassShadingFeaturesHUAWEI
-> PhysicalDeviceSubpassShadingFeaturesHUAWEI -> Bool
$c/= :: PhysicalDeviceSubpassShadingFeaturesHUAWEI
-> PhysicalDeviceSubpassShadingFeaturesHUAWEI -> Bool
== :: PhysicalDeviceSubpassShadingFeaturesHUAWEI
-> PhysicalDeviceSubpassShadingFeaturesHUAWEI -> Bool
$c== :: PhysicalDeviceSubpassShadingFeaturesHUAWEI
-> PhysicalDeviceSubpassShadingFeaturesHUAWEI -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceSubpassShadingFeaturesHUAWEI)
#endif
deriving instance Show PhysicalDeviceSubpassShadingFeaturesHUAWEI

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

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

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

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


type HUAWEI_SUBPASS_SHADING_SPEC_VERSION = 2

-- No documentation found for TopLevel "VK_HUAWEI_SUBPASS_SHADING_SPEC_VERSION"
pattern HUAWEI_SUBPASS_SHADING_SPEC_VERSION :: forall a . Integral a => a
pattern $bHUAWEI_SUBPASS_SHADING_SPEC_VERSION :: a
$mHUAWEI_SUBPASS_SHADING_SPEC_VERSION :: forall r a. Integral a => a -> (Void# -> r) -> (Void# -> r) -> r
HUAWEI_SUBPASS_SHADING_SPEC_VERSION = 2


type HUAWEI_SUBPASS_SHADING_EXTENSION_NAME = "VK_HUAWEI_subpass_shading"

-- No documentation found for TopLevel "VK_HUAWEI_SUBPASS_SHADING_EXTENSION_NAME"
pattern HUAWEI_SUBPASS_SHADING_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bHUAWEI_SUBPASS_SHADING_EXTENSION_NAME :: a
$mHUAWEI_SUBPASS_SHADING_EXTENSION_NAME :: forall r a.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
HUAWEI_SUBPASS_SHADING_EXTENSION_NAME = "VK_HUAWEI_subpass_shading"