{-# language CPP #-}
-- | = Name
--
-- VK_KHR_portability_subset - device extension
--
-- == VK_KHR_portability_subset
--
-- [__Name String__]
--     @VK_KHR_portability_subset@
--
-- [__Extension Type__]
--     Device extension
--
-- [__Registered Extension Number__]
--     164
--
-- [__Revision__]
--     1
--
-- [__Extension and Version Dependencies__]
--
--     -   Requires support for Vulkan 1.0
--
--     -   Requires @VK_KHR_get_physical_device_properties2@ to be enabled
--         for any device-level functionality
--
--     -   __This is a /provisional/ extension and /must/ be used with
--         caution. See the
--         <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#boilerplate-provisional-header description>
--         of provisional header files for enablement and stability
--         details.__
--
-- [__Contact__]
--
--     -   Bill Hollings
--         <https://github.com/KhronosGroup/Vulkan-Docs/issues/new?body=[VK_KHR_portability_subset] @billhollings%0A*Here describe the issue or question you have about the VK_KHR_portability_subset extension* >
--
-- == Other Extension Metadata
--
-- [__Last Modified Date__]
--     2020-07-21
--
-- [__IP Status__]
--     No known IP claims.
--
-- [__Contributors__]
--
--     -   Bill Hollings, The Brenwill Workshop Ltd.
--
--     -   Daniel Koch, NVIDIA
--
--     -   Dzmitry Malyshau, Mozilla
--
--     -   Chip Davis, CodeWeavers
--
--     -   Dan Ginsburg, Valve
--
--     -   Mike Weiblen, LunarG
--
--     -   Neil Trevett, NVIDIA
--
--     -   Alexey Knyazev, Independent
--
-- == Description
--
-- The \`VK_KHR_portability_subset extension allows a non-conformant Vulkan
-- implementation to be built on top of another non-Vulkan graphics API,
-- and identifies differences between that implementation and a
-- fully-conformant native Vulkan implementation.
--
-- This extension provides Vulkan implementations with the ability to mark
-- otherwise-required capabilities as unsupported, or to establish
-- additional properties and limits that the application should adhere to
-- in order to guarantee portable behaviour and operation across platforms,
-- including platforms where Vulkan is not natively supported.
--
-- The goal of this specification is to document, and make queryable,
-- capabilities which are required to be supported by a fully-conformant
-- Vulkan 1.0 implementation, but may be optional for an implementation of
-- the Vulkan 1.0 Portability Subset.
--
-- The intent is that this extension will be advertised only on
-- implementations of the Vulkan 1.0 Portability Subset, and not on
-- conformant implementations of Vulkan 1.0. Fully-conformant Vulkan
-- implementations provide all the required capabilities, and so will not
-- provide this extension. Therefore, the existence of this extension can
-- be used to determine that an implementation is likely not fully
-- conformant with the Vulkan spec.
--
-- If this extension is supported by the Vulkan implementation, the
-- application must enable this extension.
--
-- This extension defines several new structures that can be chained to the
-- existing structures used by certain standard Vulkan calls, in order to
-- query for non-conformant portable behavior.
--
-- == New Structures
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
--     'Vulkan.Core10.Device.DeviceCreateInfo':
--
--     -   'PhysicalDevicePortabilitySubsetFeaturesKHR'
--
-- -   Extending
--     'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2':
--
--     -   'PhysicalDevicePortabilitySubsetPropertiesKHR'
--
-- == New Enum Constants
--
-- -   'KHR_PORTABILITY_SUBSET_EXTENSION_NAME'
--
-- -   'KHR_PORTABILITY_SUBSET_SPEC_VERSION'
--
-- -   Extending 'Vulkan.Core10.Enums.StructureType.StructureType':
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_PORTABILITY_SUBSET_FEATURES_KHR'
--
--     -   'Vulkan.Core10.Enums.StructureType.STRUCTURE_TYPE_PHYSICAL_DEVICE_PORTABILITY_SUBSET_PROPERTIES_KHR'
--
-- == Issues
--
-- None.
--
-- == Version History
--
-- -   Revision 1, 2020-07-21 (Bill Hollings)
--
--     -   Initial draft.
--
-- == See Also
--
-- 'PhysicalDevicePortabilitySubsetFeaturesKHR',
-- 'PhysicalDevicePortabilitySubsetPropertiesKHR'
--
-- == Document Notes
--
-- For more information, see the
-- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#VK_KHR_portability_subset Vulkan Specification>
--
-- This page is a generated document. Fixes and changes should be made to
-- the generator scripts, not directly.
module Vulkan.Extensions.VK_KHR_portability_subset  ( PhysicalDevicePortabilitySubsetFeaturesKHR(..)
                                                    , PhysicalDevicePortabilitySubsetPropertiesKHR(..)
                                                    , KHR_PORTABILITY_SUBSET_SPEC_VERSION
                                                    , pattern KHR_PORTABILITY_SUBSET_SPEC_VERSION
                                                    , KHR_PORTABILITY_SUBSET_EXTENSION_NAME
                                                    , pattern KHR_PORTABILITY_SUBSET_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.Word (Word32)
import Data.Kind (Type)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_PORTABILITY_SUBSET_FEATURES_KHR))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_PORTABILITY_SUBSET_PROPERTIES_KHR))
-- | VkPhysicalDevicePortabilitySubsetFeaturesKHR - Structure describing the
-- features that may not be supported by an implementation of the Vulkan
-- 1.0 Portability Subset
--
-- = Members
--
-- This structure describes the following features:
--
-- = Description
--
-- If the 'PhysicalDevicePortabilitySubsetFeaturesKHR' 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. 'PhysicalDevicePortabilitySubsetFeaturesKHR' /can/ also be
-- used in the @pNext@ chain of 'Vulkan.Core10.Device.DeviceCreateInfo' to
-- selectively enable these features.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_portability_subset VK_KHR_portability_subset>,
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDevicePortabilitySubsetFeaturesKHR = PhysicalDevicePortabilitySubsetFeaturesKHR
  { -- | #features-constantAlphaColorBlendFactors#
    -- @constantAlphaColorBlendFactors@ indicates whether this implementation
    -- supports constant /alpha/
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#framebuffer-blendfactors>
    -- used as source or destination /color/
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#framebuffer-blending>.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
constantAlphaColorBlendFactors :: Bool
  , -- | #features-events# @events@ indicates whether this implementation
    -- supports synchronization using
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#synchronization-events>.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
events :: Bool
  , -- | #features-imageViewFormatReinterpretation#
    -- @imageViewFormatReinterpretation@ indicates whether this implementation
    -- supports a 'Vulkan.Core10.Handles.ImageView' being created with a texel
    -- format containing a different number of components, or a different
    -- number of bits in each component, than the texel format of the
    -- underlying 'Vulkan.Core10.Handles.Image'.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
imageViewFormatReinterpretation :: Bool
  , -- | #features-imageViewFormatSwizzle# @imageViewFormatSwizzle@ indicates
    -- whether this implementation supports remapping format components using
    -- 'Vulkan.Core10.ImageView.ImageViewCreateInfo'::@components@.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
imageViewFormatSwizzle :: Bool
  , -- | #features-imageView2DOn3DImage# @imageView2DOn3DImage@ indicates whether
    -- this implementation supports a 'Vulkan.Core10.Handles.Image' being
    -- created with the
    -- 'Vulkan.Core10.Enums.ImageCreateFlagBits.IMAGE_CREATE_2D_ARRAY_COMPATIBLE_BIT'
    -- flag set, permitting a 2D or 2D array image view to be created on a 3D
    -- 'Vulkan.Core10.Handles.Image'.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
imageView2DOn3DImage :: Bool
  , -- | #features-multisampleArrayImage# @multisampleArrayImage@ indicates
    -- whether this implementation supports a 'Vulkan.Core10.Handles.Image'
    -- being created as a 2D array with multiple samples per texel.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
multisampleArrayImage :: Bool
  , -- | #features-mutableComparisonSamplers# @mutableComparisonSamplers@
    -- indicates whether this implementation allows descriptors with comparison
    -- samplers to be
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#descriptorsets-updates updated>.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
mutableComparisonSamplers :: Bool
  , -- | #features-pointPolygons# @pointPolygons@ indicates whether this
    -- implementation supports
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#primsrast>
    -- using a /point/
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#primsrast-polygonmode>.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
pointPolygons :: Bool
  , -- | #features-samplerMipLodBias# @samplerMipLodBias@ indicates whether this
    -- implementation supports setting a
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#samplers-mipLodBias mipmap LOD bias value>
    -- when
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#samplers creating a sampler>.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
samplerMipLodBias :: Bool
  , -- | #features-separateStencilMaskRef# @separateStencilMaskRef@ indicates
    -- whether this implementation supports separate front and back
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#fragops-stencil>
    -- reference values.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
separateStencilMaskRef :: Bool
  , -- | #features-shaderSampleRateInterpolationFunctions#
    -- @shaderSampleRateInterpolationFunctions@ indicates whether this
    -- implementation supports fragment shaders which use the
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#spirvenv-capabilities-table-InterpolationFunction InterpolationFunction>
    -- capability and the extended instructions @InterpolateAtCentroid@,
    -- @InterpolateAtOffset@, and @InterpolateAtSample@ from the @GLSL.std.450@
    -- extended instruction set. This member is only meaningful if the
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-sampleRateShading sampleRateShading>
    -- feature is supported.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
shaderSampleRateInterpolationFunctions :: Bool
  , -- | #features-tessellationIsolines# @tessellationIsolines@ indicates whether
    -- this implementation supports
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#tessellation-isoline-tessellation isoline output>
    -- from the
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#tessellation>
    -- stage of a graphics pipeline. This member is only meaningful if
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-tessellationShader tessellationShader>
    -- are supported.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
tessellationIsolines :: Bool
  , -- | #features-tessellationPointMode# @tessellationPointMode@ indicates
    -- whether this implementation supports
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#tessellation-point-mode point output>
    -- from the
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#tessellation>
    -- stage of a graphics pipeline. This member is only meaningful if
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#features-tessellationShader tessellationShader>
    -- are supported.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
tessellationPointMode :: Bool
  , -- | #features-triangleFans# @triangleFans@ indicates whether this
    -- implementation supports
    -- <https://registry.khronos.org/vulkan/specs/1.3-extensions/html/vkspec.html#drawing-triangle-fans>
    -- primitive topology.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
triangleFans :: Bool
  , -- | #features-vertexAttributeAccessBeyondStride#
    -- @vertexAttributeAccessBeyondStride@ indicates whether this
    -- implementation supports accessing a vertex input attribute beyond the
    -- stride of the corresponding vertex input binding.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
vertexAttributeAccessBeyondStride :: Bool
  }
  deriving (Typeable, PhysicalDevicePortabilitySubsetFeaturesKHR
-> PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
(PhysicalDevicePortabilitySubsetFeaturesKHR
 -> PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool)
-> (PhysicalDevicePortabilitySubsetFeaturesKHR
    -> PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool)
-> Eq PhysicalDevicePortabilitySubsetFeaturesKHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDevicePortabilitySubsetFeaturesKHR
-> PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
$c/= :: PhysicalDevicePortabilitySubsetFeaturesKHR
-> PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
== :: PhysicalDevicePortabilitySubsetFeaturesKHR
-> PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
$c== :: PhysicalDevicePortabilitySubsetFeaturesKHR
-> PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDevicePortabilitySubsetFeaturesKHR)
#endif
deriving instance Show PhysicalDevicePortabilitySubsetFeaturesKHR

instance ToCStruct PhysicalDevicePortabilitySubsetFeaturesKHR where
  withCStruct :: forall b.
PhysicalDevicePortabilitySubsetFeaturesKHR
-> (Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> IO b) -> IO b
withCStruct PhysicalDevicePortabilitySubsetFeaturesKHR
x Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> IO b
f = Int
-> (Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
80 ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> IO b) -> IO b)
-> (Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p -> Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
-> PhysicalDevicePortabilitySubsetFeaturesKHR -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p PhysicalDevicePortabilitySubsetFeaturesKHR
x (Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> IO b
f Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p)
  pokeCStruct :: forall b.
Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
-> PhysicalDevicePortabilitySubsetFeaturesKHR -> IO b -> IO b
pokeCStruct Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p PhysicalDevicePortabilitySubsetFeaturesKHR{Bool
vertexAttributeAccessBeyondStride :: Bool
triangleFans :: Bool
tessellationPointMode :: Bool
tessellationIsolines :: Bool
shaderSampleRateInterpolationFunctions :: Bool
separateStencilMaskRef :: Bool
samplerMipLodBias :: Bool
pointPolygons :: Bool
mutableComparisonSamplers :: Bool
multisampleArrayImage :: Bool
imageView2DOn3DImage :: Bool
imageViewFormatSwizzle :: Bool
imageViewFormatReinterpretation :: Bool
events :: Bool
constantAlphaColorBlendFactors :: Bool
$sel:vertexAttributeAccessBeyondStride:PhysicalDevicePortabilitySubsetFeaturesKHR :: PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
$sel:triangleFans:PhysicalDevicePortabilitySubsetFeaturesKHR :: PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
$sel:tessellationPointMode:PhysicalDevicePortabilitySubsetFeaturesKHR :: PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
$sel:tessellationIsolines:PhysicalDevicePortabilitySubsetFeaturesKHR :: PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
$sel:shaderSampleRateInterpolationFunctions:PhysicalDevicePortabilitySubsetFeaturesKHR :: PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
$sel:separateStencilMaskRef:PhysicalDevicePortabilitySubsetFeaturesKHR :: PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
$sel:samplerMipLodBias:PhysicalDevicePortabilitySubsetFeaturesKHR :: PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
$sel:pointPolygons:PhysicalDevicePortabilitySubsetFeaturesKHR :: PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
$sel:mutableComparisonSamplers:PhysicalDevicePortabilitySubsetFeaturesKHR :: PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
$sel:multisampleArrayImage:PhysicalDevicePortabilitySubsetFeaturesKHR :: PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
$sel:imageView2DOn3DImage:PhysicalDevicePortabilitySubsetFeaturesKHR :: PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
$sel:imageViewFormatSwizzle:PhysicalDevicePortabilitySubsetFeaturesKHR :: PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
$sel:imageViewFormatReinterpretation:PhysicalDevicePortabilitySubsetFeaturesKHR :: PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
$sel:events:PhysicalDevicePortabilitySubsetFeaturesKHR :: PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
$sel:constantAlphaColorBlendFactors:PhysicalDevicePortabilitySubsetFeaturesKHR :: PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_PORTABILITY_SUBSET_FEATURES_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
-> 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 PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
constantAlphaColorBlendFactors))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
events))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
imageViewFormatReinterpretation))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
imageViewFormatSwizzle))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
imageView2DOn3DImage))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
multisampleArrayImage))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
mutableComparisonSamplers))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
pointPolygons))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
samplerMipLodBias))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
52 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
separateStencilMaskRef))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
shaderSampleRateInterpolationFunctions))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
tessellationIsolines))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
tessellationPointMode))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
68 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
triangleFans))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
vertexAttributeAccessBeyondStride))
    IO b
f
  cStructSize :: Int
cStructSize = Int
80
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b.
Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_PORTABILITY_SUBSET_FEATURES_KHR)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
-> 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 PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
52 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
68 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct PhysicalDevicePortabilitySubsetFeaturesKHR where
  peekCStruct :: Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
-> IO PhysicalDevicePortabilitySubsetFeaturesKHR
peekCStruct Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p = do
    Bool32
constantAlphaColorBlendFactors <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
    Bool32
events <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32))
    Bool32
imageViewFormatReinterpretation <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Bool32))
    Bool32
imageViewFormatSwizzle <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Bool32))
    Bool32
imageView2DOn3DImage <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Bool32))
    Bool32
multisampleArrayImage <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Bool32))
    Bool32
mutableComparisonSamplers <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Bool32))
    Bool32
pointPolygons <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Bool32))
    Bool32
samplerMipLodBias <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Bool32))
    Bool32
separateStencilMaskRef <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
52 :: Ptr Bool32))
    Bool32
shaderSampleRateInterpolationFunctions <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr Bool32))
    Bool32
tessellationIsolines <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Bool32))
    Bool32
tessellationPointMode <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr Bool32))
    Bool32
triangleFans <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
68 :: Ptr Bool32))
    Bool32
vertexAttributeAccessBeyondStride <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr Bool32))
    PhysicalDevicePortabilitySubsetFeaturesKHR
-> IO PhysicalDevicePortabilitySubsetFeaturesKHR
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDevicePortabilitySubsetFeaturesKHR
 -> IO PhysicalDevicePortabilitySubsetFeaturesKHR)
-> PhysicalDevicePortabilitySubsetFeaturesKHR
-> IO PhysicalDevicePortabilitySubsetFeaturesKHR
forall a b. (a -> b) -> a -> b
$ Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> PhysicalDevicePortabilitySubsetFeaturesKHR
PhysicalDevicePortabilitySubsetFeaturesKHR
             (Bool32 -> Bool
bool32ToBool Bool32
constantAlphaColorBlendFactors)
             (Bool32 -> Bool
bool32ToBool Bool32
events)
             (Bool32 -> Bool
bool32ToBool Bool32
imageViewFormatReinterpretation)
             (Bool32 -> Bool
bool32ToBool Bool32
imageViewFormatSwizzle)
             (Bool32 -> Bool
bool32ToBool Bool32
imageView2DOn3DImage)
             (Bool32 -> Bool
bool32ToBool Bool32
multisampleArrayImage)
             (Bool32 -> Bool
bool32ToBool Bool32
mutableComparisonSamplers)
             (Bool32 -> Bool
bool32ToBool Bool32
pointPolygons)
             (Bool32 -> Bool
bool32ToBool Bool32
samplerMipLodBias)
             (Bool32 -> Bool
bool32ToBool Bool32
separateStencilMaskRef)
             (Bool32 -> Bool
bool32ToBool Bool32
shaderSampleRateInterpolationFunctions)
             (Bool32 -> Bool
bool32ToBool Bool32
tessellationIsolines)
             (Bool32 -> Bool
bool32ToBool Bool32
tessellationPointMode)
             (Bool32 -> Bool
bool32ToBool Bool32
triangleFans)
             (Bool32 -> Bool
bool32ToBool Bool32
vertexAttributeAccessBeyondStride)

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

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


-- | VkPhysicalDevicePortabilitySubsetPropertiesKHR - Structure describing
-- additional properties supported by a portable implementation
--
-- = Description
--
-- If the 'PhysicalDevicePortabilitySubsetPropertiesKHR' 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_KHR_portability_subset VK_KHR_portability_subset>,
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDevicePortabilitySubsetPropertiesKHR = PhysicalDevicePortabilitySubsetPropertiesKHR
  { -- | #limits-minVertexInputBindingStrideAlignment#
    -- @minVertexInputBindingStrideAlignment@ indicates the minimum alignment
    -- for vertex input strides.
    -- 'Vulkan.Core10.Pipeline.VertexInputBindingDescription'::@stride@ /must/
    -- be a multiple of, and at least as large as, this value. The value /must/
    -- be a power of two.
    PhysicalDevicePortabilitySubsetPropertiesKHR -> Word32
minVertexInputBindingStrideAlignment :: Word32 }
  deriving (Typeable, PhysicalDevicePortabilitySubsetPropertiesKHR
-> PhysicalDevicePortabilitySubsetPropertiesKHR -> Bool
(PhysicalDevicePortabilitySubsetPropertiesKHR
 -> PhysicalDevicePortabilitySubsetPropertiesKHR -> Bool)
-> (PhysicalDevicePortabilitySubsetPropertiesKHR
    -> PhysicalDevicePortabilitySubsetPropertiesKHR -> Bool)
-> Eq PhysicalDevicePortabilitySubsetPropertiesKHR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDevicePortabilitySubsetPropertiesKHR
-> PhysicalDevicePortabilitySubsetPropertiesKHR -> Bool
$c/= :: PhysicalDevicePortabilitySubsetPropertiesKHR
-> PhysicalDevicePortabilitySubsetPropertiesKHR -> Bool
== :: PhysicalDevicePortabilitySubsetPropertiesKHR
-> PhysicalDevicePortabilitySubsetPropertiesKHR -> Bool
$c== :: PhysicalDevicePortabilitySubsetPropertiesKHR
-> PhysicalDevicePortabilitySubsetPropertiesKHR -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDevicePortabilitySubsetPropertiesKHR)
#endif
deriving instance Show PhysicalDevicePortabilitySubsetPropertiesKHR

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

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

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


type KHR_PORTABILITY_SUBSET_SPEC_VERSION = 1

-- No documentation found for TopLevel "VK_KHR_PORTABILITY_SUBSET_SPEC_VERSION"
pattern KHR_PORTABILITY_SUBSET_SPEC_VERSION :: forall a . Integral a => a
pattern $bKHR_PORTABILITY_SUBSET_SPEC_VERSION :: forall a. Integral a => a
$mKHR_PORTABILITY_SUBSET_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> (Void# -> r) -> (Void# -> r) -> r
KHR_PORTABILITY_SUBSET_SPEC_VERSION = 1


type KHR_PORTABILITY_SUBSET_EXTENSION_NAME = "VK_KHR_portability_subset"

-- No documentation found for TopLevel "VK_KHR_PORTABILITY_SUBSET_EXTENSION_NAME"
pattern KHR_PORTABILITY_SUBSET_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bKHR_PORTABILITY_SUBSET_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mKHR_PORTABILITY_SUBSET_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
KHR_PORTABILITY_SUBSET_EXTENSION_NAME = "VK_KHR_portability_subset"