{-# language CPP #-}
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 (allocaBytesAligned)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
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.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
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
--
-- The members of the 'PhysicalDevicePortabilitySubsetFeaturesKHR'
-- structure describe the following features:
--
-- = Description
--
-- If the 'PhysicalDevicePortabilitySubsetFeaturesKHR' structure is
-- included in the @pNext@ chain of
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceFeatures2',
-- it is filled with values indicating whether the features are supported.
-- 'PhysicalDevicePortabilitySubsetFeaturesKHR' /can/ also be used in the
-- @pNext@ chain of 'Vulkan.Core10.Device.DeviceCreateInfo' to enable the
-- features.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'Vulkan.Core10.FundamentalTypes.Bool32',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDevicePortabilitySubsetFeaturesKHR = PhysicalDevicePortabilitySubsetFeaturesKHR
  { -- | @constantAlphaColorBlendFactors@ indicates whether this implementation
    -- supports constant /alpha/
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#framebuffer-blendfactors>
    -- used as source or destination /color/
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#framebuffer-blending>.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
constantAlphaColorBlendFactors :: Bool
  , -- | @events@ indicates whether this implementation supports synchronization
    -- using
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#synchronization-events>.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
events :: Bool
  , -- | @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
  , -- | @imageViewFormatSwizzle@ indicates whether this implementation supports
    -- remapping format components using
    -- 'Vulkan.Core10.ImageView.ImageViewCreateInfo'::@components@.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
imageViewFormatSwizzle :: Bool
  , -- | @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
  , -- | @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
  , -- | @mutableComparisonSamplers@ indicates whether this implementation allows
    -- descriptors with comparison samplers to be
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#descriptorsets-updates updated>.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
mutableComparisonSamplers :: Bool
  , -- | @pointPolygons@ indicates whether this implementation supports
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#primsrast>
    -- using a /point/
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#primsrast-polygonmode>.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
pointPolygons :: Bool
  , -- | @samplerMipLodBias@ indicates whether this implementation supports
    -- setting a
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#samplers-mipLodBias mipmap LOD bias value>
    -- when
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#samplers creating a sampler>.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
samplerMipLodBias :: Bool
  , -- | @separateStencilMaskRef@ indicates whether this implementation supports
    -- separate front and back
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#fragops-stencil>
    -- reference values.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
separateStencilMaskRef :: Bool
  , -- | @shaderSampleRateInterpolationFunctions@ indicates whether this
    -- implementation supports fragment shaders which use the
    -- @InterpolationFunction@
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#spirvenv-capabilities-table 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://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-sampleRateShading sampleRateShading>
    -- feature is supported.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
shaderSampleRateInterpolationFunctions :: Bool
  , -- | @tessellationIsolines@ indicates whether this implementation supports
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#tessellation-isoline-tessellation isoline output>
    -- from the
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#tessellation>
    -- stage of a graphics pipeline. This member is only meaningful if
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-tessellationShader tessellation shaders>
    -- are supported.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
tessellationIsolines :: Bool
  , -- | @tessellationPointMode@ indicates whether this implementation supports
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#tessellation-point-mode point output>
    -- from the
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#tessellation>
    -- stage of a graphics pipeline. This member is only meaningful if
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#features-tessellationShader tessellation shaders>
    -- are supported.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
tessellationPointMode :: Bool
  , -- | @triangleFans@ indicates whether this implementation supports
    -- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#drawing-triangle-fans>
    -- primitive topology.
    PhysicalDevicePortabilitySubsetFeaturesKHR -> Bool
triangleFans :: Bool
  , -- | @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 :: PhysicalDevicePortabilitySubsetFeaturesKHR
-> (Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> IO b) -> IO b
withCStruct x :: PhysicalDevicePortabilitySubsetFeaturesKHR
x f :: Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> IO b
f = Int
-> Int
-> (Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 80 8 ((Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> IO b) -> IO b)
-> (Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: 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 :: Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
-> PhysicalDevicePortabilitySubsetFeaturesKHR -> IO b -> IO b
pokeCStruct p :: Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p PhysicalDevicePortabilitySubsetFeaturesKHR{..} f :: 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` 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` 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` 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` 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` 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` 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` 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` 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` 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` 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` 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` 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` 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` 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` 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` 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` 72 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
vertexAttributeAccessBeyondStride))
    IO b
f
  cStructSize :: Int
cStructSize = 80
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr PhysicalDevicePortabilitySubsetFeaturesKHR -> IO b -> IO b
pokeZeroCStruct p :: Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p f :: 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` 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` 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` 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` 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` 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` 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` 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` 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` 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` 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` 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` 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` 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` 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` 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` 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` 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 p :: Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
p = do
    Bool32
constantAlphaColorBlendFactors <- Ptr Bool32 -> IO Bool32
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` 16 :: Ptr Bool32))
    Bool32
events <- Ptr Bool32 -> IO Bool32
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` 20 :: Ptr Bool32))
    Bool32
imageViewFormatReinterpretation <- Ptr Bool32 -> IO Bool32
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` 24 :: Ptr Bool32))
    Bool32
imageViewFormatSwizzle <- Ptr Bool32 -> IO Bool32
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` 28 :: Ptr Bool32))
    Bool32
