{-# language CPP #-}
-- | = Name
--
-- VK_EXT_multisampled_render_to_single_sampled - device extension
--
-- == VK_EXT_multisampled_render_to_single_sampled
--
-- [__Name String__]
--     @VK_EXT_multisampled_render_to_single_sampled@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     377
--
-- [__Revision__]
--     1
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires support for Vulkan 1.0
--
--     -   Requires @VK_KHR_create_renderpass2@ to be enabled for any
--         device-level functionality
--
--     -   Requires @VK_KHR_depth_stencil_resolve@ to be enabled for any
--         device-level functionality
--
-- [__Contact__]
--
--     -   Shahbaz Youssefi
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_EXT_multisampled_render_to_single_sampled] @syoussefi%0A*Here describe the issue or question you have about the VK_EXT_multisampled_render_to_single_sampled extension* >
--
-- [__Extension Proposal__]
--     <https://github.com/KhronosGroup/Vulkan-Docs/tree/main/proposals/VK_EXT_multisampled_render_to_single_sampled.adoc VK_EXT_multisampled_render_to_single_sampled>
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2021-04-16
--
-- [__IP Status__]
--     No known IP claims.
--
-- [__Contributors__]
--
--     -   Shahbaz Youssefi, Google
--
--     -   Jan-Harald Fredriksen, Arm
--
--     -   Jörg Wagner, Arm
--
--     -   Matthew Netsch, Qualcomm Technologies, Inc.
--
--     -   Jarred Davies, Imagination Technologies
--
-- == Description
--
-- With careful usage of resolve attachments, multisampled image memory
-- allocated with
-- 'Vulkan.Core10.Enums.MemoryPropertyFlagBits.MEMORY_PROPERTY_LAZILY_ALLOCATED_BIT',
-- @loadOp@ not equal to
-- 'Vulkan.Core10.Enums.AttachmentLoadOp.ATTACHMENT_LOAD_OP_LOAD' and
-- @storeOp@ not equal to
-- 'Vulkan.Core10.Enums.AttachmentStoreOp.ATTACHMENT_STORE_OP_STORE', a
-- Vulkan application is able to efficiently perform multisampled rendering
-- without incurring any additional memory penalty on some implementations.
--
-- Under certain circumstances however, the application may not be able to
-- complete its multisampled rendering within a single render pass; for
-- example if it does partial rasterization from frame to frame, blending
-- on an image from a previous frame, or in emulation of
-- GL_EXT_multisampled_render_to_texture. In such cases, the application
-- can use an initial subpass to effectively load single-sampled data from
-- the next subpass’s resolve attachment and fill in the multisampled
-- attachment which otherwise uses @loadOp@ equal to
-- 'Vulkan.Core10.Enums.AttachmentLoadOp.ATTACHMENT_LOAD_OP_DONT_CARE'.
-- However, this is not always possible (for example for stencil in the
-- absence of VK_EXT_shader_stencil_export) and has multiple drawbacks.
--
-- Some implementations are able to perform said operation efficiently in
-- hardware, effectively loading a multisampled attachment from the
-- contents of a single sampled one. Together with the ability to perform a
-- resolve operation at the end of a subpass, these implementations are
-- able to perform multisampled rendering on single-sampled attachments
-- with no extra memory or bandwidth overhead. This extension exposes this
-- capability by allowing a framebuffer and render pass to include
-- single-sampled attachments while rendering is done with a specified
-- number of samples.
--
-- == New Structures
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.FormatProperties2':
--
--     -   'SubpassResolvePerformanceQueryEXT'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT'
--
-- -   Extending
--     'Vulkan.Core12.Promoted_From_VK_KHR_create_renderpass2.SubpassDescription2',
--     'Vulkan.Core13.Promoted_From_VK_KHR_dynamic_rendering.RenderingInfo':
--
--     -   'MultisampledRenderToSingleSampledInfoEXT'
--
-- == New Enum Constants
--
-- -   'EXT_MULTISAMPLED_RENDER_TO_SINGLE_SAMPLED_EXTENSION_NAME'
--
-- -   'EXT_MULTISAMPLED_RENDER_TO_SINGLE_SAMPLED_SPEC_VERSION'
--
-- -   Extending
--     'Vulkan.Core10.Enums.ImageCreateFlagBits.ImageCreateFlagBits':
--
--     -   'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_MULTISAMPLED_RENDER_TO_SINGLE_SAMPLED_BIT_EXT'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_MULTISAMPLED_RENDER_TO_SINGLE_SAMPLED_INFO_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_MULTISAMPLED_RENDER_TO_SINGLE_SAMPLED_FEATURES_EXT'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_SUBPASS_RESOLVE_PERFORMANCE_QUERY_EXT'
--
-- == Issues
--
-- 1) Could the multisampled attachment be initialized through some form of
-- copy?
--
-- __RESOLVED__: No. Some implementations do not support copying between
-- attachments in general, and find expressing this operation through a
-- copy unnatural.
--
-- 2) Another way to achieve this is by introducing a new @loadOp@ to load
-- the contents of the multisampled image from a single-sampled one. Why is
-- this extension preferred?
--
-- __RESOLVED__: Using this extension simplifies the application, as it
-- does not need to manage a secondary lazily-allocated image.
-- Additionally, using this extension leaves less room for error; for
-- example a single mistake in @loadOp@ or @storeOp@ would result in the
-- lazily-allocated image to actually take up memory, and remain so until
-- destruction.
--
-- 3) There is no guarantee that multisampled data between two subpasses
-- with the same number of samples will be retained as the implementation
-- may be forced to split the render pass implicitly for various reasons.
-- Should this extension require that every subpass that uses
-- multisampled-render-to-single-sampled end in an implicit render pass
-- split (which results in a resolve operation)?
--
-- __RESOLVED__: No. Not requiring this allows render passes with multiple
-- multisampled-render-to-single-sampled subpasses to potentially execute
-- more efficiently (though there is no guarantee).
--
-- == Version History
--
-- -   Revision 1, 2021-04-12 (Shahbaz Youssefi)
--
-- == See Also
--
-- 'MultisampledRenderToSingleSampledInfoEXT',
-- 'PhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT',
-- 'SubpassResolvePerformanceQueryEXT'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_EXT_multisampled_render_to_single_sampled Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_EXT_multisampled_render_to_single_sampled  ( PhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT(..)
                                                                       , SubpassResolvePerformanceQueryEXT(..)
                                                                       , MultisampledRenderToSingleSampledInfoEXT(..)
                                                                       , EXT_MULTISAMPLED_RENDER_TO_SINGLE_SAMPLED_SPEC_VERSION
                                                                       , pattern EXT_MULTISAMPLED_RENDER_TO_SINGLE_SAMPLED_SPEC_VERSION
                                                                       , EXT_MULTISAMPLED_RENDER_TO_SINGLE_SAMPLED_EXTENSION_NAME
                                                                       , pattern EXT_MULTISAMPLED_RENDER_TO_SINGLE_SAMPLED_EXTENSION_NAME
                                                                       ) where

