{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.PhysicalDevice.Struct where

import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Storable
import Foreign.Storable.PeekPoke

import Data.Default
import System.IO.Unsafe

import Gpu.Vulkan.PhysicalDevice.Struct.Th
import qualified Gpu.Vulkan.PhysicalDevice.Core as C
import qualified Gpu.Vulkan.PhysicalDevice.Struct.Core as C

import Gpu.Vulkan.PhysicalDevice.Struct.ThTest

import Gpu.Vulkan.Enum
import Gpu.Vulkan.PNext.Middle.Internal

import Data.TypeLevel.Maybe qualified as TMaybe

Int -> Limits -> ShowS
[Limits] -> ShowS
Limits -> Limits
Limits -> Bool
Limits -> Float
Limits -> Int32
Limits -> String
Limits -> Word32
Limits -> Limits
Limits -> LengthL 2 Float
Limits -> LengthL 2 Word32
Limits -> LengthL 3 Word32
Limits -> Size
Limits -> Size
Limits -> CountFlags
(Int -> Limits -> ShowS)
-> (Limits -> String) -> ([Limits] -> ShowS) -> Show Limits
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Limits -> ShowS
showsPrec :: Int -> Limits -> ShowS
$cshow :: Limits -> String
show :: Limits -> String
$cshowList :: [Limits] -> ShowS
showList :: [Limits] -> ShowS
limitsNonCoherentAtomSize :: Limits -> Size
limitsOptimalBufferCopyRowPitchAlignment :: Limits -> Size
limitsOptimalBufferCopyOffsetAlignment :: Limits -> Size
limitsStandardSampleLocations :: Limits -> Bool
limitsStrictLines :: Limits -> Bool
limitsLineWidthGranularity :: Limits -> Float
limitsPointSizeGranularity :: Limits -> Float
limitsLineWidthRange :: Limits -> LengthL 2 Float
limitsPointSizeRange :: Limits -> LengthL 2 Float
limitsDiscreteQueuePriorities :: Limits -> Word32
limitsMaxCombinedClipAndCullDistances :: Limits -> Word32
limitsMaxCullDistances :: Limits -> Word32
limitsMaxClipDistances :: Limits -> Word32
limitsTimestampPeriod :: Limits -> Float
limitsTimestampComputeAndGraphics :: Limits -> Bool
limitsMaxSampleMaskWords :: Limits -> Word32
limitsStorageImageSampleCounts :: Limits -> CountFlags
limitsSampledImageStencilSampleCounts :: Limits -> CountFlags
limitsSampledImageDepthSampleCounts :: Limits -> CountFlags
limitsSampledImageIntegerSampleCounts :: Limits -> CountFlags
limitsSampledImageColorSampleCounts :: Limits -> CountFlags
limitsMaxColorAttachments :: Limits -> Word32
limitsFramebufferNoAttachmentsSampleCounts :: Limits -> CountFlags
limitsFramebufferStencilSampleCounts :: Limits -> CountFlags
limitsFramebufferDepthSampleCounts :: Limits -> CountFlags
limitsFramebufferColorSampleCounts :: Limits -> CountFlags
limitsMaxFramebufferLayers :: Limits -> Word32
limitsMaxFramebufferHeight :: Limits -> Word32
limitsMaxFramebufferWidth :: Limits -> Word32
limitsSubPixelInterpolationOffsetBits :: Limits -> Word32
limitsMaxInterpolationOffset :: Limits -> Float
limitsMinInterpolationOffset :: Limits -> Float
limitsMaxTexelGatherOffset :: Limits -> Word32
limitsMinTexelGatherOffset :: Limits -> Int32
limitsMaxTexelOffset :: Limits -> Word32
limitsMinTexelOffset :: Limits -> Int32
limitsMinStorageBufferOffsetAlignment :: Limits -> Size
limitsMinUniformBufferOffsetAlignment :: Limits -> Size
limitsMinTexelBufferOffsetAlignment :: Limits -> Size
limitsMinMemoryMapAlignment :: Limits -> Size
limitsViewportSubPixelBits :: Limits -> Word32
limitsViewportBoundsRange :: Limits -> LengthL 2 Float
limitsMaxViewportDimensions :: Limits -> LengthL 2 Word32
limitsMaxViewports :: Limits -> Word32
limitsMaxSamplerAnisotropy :: Limits -> Float
limitsMaxSamplerLodBias :: Limits -> Float
limitsMaxDrawIndirectCount :: Limits -> Word32
limitsMaxDrawIndexedIndexValue :: Limits -> Word32
limitsMipmapPrecisionBits :: Limits -> Word32
limitsSubTexelPrecisionBits :: Limits -> Word32
limitsSubPixelPrecisionBits :: Limits -> Word32
limitsMaxComputeWorkGroupSize :: Limits -> LengthL 3 Word32
limitsMaxComputeWorkGroupInvocations :: Limits -> Word32
limitsMaxComputeWorkGroupCount :: Limits -> LengthL 3 Word32
limitsMaxComputeSharedMemorySize :: Limits -> Word32
limitsMaxFragmentCombinedOutputResources :: Limits -> Word32
limitsMaxFragmentDualSrcAttachments :: Limits -> Word32
limitsMaxFragmentOutputAttachments :: Limits -> Word32
limitsMaxFragmentInputComponents :: Limits -> Word32
limitsMaxGeometryTotalOutputComponents :: Limits -> Word32
limitsMaxGeometryOutputVertices :: Limits -> Word32
limitsMaxGeometryOutputComponents :: Limits -> Word32
limitsMaxGeometryInputComponents :: Limits -> Word32
limitsMaxGeometryShaderInvocations :: Limits -> Word32
limitsMaxTessellationEvaluationOutputComponents :: Limits -> Word32
limitsMaxTessellationEvaluationInputComponents :: Limits -> Word32
limitsMaxTessellationControlTotalOutputComponents :: Limits -> Word32
limitsMaxTessellationControlPerPatchOutputComponents :: Limits -> Word32
limitsMaxTessellationControlPerVertexOutputComponents :: Limits -> Word32
limitsMaxTessellationControlPerVertexInputComponents :: Limits -> Word32
limitsMaxTessellationPatchSize :: Limits -> Word32
limitsMaxTessellationGenerationLevel :: Limits -> Word32
limitsMaxVertexOutputComponents :: Limits -> Word32
limitsMaxVertexInputBindingStride :: Limits -> Word32
limitsMaxVertexInputAttributeOffset :: Limits -> Word32
limitsMaxVertexInputBindings :: Limits -> Word32
limitsMaxVertexInputAttributes :: Limits -> Word32
limitsMaxDescriptorSetInputAttachments :: Limits -> Word32
limitsMaxDescriptorSetStorageImages :: Limits -> Word32
limitsMaxDescriptorSetSampledImages :: Limits -> Word32
limitsMaxDescriptorSetStorageBuffersDynamic :: Limits -> Word32
limitsMaxDescriptorSetStorageBuffers :: Limits -> Word32
limitsMaxDescriptorSetUniformBuffersDynamic :: Limits -> Word32
limitsMaxDescriptorSetUniformBuffers :: Limits -> Word32
limitsMaxDescriptorSetSamplers :: Limits -> Word32
limitsMaxPerStageResources :: Limits -> Word32
limitsMaxPerStageDescriptorInputAttachments :: Limits -> Word32
limitsMaxPerStageDescriptorStorageImages :: Limits -> Word32
limitsMaxPerStageDescriptorSampledImages :: Limits -> Word32
limitsMaxPerStageDescriptorStorageBuffers :: Limits -> Word32
limitsMaxPerStageDescriptorUniformBuffers :: Limits -> Word32
limitsMaxPerStageDescriptorSamplers :: Limits -> Word32
limitsMaxBoundDescriptorSets :: Limits -> Word32
limitsSparseAddressSpaceSize :: Limits -> Size
limitsBufferImageGranularity :: Limits -> Size
limitsMaxSamplerAllocationCount :: Limits -> Word32
limitsMaxMemoryAllocationCount :: Limits -> Word32
limitsMaxPushConstantsSize :: Limits -> Word32
limitsMaxStorageBufferRange :: Limits -> Word32
limitsMaxUniformBufferRange :: Limits -> Word32
limitsMaxTexelBufferElements :: Limits -> Word32
limitsMaxImageArrayLayers :: Limits -> Word32
limitsMaxImageDimensionCube :: Limits -> Word32
limitsMaxImageDimension3D :: Limits -> Word32
limitsMaxImageDimension2D :: Limits -> Word32
limitsMaxImageDimension1D :: Limits -> Word32
limitsFromCore :: Limits -> Limits
limitsToCore :: Limits -> Limits
vkPhysicalDeviceLimits
Int -> Features -> ShowS
[Features] -> ShowS
Features -> Features
Features -> Bool
Features -> String
Features -> Features
(Int -> Features -> ShowS)
-> (Features -> String) -> ([Features] -> ShowS) -> Show Features
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Features -> ShowS
showsPrec :: Int -> Features -> ShowS
$cshow :: Features -> String
show :: Features -> String
$cshowList :: [Features] -> ShowS
showList :: [Features] -> ShowS
featuresInheritedQueries :: Features -> Bool
featuresVariableMultisampleRate :: Features -> Bool
featuresSparseResidencyAliased :: Features -> Bool
featuresSparseResidency16Samples :: Features -> Bool
featuresSparseResidency8Samples :: Features -> Bool
featuresSparseResidency4Samples :: Features -> Bool
featuresSparseResidency2Samples :: Features -> Bool
featuresSparseResidencyImage3D :: Features -> Bool
featuresSparseResidencyImage2D :: Features -> Bool
featuresSparseResidencyBuffer :: Features -> Bool
featuresSparseBinding :: Features -> Bool
featuresShaderResourceMinLod :: Features -> Bool
featuresShaderResourceResidency :: Features -> Bool
featuresShaderInt16 :: Features -> Bool
featuresShaderInt64 :: Features -> Bool
featuresShaderFloat64 :: Features -> Bool
featuresShaderCullDistance :: Features -> Bool
featuresShaderClipDistance :: Features -> Bool
featuresShaderStorageImageArrayDynamicIndexing :: Features -> Bool
featuresShaderStorageBufferArrayDynamicIndexing :: Features -> Bool
featuresShaderSampledImageArrayDynamicIndexing :: Features -> Bool
featuresShaderUniformBufferArrayDynamicIndexing :: Features -> Bool
featuresShaderStorageImageWriteWithoutFormat :: Features -> Bool
featuresShaderStorageImageReadWithoutFormat :: Features -> Bool
featuresShaderStorageImageMultisample :: Features -> Bool
featuresShaderStorageImageExtendedFormats :: Features -> Bool
featuresShaderImageGatherExtended :: Features -> Bool
featuresShaderTessellationAndGeometryPointSize :: Features -> Bool
featuresFragmentStoresAndAtomics :: Features -> Bool
featuresVertexPipelineStoresAndAtomics :: Features -> Bool
featuresPipelineStatisticsQuery :: Features -> Bool
featuresOcclusionQueryPrecise :: Features -> Bool
featuresTextureCompressionBC :: Features -> Bool
featuresTextureCompressionASTC_LDR :: Features -> Bool
featuresTextureCompressionETC2 :: Features -> Bool
featuresSamplerAnisotropy :: Features -> Bool
featuresMultiViewport :: Features -> Bool
featuresAlphaToOne :: Features -> Bool
featuresLargePoints :: Features -> Bool
featuresWideLines :: Features -> Bool
featuresDepthBounds :: Features -> Bool
featuresFillModeNonSolid :: Features -> Bool
featuresDepthBiasClamp :: Features -> Bool
featuresDepthClamp :: Features -> Bool
featuresDrawIndirectFirstInstance :: Features -> Bool
featuresMultiDrawIndirect :: Features -> Bool
featuresLogicOp :: Features -> Bool
featuresDualSrcBlend :: Features -> Bool
featuresSampleRateShading :: Features -> Bool
featuresTessellationShader :: Features -> Bool
featuresGeometryShader :: Features -> Bool
featuresIndependentBlend :: Features -> Bool
featuresImageCubeArray :: Features -> Bool
featuresFullDrawIndexUint32 :: Features -> Bool
featuresRobustBufferAccess :: Features -> Bool
featuresFromCore :: Features -> Features
featuresToCore :: Features -> Features
vkPhysicalDeviceFeatures

featuresZero :: Features
featuresZero :: Features
featuresZero = IO Features -> Features
forall a. IO a -> a
unsafePerformIO (IO Features -> Features) -> IO Features -> Features
forall a b. (a -> b) -> a -> b
$ Features -> Features
featuresFromCore (Features -> Features) -> IO Features -> IO Features
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Features
C.getClearedFeatures

instance Default Features where def :: Features
def = Features
featuresZero

makeStructure "DescriptorIndexingFeatures"

instance Peek DescriptorIndexingFeaturesNoNext where
	peek' :: Ptr DescriptorIndexingFeaturesNoNext
-> IO DescriptorIndexingFeaturesNoNext
peek' = (DescriptorIndexingFeatures -> DescriptorIndexingFeaturesNoNext
descriptorIndexingFeaturesFromCore (DescriptorIndexingFeatures -> DescriptorIndexingFeaturesNoNext)
-> IO DescriptorIndexingFeatures
-> IO DescriptorIndexingFeaturesNoNext
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO DescriptorIndexingFeatures
 -> IO DescriptorIndexingFeaturesNoNext)