imageView2DOn3DImage <- Ptr Bool32 -> IO Bool32
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` 32 :: Ptr Bool32))
    Bool32
multisampleArrayImage <- Ptr Bool32 -> IO Bool32
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` 36 :: Ptr Bool32))
    Bool32
mutableComparisonSamplers <- Ptr Bool32 -> IO Bool32
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` 40 :: Ptr Bool32))
    Bool32
pointPolygons <- Ptr Bool32 -> IO Bool32
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` 44 :: Ptr Bool32))
    Bool32
samplerMipLodBias <- Ptr Bool32 -> IO Bool32
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` 48 :: Ptr Bool32))
    Bool32
separateStencilMaskRef <- Ptr Bool32 -> IO Bool32
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` 52 :: Ptr Bool32))
    Bool32
shaderSampleRateInterpolationFunctions <- Ptr Bool32 -> IO Bool32
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` 56 :: Ptr Bool32))
    Bool32
tessellationIsolines <- Ptr Bool32 -> IO Bool32
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` 60 :: Ptr Bool32))
    Bool32
tessellationPointMode <- Ptr Bool32 -> IO Bool32
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` 64 :: Ptr Bool32))
    Bool32
triangleFans <- Ptr Bool32 -> IO Bool32
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` 68 :: Ptr Bool32))
    Bool32
vertexAttributeAccessBeyondStride <- Ptr Bool32 -> IO Bool32
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` 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
_ = 80
  alignment :: PhysicalDevicePortabilitySubsetFeaturesKHR -> Int
alignment ~PhysicalDevicePortabilitySubsetFeaturesKHR
_ = 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 :: Ptr PhysicalDevicePortabilitySubsetFeaturesKHR
ptr poked :: 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
--
-- = Members
--
-- The members of the 'PhysicalDevicePortabilitySubsetPropertiesKHR'
-- structure describe the following implementation-dependent limits:
--
-- = Description
--
-- If the 'PhysicalDevicePortabilitySubsetPropertiesKHR' structure is
-- included in the @pNext@ chain of
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.PhysicalDeviceProperties2',
-- it is filled with the implementation-dependent limits.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data PhysicalDevicePortabilitySubsetPropertiesKHR = PhysicalDevicePortabilitySubsetPropertiesKHR
  { -- | @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.
    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 :: PhysicalDevicePortabilitySubsetPropertiesKHR
-> (Ptr PhysicalDevicePortabilitySubsetPropertiesKHR -> IO b)
-> IO b
withCStruct x :: PhysicalDevicePortabilitySubsetPropertiesKHR
x f :: Ptr PhysicalDevicePortabilitySubsetPropertiesKHR -> IO b
f = Int
-> Int
-> (Ptr PhysicalDevicePortabilitySubsetPropertiesKHR -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 24 8 ((Ptr PhysicalDevicePortabilitySubsetPropertiesKHR -> IO b)
 -> IO b)
-> (Ptr PhysicalDevicePortabilitySubsetPropertiesKHR -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \p :: 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 :: Ptr PhysicalDevicePortabilitySubsetPropertiesKHR
-> PhysicalDevicePortabilitySubsetPropertiesKHR -> IO b -> IO b
pokeCStruct p :: Ptr PhysicalDevicePortabilitySubsetPropertiesKHR
p PhysicalDevicePortabilitySubsetPropertiesKHR{..} f :: 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` 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` 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` 16 :: Ptr Word32)) (Word32
minVertexInputBindingStrideAlignment)
    IO b
f
  cStructSize :: Int
cStructSize = 24
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr PhysicalDevicePortabilitySubsetPropertiesKHR -> IO b -> IO b
pokeZeroCStruct p :: Ptr PhysicalDevicePortabilitySubsetPropertiesKHR
p f :: 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` 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` 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` 16 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct PhysicalDevicePortabilitySubsetPropertiesKHR where
  peekCStruct :: Ptr PhysicalDevicePortabilitySubsetPropertiesKHR
-> IO PhysicalDevicePortabilitySubsetPropertiesKHR
peekCStruct p :: Ptr PhysicalDevicePortabilitySubsetPropertiesKHR
p = do
    Word32
minVertexInputBindingStrideAlignment <- Ptr Word32 -> IO Word32
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` 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
_ = 24
  alignment :: PhysicalDevicePortabilitySubsetPropertiesKHR -> Int
alignment ~PhysicalDevicePortabilitySubsetPropertiesKHR
_ = 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 :: Ptr PhysicalDevicePortabilitySubsetPropertiesKHR
ptr poked :: 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 :: 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 :: 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"