import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
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 Foreign.Ptr (Ptr)
import Data.Kind (Type)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Enums.SampleCountFlagBits (SampleCountFlagBits)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_MULTISAMPLED_RENDER_TO_SINGLE_SAMPLED_INFO_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_MULTISAMPLED_RENDER_TO_SINGLE_SAMPLED_FEATURES_EXT))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_SUBPASS_RESOLVE_PERFORMANCE_QUERY_EXT))
-- | VkPhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT - Structure
-- describing whether multisampled rendering to single-sampled attachments
-- is supported
--
-- = Members
--
-- This structure describes the following features:
--
-- = Description
--
-- If the 'PhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT'
-- 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. 'PhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT'
-- /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_EXT_multisampled_render_to_single_sampled VK_EXT_multisampled_render_to_single_sampled>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT = PhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT
  { -- | #features-multisampledRenderToSingleSampled#
    -- @multisampledRenderToSingleSampled@ indicates that the implementation
    -- supports multisampled rendering to single-sampled render pass
    -- attachments.
    PhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT -> Bool
multisampledRenderToSingleSampled :: Bool }
  deriving (Typeable, PhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT
-> PhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT
-> Bool
(PhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT
 -> PhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT
 -> Bool)
-> (PhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT
    -> PhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT
    -> Bool)
-> Eq PhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT
-> PhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT
-> Bool
$c/= :: PhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT
-> PhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT
-> Bool
== :: PhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT
-> PhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT
-> Bool
$c== :: PhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT
-> PhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT
-> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT)
#endif
deriving instance Show PhysicalDeviceMultisampledRenderToSingleSampledFeaturesEXT

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

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

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