-> (Ptr DescriptorIndexingFeaturesNoNext
    -> IO DescriptorIndexingFeatures)
-> Ptr DescriptorIndexingFeaturesNoNext
-> IO DescriptorIndexingFeaturesNoNext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr DescriptorIndexingFeatures -> IO DescriptorIndexingFeatures
forall a. Storable a => Ptr a -> IO a
peek (Ptr DescriptorIndexingFeatures -> IO DescriptorIndexingFeatures)
-> (Ptr DescriptorIndexingFeaturesNoNext
    -> Ptr DescriptorIndexingFeatures)
-> Ptr DescriptorIndexingFeaturesNoNext
-> IO DescriptorIndexingFeatures
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr DescriptorIndexingFeaturesNoNext
-> Ptr DescriptorIndexingFeatures
forall a b. Ptr a -> Ptr b
castPtr

instance Typeable DescriptorIndexingFeaturesNoNext where
	structureType :: StructureType
structureType = StructureType
StructureTypePhysicalDeviceDescriptorIndexingFeatures

instance Sizable DescriptorIndexingFeaturesNoNext where
	sizeOf' :: Int
sizeOf' = forall a. Storable a => a -> Int
sizeOf @C.DescriptorIndexingFeatures DescriptorIndexingFeatures
forall a. HasCallStack => a
undefined
	alignment' :: Int