-- | VkSubpassResolvePerformanceQueryEXT - Structure specifying the
-- efficiency of subpass resolve for an attachment with a format
--
-- = Description
--
-- If @optimal@ is 'Vulkan.Core10.FundamentalTypes.FALSE' for a
-- 'Vulkan.Core10.Enums.Format.Format', using a subpass resolve operation
-- on a multisampled attachment with this format can incur additional
-- costs, including additional memory bandwidth usage and a higher memory
-- footprint. If an attachment with such a format is used in a
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#subpass-multisampledrendertosinglesampled multisampled-render-to-single-sampled>
-- subpass, the additional memory and memory bandwidth usage can nullify
-- the benefits of using the @VK_EXT_multisampled_render_to_single_sampled@
-- extension.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_multisampled_render_to_single_sampled VK_EXT_multisampled_render_to_single_sampled>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data SubpassResolvePerformanceQueryEXT = SubpassResolvePerformanceQueryEXT
  { -- | @optimal@ specifies that a subpass resolve operation is optimally
    -- performed.
    SubpassResolvePerformanceQueryEXT -> Bool
optimal :: Bool }
  deriving (Typeable, SubpassResolvePerformanceQueryEXT
-> SubpassResolvePerformanceQueryEXT -> Bool
(SubpassResolvePerformanceQueryEXT
 -> SubpassResolvePerformanceQueryEXT -> Bool)
-> (SubpassResolvePerformanceQueryEXT
    -> SubpassResolvePerformanceQueryEXT -> Bool)
-> Eq SubpassResolvePerformanceQueryEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubpassResolvePerformanceQueryEXT
-> SubpassResolvePerformanceQueryEXT -> Bool
$c/= :: SubpassResolvePerformanceQueryEXT
-> SubpassResolvePerformanceQueryEXT -> Bool
== :: SubpassResolvePerformanceQueryEXT
-> SubpassResolvePerformanceQueryEXT -> Bool
$c== :: SubpassResolvePerformanceQueryEXT
-> SubpassResolvePerformanceQueryEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SubpassResolvePerformanceQueryEXT)
#endif
deriving instance Show SubpassResolvePerformanceQueryEXT

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

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

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


-- | VkMultisampledRenderToSingleSampledInfoEXT - Structure containing info
-- for multisampled rendering to single-sampled attachments in a subpass
--
-- == Valid Usage
--
-- -   #VUID-VkMultisampledRenderToSingleSampledInfoEXT-rasterizationSamples-06878#
--     The value of @rasterizationSamples@ /must/ not be
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SAMPLE_COUNT_1_BIT'
--
-- -   #VUID-VkMultisampledRenderToSingleSampledInfoEXT-pNext-06880# If
--     added to the @pNext@ chain of
--     'Vulkan.Core13.Promoted_From_VK_KHR_dynamic_rendering.RenderingInfo',
--     each @imageView@ member of any element of
--     'Vulkan.Core13.Promoted_From_VK_KHR_dynamic_rendering.RenderingInfo'::@pColorAttachments@,
--     'Vulkan.Core13.Promoted_From_VK_KHR_dynamic_rendering.RenderingInfo'::@pDepthAttachment@,
--     or
--     'Vulkan.Core13.Promoted_From_VK_KHR_dynamic_rendering.RenderingInfo'::@pStencilAttachment@
--     that is not 'Vulkan.Core10.APIConstants.NULL_HANDLE' /must/ have a
--     format that supports the sample count specified in
--     @rasterizationSamples@
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-VkMultisampledRenderToSingleSampledInfoEXT-sType-sType#
--     @sType@ /must/ be
--     'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_MULTISAMPLED_RENDER_TO_SINGLE_SAMPLED_INFO_EXT'
--
-- -   #VUID-VkMultisampledRenderToSingleSampledInfoEXT-rasterizationSamples-parameter#
--     @rasterizationSamples@ /must/ be a valid
--     'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits' value
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_EXT_multisampled_render_to_single_sampled VK_EXT_multisampled_render_to_single_sampled>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.SampleCountFlagBits.SampleCountFlagBits',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data MultisampledRenderToSingleSampledInfoEXT = MultisampledRenderToSingleSampledInfoEXT
  { -- | @multisampledRenderToSingleSampledEnable@ controls whether multisampled
    -- rendering to single-sampled attachments is performed as described
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#multisampled-render-to-single-sampled below>.
    MultisampledRenderToSingleSampledInfoEXT -> Bool
multisampledRenderToSingleSampledEnable :: Bool
  , -- | @rasterizationSamples@ is a VkSampleCountFlagBits specifying the number
    -- of samples used in rasterization.
    MultisampledRenderToSingleSampledInfoEXT -> SampleCountFlagBits
rasterizationSamples :: SampleCountFlagBits
  }
  deriving (Typeable, MultisampledRenderToSingleSampledInfoEXT
-> MultisampledRenderToSingleSampledInfoEXT -> Bool
(MultisampledRenderToSingleSampledInfoEXT
 -> MultisampledRenderToSingleSampledInfoEXT -> Bool)
-> (MultisampledRenderToSingleSampledInfoEXT
    -> MultisampledRenderToSingleSampledInfoEXT -> Bool)
-> Eq MultisampledRenderToSingleSampledInfoEXT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MultisampledRenderToSingleSampledInfoEXT
-> MultisampledRenderToSingleSampledInfoEXT -> Bool
$c/= :: MultisampledRenderToSingleSampledInfoEXT
-> MultisampledRenderToSingleSampledInfoEXT -> Bool
== :: MultisampledRenderToSingleSampledInfoEXT
-> MultisampledRenderToSingleSampledInfoEXT -> Bool
$c== :: MultisampledRenderToSingleSampledInfoEXT
-> MultisampledRenderToSingleSampledInfoEXT -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MultisampledRenderToSingleSampledInfoEXT)
#endif
deriving instance Show MultisampledRenderToSingleSampledInfoEXT

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

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

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

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


type EXT_MULTISAMPLED_RENDER_TO_SINGLE_SAMPLED_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_EXT_MULTISAMPLED_RENDER_TO_SINGLE_SAMPLED_SPEC_VERSION"
pattern EXT_MULTISAMPLED_RENDER_TO_SINGLE_SAMPLED_SPEC_VERSION :: forall a . Integral a => a
pattern $bEXT_MULTISAMPLED_RENDER_TO_SINGLE_SAMPLED_SPEC_VERSION :: forall a. Integral a => a
$mEXT_MULTISAMPLED_RENDER_TO_SINGLE_SAMPLED_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> (Void# -> r) -> (Void# -> r) -> r
EXT_MULTISAMPLED_RENDER_TO_SINGLE_SAMPLED_SPEC_VERSION = 1


type EXT_MULTISAMPLED_RENDER_TO_SINGLE_SAMPLED_EXTENSION_NAME = "VK_EXT_multisampled_render_to_single_sampled"

-- No documentation found for TopLevel "VK_EXT_MULTISAMPLED_RENDER_TO_SINGLE_SAMPLED_EXTENSION_NAME"
pattern EXT_MULTISAMPLED_RENDER_TO_SINGLE_SAMPLED_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bEXT_MULTISAMPLED_RENDER_TO_SINGLE_SAMPLED_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mEXT_MULTISAMPLED_RENDER_TO_SINGLE_SAMPLED_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
EXT_MULTISAMPLED_RENDER_TO_SINGLE_SAMPLED_EXTENSION_NAME = "VK_EXT_multisampled_render_to_single_sampled"