alignment' = forall a. Storable a => a -> Int
alignment @C.DescriptorIndexingFeatures DescriptorIndexingFeatures
forall a. HasCallStack => a
undefined

instance WithPoked (TMaybe.M mn) => WithPoked (DescriptorIndexingFeatures mn) where
	withPoked' :: forall b.
DescriptorIndexingFeatures mn
-> (forall s. PtrS s (DescriptorIndexingFeatures mn) -> IO b)
-> IO b
withPoked' DescriptorIndexingFeatures mn
difs forall s. PtrS s (DescriptorIndexingFeatures mn) -> IO b
f = (Ptr DescriptorIndexingFeatures -> IO b) -> IO b
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr DescriptorIndexingFeatures
pcdifs -> do
		DescriptorIndexingFeatures mn
-> (DescriptorIndexingFeatures -> IO ()) -> IO ()
forall (mn :: Maybe (*)).
WithPoked (M mn) =>
DescriptorIndexingFeatures mn
-> (DescriptorIndexingFeatures -> IO ()) -> IO ()
descriptorIndexingFeaturesToCore DescriptorIndexingFeatures mn
difs ((DescriptorIndexingFeatures -> IO ()) -> IO ())
-> (DescriptorIndexingFeatures -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \DescriptorIndexingFeatures
cdifs -> Ptr DescriptorIndexingFeatures
-> DescriptorIndexingFeatures -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr DescriptorIndexingFeatures
pcdifs DescriptorIndexingFeatures
cdifs
		PtrS Any (DescriptorIndexingFeatures mn) -> IO b
forall s. PtrS s (DescriptorIndexingFeatures mn) -> IO b
f (PtrS Any (DescriptorIndexingFeatures mn) -> IO b)
-> (Ptr (DescriptorIndexingFeatures mn)
    -> PtrS Any (DescriptorIndexingFeatures mn))
-> Ptr (DescriptorIndexingFeatures mn)
-> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (DescriptorIndexingFeatures mn)
-> PtrS Any (DescriptorIndexingFeatures mn)
forall a s. Ptr a -> PtrS s a
ptrS (Ptr (DescriptorIndexingFeatures mn) -> IO b)
-> Ptr (DescriptorIndexingFeatures mn) -> IO b
forall a b. (a -> b) -> a -> b
$ Ptr DescriptorIndexingFeatures
-> Ptr (DescriptorIndexingFeatures mn)
forall a b. Ptr a -> Ptr b
castPtr Ptr DescriptorIndexingFeatures
pcdifs

instance Nextable DescriptorIndexingFeatures where
	nextableSize :: Int
nextableSize = forall a. Storable a => a -> Int
sizeOf @C.DescriptorIndexingFeatures DescriptorIndexingFeatures
forall a. HasCallStack => a
undefined
	nextableType :: StructureType
nextableType = StructureType
StructureTypePhysicalDeviceDescriptorIndexingFeatures
	nextPtr :: Ptr () -> IO (Ptr ())
nextPtr Ptr ()
p = DescriptorIndexingFeatures -> Ptr ()
C.descriptorIndexingFeaturesPNext (DescriptorIndexingFeatures -> Ptr ())
-> IO DescriptorIndexingFeatures -> IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr DescriptorIndexingFeatures -> IO DescriptorIndexingFeatures
forall a. Storable a => Ptr a -> IO a
peek (Ptr () -> Ptr DescriptorIndexingFeatures
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
p)
	createNextable :: forall (mn' :: Maybe (*)).
Ptr () -> M mn' -> IO (DescriptorIndexingFeatures mn')
createNextable Ptr ()
p M mn'
n =
		M mn'
-> DescriptorIndexingFeaturesNoNext
-> DescriptorIndexingFeatures mn'
forall (mn :: Maybe (*)).
M mn
-> DescriptorIndexingFeaturesNoNext
-> DescriptorIndexingFeatures mn
descriptorIndexingFeaturesFromNoNext M mn'
n (DescriptorIndexingFeaturesNoNext
 -> DescriptorIndexingFeatures mn')
-> (DescriptorIndexingFeatures -> DescriptorIndexingFeaturesNoNext)
-> DescriptorIndexingFeatures
-> DescriptorIndexingFeatures mn'
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		DescriptorIndexingFeatures -> DescriptorIndexingFeaturesNoNext
descriptorIndexingFeaturesFromCore (DescriptorIndexingFeatures -> DescriptorIndexingFeatures mn')
-> IO DescriptorIndexingFeatures
-> IO (DescriptorIndexingFeatures mn')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr DescriptorIndexingFeatures -> IO DescriptorIndexingFeatures
forall a. Storable a => Ptr a -> IO a
peek (Ptr () -> Ptr DescriptorIndexingFeatures
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
p)

descriptorIndexingFeaturesZero :: TMaybe.M mn -> DescriptorIndexingFeatures mn
descriptorIndexingFeaturesZero :: forall (mn :: Maybe (*)). M mn -> DescriptorIndexingFeatures mn
descriptorIndexingFeaturesZero M mn
mn = IO (DescriptorIndexingFeatures mn) -> DescriptorIndexingFeatures mn
forall a. IO a -> a
unsafePerformIO
	(IO (DescriptorIndexingFeatures mn)
 -> DescriptorIndexingFeatures mn)
-> IO (DescriptorIndexingFeatures mn)
-> DescriptorIndexingFeatures mn
forall a b. (a -> b) -> a -> b
$ M mn
-> DescriptorIndexingFeaturesNoNext
-> DescriptorIndexingFeatures mn
forall (mn :: Maybe (*)).
M mn
-> DescriptorIndexingFeaturesNoNext
-> DescriptorIndexingFeatures mn
descriptorIndexingFeaturesFromNoNext M mn
mn
	(DescriptorIndexingFeaturesNoNext -> DescriptorIndexingFeatures mn)
-> (DescriptorIndexingFeatures -> DescriptorIndexingFeaturesNoNext)
-> DescriptorIndexingFeatures
-> DescriptorIndexingFeatures mn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DescriptorIndexingFeatures -> DescriptorIndexingFeaturesNoNext
descriptorIndexingFeaturesFromCore
	(DescriptorIndexingFeatures -> DescriptorIndexingFeatures mn)
-> IO DescriptorIndexingFeatures
-> IO (DescriptorIndexingFeatures mn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO DescriptorIndexingFeatures
C.getClearedDescriptorIndexingFeatures

makeStructure "Vulkan12Features"

instance Peek Vulkan12FeaturesNoNext where
	peek' :: Ptr Vulkan12FeaturesNoNext -> IO Vulkan12FeaturesNoNext
peek' = (Vulkan12Features -> Vulkan12FeaturesNoNext
vulkan12FeaturesFromCore (Vulkan12Features -> Vulkan12FeaturesNoNext)
-> IO Vulkan12Features -> IO Vulkan12FeaturesNoNext
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO Vulkan12Features -> IO Vulkan12FeaturesNoNext)
-> (Ptr Vulkan12FeaturesNoNext -> IO Vulkan12Features)
-> Ptr Vulkan12FeaturesNoNext
-> IO Vulkan12FeaturesNoNext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vulkan12Features -> IO Vulkan12Features
forall a. Storable a => Ptr a -> IO a
peek (Ptr Vulkan12Features -> IO Vulkan12Features)
-> (Ptr Vulkan12FeaturesNoNext -> Ptr Vulkan12Features)
-> Ptr Vulkan12FeaturesNoNext
-> IO Vulkan12Features
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vulkan12FeaturesNoNext -> Ptr Vulkan12Features
forall a b. Ptr a -> Ptr b
castPtr

instance Typeable Vulkan12FeaturesNoNext where
	structureType :: StructureType
structureType = StructureType
StructureTypePhysicalDeviceVulkan12Features

instance Sizable Vulkan12FeaturesNoNext where
	sizeOf' :: Int
sizeOf' = forall a. Storable a => a -> Int
sizeOf @C.Vulkan12Features Vulkan12Features
forall a. HasCallStack => a
undefined
	alignment' :: Int
alignment' = forall a. Storable a => a -> Int
alignment @C.Vulkan12Features Vulkan12Features
forall a. HasCallStack => a
undefined

instance WithPoked (TMaybe.M mn) => WithPoked (Vulkan12Features mn) where
	withPoked' :: forall b.
Vulkan12Features mn
-> (forall s. PtrS s (Vulkan12Features mn) -> IO b) -> IO b
withPoked' Vulkan12Features mn
v12fs forall s. PtrS s (Vulkan12Features mn) -> IO b
f = (Ptr Vulkan12Features -> IO b) -> IO b
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr Vulkan12Features
pv12fs -> do
		Vulkan12Features mn -> (Vulkan12Features -> IO ()) -> IO ()
forall (mn :: Maybe (*)).
WithPoked (M mn) =>
Vulkan12Features mn -> (Vulkan12Features -> IO ()) -> IO ()
vulkan12FeaturesToCore Vulkan12Features mn
v12fs ((Vulkan12Features -> IO ()) -> IO ())
-> (Vulkan12Features -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Vulkan12Features
cv12fs -> Ptr Vulkan12Features -> Vulkan12Features -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Vulkan12Features
pv12fs Vulkan12Features
cv12fs
		PtrS Any (Vulkan12Features mn) -> IO b
forall s. PtrS s (Vulkan12Features mn) -> IO b
f (PtrS Any (Vulkan12Features mn) -> IO b)
-> (Ptr (Vulkan12Features mn) -> PtrS Any (Vulkan12Features mn))
-> Ptr (Vulkan12Features mn)
-> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (Vulkan12Features mn) -> PtrS Any (Vulkan12Features mn)
forall a s. Ptr a -> PtrS s a
ptrS (Ptr (Vulkan12Features mn) -> IO b)
-> Ptr (Vulkan12Features mn) -> IO b
forall a b. (a -> b) -> a -> b
$ Ptr Vulkan12Features -> Ptr (Vulkan12Features mn)
forall a b. Ptr a -> Ptr b
castPtr Ptr Vulkan12Features
pv12fs

instance Nextable Vulkan12Features where
	nextableSize :: Int
nextableSize = forall a. Storable a => a -> Int
sizeOf @C.Vulkan12Features Vulkan12Features
forall a. HasCallStack => a
undefined
	nextableType :: StructureType
nextableType = StructureType
StructureTypePhysicalDeviceVulkan12Features
	nextPtr :: Ptr () -> IO (Ptr ())
nextPtr Ptr ()
p = Vulkan12Features -> Ptr ()
C.vulkan12FeaturesPNext (Vulkan12Features -> Ptr ()) -> IO Vulkan12Features -> IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Vulkan12Features -> IO Vulkan12Features
forall a. Storable a => Ptr a -> IO a
peek (Ptr () -> Ptr Vulkan12Features
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
p)
	createNextable :: forall (mn' :: Maybe (*)).
Ptr () -> M mn' -> IO (Vulkan12Features mn')
createNextable Ptr ()
p M mn'
n =
		M mn' -> Vulkan12FeaturesNoNext -> Vulkan12Features mn'
forall (mn :: Maybe (*)).
M mn -> Vulkan12FeaturesNoNext -> Vulkan12Features mn
vulkan12FeaturesFromNoNext M mn'
n (Vulkan12FeaturesNoNext -> Vulkan12Features mn')
-> (Vulkan12Features -> Vulkan12FeaturesNoNext)
-> Vulkan12Features
-> Vulkan12Features mn'
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		Vulkan12Features -> Vulkan12FeaturesNoNext
vulkan12FeaturesFromCore (Vulkan12Features -> Vulkan12Features mn')
-> IO Vulkan12Features -> IO (Vulkan12Features mn')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Vulkan12Features -> IO Vulkan12Features
forall a. Storable a => Ptr a -> IO a
peek (Ptr () -> Ptr Vulkan12Features
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
p)

vulkan12FeaturesZero :: TMaybe.M mn -> Vulkan12Features mn
vulkan12FeaturesZero :: forall (mn :: Maybe (*)). M mn -> Vulkan12Features mn
vulkan12FeaturesZero M mn
mn = IO (Vulkan12Features mn) -> Vulkan12Features mn
forall a. IO a -> a
unsafePerformIO (IO (Vulkan12Features mn) -> Vulkan12Features mn)
-> IO (Vulkan12Features mn) -> Vulkan12Features mn
forall a b. (a -> b) -> a -> b
$ M mn -> Vulkan12FeaturesNoNext -> Vulkan12Features mn
forall (mn :: Maybe (*)).
M mn -> Vulkan12FeaturesNoNext -> Vulkan12Features mn
vulkan12FeaturesFromNoNext M mn
mn
	(Vulkan12FeaturesNoNext -> Vulkan12Features mn)
-> (Vulkan12Features -> Vulkan12FeaturesNoNext)
-> Vulkan12Features
-> Vulkan12Features mn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vulkan12Features -> Vulkan12FeaturesNoNext
vulkan12FeaturesFromCore (Vulkan12Features -> Vulkan12Features mn)
-> IO Vulkan12Features -> IO (Vulkan12Features mn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Vulkan12Features
C.getClearedVulkan12Features

makeStructure "Vulkan13Features"

instance Peek Vulkan13FeaturesNoNext where
	peek' :: Ptr Vulkan13FeaturesNoNext -> IO Vulkan13FeaturesNoNext
peek' = (Vulkan13Features -> Vulkan13FeaturesNoNext
vulkan13FeaturesFromCore (Vulkan13Features -> Vulkan13FeaturesNoNext)
-> IO Vulkan13Features -> IO Vulkan13FeaturesNoNext
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO Vulkan13Features -> IO Vulkan13FeaturesNoNext)
-> (Ptr Vulkan13FeaturesNoNext -> IO Vulkan13Features)
-> Ptr Vulkan13FeaturesNoNext
-> IO Vulkan13FeaturesNoNext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vulkan13Features -> IO Vulkan13Features
forall a. Storable a => Ptr a -> IO a
peek (Ptr Vulkan13Features -> IO Vulkan13Features)
-> (Ptr Vulkan13FeaturesNoNext -> Ptr Vulkan13Features)
-> Ptr Vulkan13FeaturesNoNext
-> IO Vulkan13Features
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Vulkan13FeaturesNoNext -> Ptr Vulkan13Features
forall a b. Ptr a -> Ptr b
castPtr

instance Typeable Vulkan13FeaturesNoNext where
	structureType :: StructureType
structureType = StructureType
StructureTypePhysicalDeviceVulkan13Features

instance Sizable Vulkan13FeaturesNoNext where
	sizeOf' :: Int
sizeOf' = forall a. Storable a => a -> Int
sizeOf @C.Vulkan13Features Vulkan13Features
forall a. HasCallStack => a
undefined
	alignment' :: Int
alignment' = forall a. Storable a => a -> Int
alignment @C.Vulkan13Features Vulkan13Features
forall a. HasCallStack => a
undefined

instance WithPoked (TMaybe.M mn) => WithPoked (Vulkan13Features mn) where
	withPoked' :: forall b.
Vulkan13Features mn
-> (forall s. PtrS s (Vulkan13Features mn) -> IO b) -> IO b
withPoked' Vulkan13Features mn
v13fs forall s. PtrS s (Vulkan13Features mn) -> IO b
f = (Ptr Vulkan13Features -> IO b) -> IO b
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr Vulkan13Features
pv13fs -> do
		Vulkan13Features mn -> (Vulkan13Features -> IO ()) -> IO ()
forall (mn :: Maybe (*)).
WithPoked (M mn) =>
Vulkan13Features mn -> (Vulkan13Features -> IO ()) -> IO ()
vulkan13FeaturesToCore Vulkan13Features mn
v13fs ((Vulkan13Features -> IO ()) -> IO ())
-> (Vulkan13Features -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Vulkan13Features
cv13fs -> Ptr Vulkan13Features -> Vulkan13Features -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Vulkan13Features
pv13fs Vulkan13Features
cv13fs
		PtrS Any (Vulkan13Features mn) -> IO b
forall s. PtrS s (Vulkan13Features mn) -> IO b
f (PtrS Any (Vulkan13Features mn) -> IO b)
-> (Ptr (Vulkan13Features mn) -> PtrS Any (Vulkan13Features mn))
-> Ptr (Vulkan13Features mn)
-> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (Vulkan13Features mn) -> PtrS Any (Vulkan13Features mn)
forall a s. Ptr a -> PtrS s a
ptrS (Ptr (Vulkan13Features mn) -> IO b)
-> Ptr (Vulkan13Features mn) -> IO b
forall a b. (a -> b) -> a -> b
$ Ptr Vulkan13Features -> Ptr (Vulkan13Features mn)
forall a b. Ptr a -> Ptr b
castPtr Ptr Vulkan13Features
pv13fs

instance Nextable Vulkan13Features where
	nextableSize :: Int
nextableSize = forall a. Storable a => a -> Int
sizeOf @C.Vulkan13Features Vulkan13Features
forall a. HasCallStack => a
undefined
	nextableType :: StructureType
nextableType = StructureType
StructureTypePhysicalDeviceVulkan13Features
	nextPtr :: Ptr () -> IO (Ptr ())
nextPtr Ptr ()
p = Vulkan13Features -> Ptr ()
C.vulkan13FeaturesPNext (Vulkan13Features -> Ptr ()) -> IO Vulkan13Features -> IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Vulkan13Features -> IO Vulkan13Features
forall a. Storable a => Ptr a -> IO a
peek (Ptr () -> Ptr Vulkan13Features
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
p)
	createNextable :: forall (mn' :: Maybe (*)).
Ptr () -> M mn' -> IO (Vulkan13Features mn')
createNextable Ptr ()
p M mn'
n =
		M mn' -> Vulkan13FeaturesNoNext -> Vulkan13Features mn'
forall (mn :: Maybe (*)).
M mn -> Vulkan13FeaturesNoNext -> Vulkan13Features mn
vulkan13FeaturesFromNoNext M mn'
n (Vulkan13FeaturesNoNext -> Vulkan13Features mn')
-> (Vulkan13Features -> Vulkan13FeaturesNoNext)
-> Vulkan13Features
-> Vulkan13Features mn'
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		Vulkan13Features -> Vulkan13FeaturesNoNext
vulkan13FeaturesFromCore (Vulkan13Features -> Vulkan13Features mn')
-> IO Vulkan13Features -> IO (Vulkan13Features mn')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Vulkan13Features -> IO Vulkan13Features
forall a. Storable a => Ptr a -> IO a
peek (Ptr () -> Ptr Vulkan13Features
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
p)

vulkan13FeaturesZero :: TMaybe.M mn -> Vulkan13Features mn
vulkan13FeaturesZero :: forall (mn :: Maybe (*)). M mn -> Vulkan13Features mn
vulkan13FeaturesZero M mn
mn = IO (Vulkan13Features mn) -> Vulkan13Features mn
forall a. IO a -> a
unsafePerformIO (IO (Vulkan13Features mn) -> Vulkan13Features mn)
-> IO (Vulkan13Features mn) -> Vulkan13Features mn
forall a b. (a -> b) -> a -> b
$ M mn -> Vulkan13FeaturesNoNext -> Vulkan13Features mn
forall (mn :: Maybe (*)).
M mn -> Vulkan13FeaturesNoNext -> Vulkan13Features mn
vulkan13FeaturesFromNoNext M mn
mn
	(Vulkan13FeaturesNoNext -> Vulkan13Features mn)
-> (Vulkan13Features -> Vulkan13FeaturesNoNext)
-> Vulkan13Features
-> Vulkan13Features mn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vulkan13Features -> Vulkan13FeaturesNoNext
vulkan13FeaturesFromCore (Vulkan13Features -> Vulkan13Features mn)
-> IO Vulkan13Features -> IO (Vulkan13Features mn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Vulkan13Features
C.getClearedVulkan13Features