#include "vulkan/vulkan.h" {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE Strict #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} module Graphics.Vulkan.Types.Struct.PhysicalDevice (VkPhysicalDevice16BitStorageFeatures(..), VkPhysicalDevice16BitStorageFeaturesKHR, VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT(..), VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT(..), VkPhysicalDeviceConservativeRasterizationPropertiesEXT(..), VkPhysicalDeviceDescriptorIndexingFeaturesEXT(..), VkPhysicalDeviceDescriptorIndexingPropertiesEXT(..), VkPhysicalDeviceDiscardRectanglePropertiesEXT(..), VkPhysicalDeviceExternalBufferInfo(..), VkPhysicalDeviceExternalBufferInfoKHR, VkPhysicalDeviceExternalFenceInfo(..), VkPhysicalDeviceExternalFenceInfoKHR, VkPhysicalDeviceExternalImageFormatInfo(..), VkPhysicalDeviceExternalImageFormatInfoKHR, VkPhysicalDeviceExternalMemoryHostPropertiesEXT(..), VkPhysicalDeviceExternalSemaphoreInfo(..), VkPhysicalDeviceExternalSemaphoreInfoKHR, VkPhysicalDeviceFeatures2(..), VkPhysicalDeviceFeatures2KHR, VkPhysicalDeviceGroupProperties(..), VkPhysicalDeviceGroupPropertiesKHR, VkPhysicalDeviceIDProperties(..), VkPhysicalDeviceIDPropertiesKHR, VkPhysicalDeviceImageFormatInfo2(..), VkPhysicalDeviceImageFormatInfo2KHR, VkPhysicalDeviceLimits(..), VkPhysicalDeviceMaintenance3Properties(..), VkPhysicalDeviceMaintenance3PropertiesKHR, VkPhysicalDeviceMemoryProperties(..), VkPhysicalDeviceMemoryProperties2(..), VkPhysicalDeviceMemoryProperties2KHR, VkPhysicalDeviceMultiviewFeatures(..), VkPhysicalDeviceMultiviewFeaturesKHR, VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX(..), VkPhysicalDeviceMultiviewProperties(..), VkPhysicalDeviceMultiviewPropertiesKHR, VkPhysicalDevicePointClippingProperties(..), VkPhysicalDevicePointClippingPropertiesKHR, VkPhysicalDeviceProperties(..), VkPhysicalDeviceProperties2(..), VkPhysicalDeviceProperties2KHR, VkPhysicalDeviceProtectedMemoryFeatures(..), VkPhysicalDeviceProtectedMemoryProperties(..), VkPhysicalDevicePushDescriptorPropertiesKHR(..), VkPhysicalDeviceSampleLocationsPropertiesEXT(..), VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT(..), VkPhysicalDeviceSamplerYcbcrConversionFeatures(..), VkPhysicalDeviceSamplerYcbcrConversionFeaturesKHR, VkPhysicalDeviceShaderCorePropertiesAMD(..), VkPhysicalDeviceShaderDrawParameterFeatures(..), VkPhysicalDeviceSparseImageFormatInfo2(..), VkPhysicalDeviceSparseImageFormatInfo2KHR, VkPhysicalDeviceSparseProperties(..), VkPhysicalDeviceSubgroupProperties(..), VkPhysicalDeviceSurfaceInfo2KHR(..), VkPhysicalDeviceVariablePointerFeatures(..), VkPhysicalDeviceVariablePointerFeaturesKHR, VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT(..)) where import Foreign.Storable (Storable (..)) import GHC.Base (Addr##, ByteArray##, Proxy##, byteArrayContents##, plusAddr##, proxy##) import GHC.TypeLits (KnownNat, natVal') -- ' closing tick for hsc2hs import Graphics.Vulkan.Constants (VK_LUID_SIZE, pattern VK_LUID_SIZE, VK_MAX_DEVICE_GROUP_SIZE, pattern VK_MAX_DEVICE_GROUP_SIZE, VK_MAX_MEMORY_HEAPS, pattern VK_MAX_MEMORY_HEAPS, VK_MAX_MEMORY_TYPES, pattern VK_MAX_MEMORY_TYPES, VK_MAX_PHYSICAL_DEVICE_NAME_SIZE, pattern VK_MAX_PHYSICAL_DEVICE_NAME_SIZE, VK_UUID_SIZE, pattern VK_UUID_SIZE) import Graphics.Vulkan.Marshal import Graphics.Vulkan.Marshal.Internal import Graphics.Vulkan.Types.BaseTypes (VkBool32, VkDeviceSize) import Graphics.Vulkan.Types.Enum.Buffer (VkBufferCreateFlags, VkBufferUsageFlags) import Graphics.Vulkan.Types.Enum.External (VkExternalFenceHandleTypeFlagBits, VkExternalMemoryHandleTypeFlagBits, VkExternalSemaphoreHandleTypeFlagBits) import Graphics.Vulkan.Types.Enum.Format (VkFormat) import Graphics.Vulkan.Types.Enum.Image (VkImageCreateFlags, VkImageTiling, VkImageType, VkImageUsageFlags) import Graphics.Vulkan.Types.Enum.PhysicalDeviceType (VkPhysicalDeviceType) import Graphics.Vulkan.Types.Enum.PointClippingBehavior (VkPointClippingBehavior) import Graphics.Vulkan.Types.Enum.SampleCountFlags (VkSampleCountFlagBits, VkSampleCountFlags) import Graphics.Vulkan.Types.Enum.Shader (VkShaderStageFlags) import Graphics.Vulkan.Types.Enum.StructureType (VkStructureType) import Graphics.Vulkan.Types.Enum.SubgroupFeatureFlags (VkSubgroupFeatureFlags) import Graphics.Vulkan.Types.Handles (VkPhysicalDevice, VkSurfaceKHR) import Graphics.Vulkan.Types.Struct.Device (VkDeviceCreateInfo) import Graphics.Vulkan.Types.Struct.Extent (VkExtent2D) import Graphics.Vulkan.Types.Struct.Memory (VkMemoryHeap, VkMemoryType) import Graphics.Vulkan.Types.Struct.PhysicalDeviceFeatures (VkPhysicalDeviceFeatures) import System.IO.Unsafe (unsafeDupablePerformIO) -- | > typedef struct VkPhysicalDevice16BitStorageFeatures { -- > VkStructureType sType; -- > void* pNext; -- > VkBool32 storageBuffer16BitAccess; -- > VkBool32 uniformAndStorageBuffer16BitAccess; -- > VkBool32 storagePushConstant16; -- > VkBool32 storageInputOutput16; -- > } VkPhysicalDevice16BitStorageFeatures; -- -- data VkPhysicalDevice16BitStorageFeatures = VkPhysicalDevice16BitStorageFeatures## Addr## ByteArray## instance Eq VkPhysicalDevice16BitStorageFeatures where (VkPhysicalDevice16BitStorageFeatures## a _) == x@(VkPhysicalDevice16BitStorageFeatures## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDevice16BitStorageFeatures where (VkPhysicalDevice16BitStorageFeatures## a _) `compare` x@(VkPhysicalDevice16BitStorageFeatures## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDevice16BitStorageFeatures where sizeOf ~_ = #{size VkPhysicalDevice16BitStorageFeatures} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDevice16BitStorageFeatures} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDevice16BitStorageFeatures where unsafeAddr (VkPhysicalDevice16BitStorageFeatures## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDevice16BitStorageFeatures## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDevice16BitStorageFeatures## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDevice16BitStorageFeatures where type StructFields VkPhysicalDevice16BitStorageFeatures = '["sType", "pNext", "storageBuffer16BitAccess", -- ' closing tick for hsc2hs "uniformAndStorageBuffer16BitAccess", "storagePushConstant16", "storageInputOutput16"] type CUnionType VkPhysicalDevice16BitStorageFeatures = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDevice16BitStorageFeatures = 'False -- ' closing tick for hsc2hs type StructExtends VkPhysicalDevice16BitStorageFeatures = '[VkPhysicalDeviceFeatures2, VkDeviceCreateInfo] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDevice16BitStorageFeatures where type FieldType "sType" VkPhysicalDevice16BitStorageFeatures = VkStructureType type FieldOptional "sType" VkPhysicalDevice16BitStorageFeatures = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDevice16BitStorageFeatures = #{offset VkPhysicalDevice16BitStorageFeatures, sType} type FieldIsArray "sType" VkPhysicalDevice16BitStorageFeatures = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDevice16BitStorageFeatures, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDevice16BitStorageFeatures where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDevice16BitStorageFeatures, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDevice16BitStorageFeatures, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDevice16BitStorageFeatures where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDevice16BitStorageFeatures, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDevice16BitStorageFeatures where type FieldType "pNext" VkPhysicalDevice16BitStorageFeatures = Ptr Void type FieldOptional "pNext" VkPhysicalDevice16BitStorageFeatures = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDevice16BitStorageFeatures = #{offset VkPhysicalDevice16BitStorageFeatures, pNext} type FieldIsArray "pNext" VkPhysicalDevice16BitStorageFeatures = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDevice16BitStorageFeatures, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDevice16BitStorageFeatures where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDevice16BitStorageFeatures, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDevice16BitStorageFeatures, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDevice16BitStorageFeatures where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDevice16BitStorageFeatures, pNext} instance {-# OVERLAPPING #-} HasField "storageBuffer16BitAccess" VkPhysicalDevice16BitStorageFeatures where type FieldType "storageBuffer16BitAccess" VkPhysicalDevice16BitStorageFeatures = VkBool32 type FieldOptional "storageBuffer16BitAccess" VkPhysicalDevice16BitStorageFeatures = 'False -- ' closing tick for hsc2hs type FieldOffset "storageBuffer16BitAccess" VkPhysicalDevice16BitStorageFeatures = #{offset VkPhysicalDevice16BitStorageFeatures, storageBuffer16BitAccess} type FieldIsArray "storageBuffer16BitAccess" VkPhysicalDevice16BitStorageFeatures = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDevice16BitStorageFeatures, storageBuffer16BitAccess} instance {-# OVERLAPPING #-} CanReadField "storageBuffer16BitAccess" VkPhysicalDevice16BitStorageFeatures where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDevice16BitStorageFeatures, storageBuffer16BitAccess}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDevice16BitStorageFeatures, storageBuffer16BitAccess} instance {-# OVERLAPPING #-} CanWriteField "storageBuffer16BitAccess" VkPhysicalDevice16BitStorageFeatures where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDevice16BitStorageFeatures, storageBuffer16BitAccess} instance {-# OVERLAPPING #-} HasField "uniformAndStorageBuffer16BitAccess" VkPhysicalDevice16BitStorageFeatures where type FieldType "uniformAndStorageBuffer16BitAccess" VkPhysicalDevice16BitStorageFeatures = VkBool32 type FieldOptional "uniformAndStorageBuffer16BitAccess" VkPhysicalDevice16BitStorageFeatures = 'False -- ' closing tick for hsc2hs type FieldOffset "uniformAndStorageBuffer16BitAccess" VkPhysicalDevice16BitStorageFeatures = #{offset VkPhysicalDevice16BitStorageFeatures, uniformAndStorageBuffer16BitAccess} type FieldIsArray "uniformAndStorageBuffer16BitAccess" VkPhysicalDevice16BitStorageFeatures = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDevice16BitStorageFeatures, uniformAndStorageBuffer16BitAccess} instance {-# OVERLAPPING #-} CanReadField "uniformAndStorageBuffer16BitAccess" VkPhysicalDevice16BitStorageFeatures where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDevice16BitStorageFeatures, uniformAndStorageBuffer16BitAccess}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDevice16BitStorageFeatures, uniformAndStorageBuffer16BitAccess} instance {-# OVERLAPPING #-} CanWriteField "uniformAndStorageBuffer16BitAccess" VkPhysicalDevice16BitStorageFeatures where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDevice16BitStorageFeatures, uniformAndStorageBuffer16BitAccess} instance {-# OVERLAPPING #-} HasField "storagePushConstant16" VkPhysicalDevice16BitStorageFeatures where type FieldType "storagePushConstant16" VkPhysicalDevice16BitStorageFeatures = VkBool32 type FieldOptional "storagePushConstant16" VkPhysicalDevice16BitStorageFeatures = 'False -- ' closing tick for hsc2hs type FieldOffset "storagePushConstant16" VkPhysicalDevice16BitStorageFeatures = #{offset VkPhysicalDevice16BitStorageFeatures, storagePushConstant16} type FieldIsArray "storagePushConstant16" VkPhysicalDevice16BitStorageFeatures = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDevice16BitStorageFeatures, storagePushConstant16} instance {-# OVERLAPPING #-} CanReadField "storagePushConstant16" VkPhysicalDevice16BitStorageFeatures where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDevice16BitStorageFeatures, storagePushConstant16}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDevice16BitStorageFeatures, storagePushConstant16} instance {-# OVERLAPPING #-} CanWriteField "storagePushConstant16" VkPhysicalDevice16BitStorageFeatures where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDevice16BitStorageFeatures, storagePushConstant16} instance {-# OVERLAPPING #-} HasField "storageInputOutput16" VkPhysicalDevice16BitStorageFeatures where type FieldType "storageInputOutput16" VkPhysicalDevice16BitStorageFeatures = VkBool32 type FieldOptional "storageInputOutput16" VkPhysicalDevice16BitStorageFeatures = 'False -- ' closing tick for hsc2hs type FieldOffset "storageInputOutput16" VkPhysicalDevice16BitStorageFeatures = #{offset VkPhysicalDevice16BitStorageFeatures, storageInputOutput16} type FieldIsArray "storageInputOutput16" VkPhysicalDevice16BitStorageFeatures = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDevice16BitStorageFeatures, storageInputOutput16} instance {-# OVERLAPPING #-} CanReadField "storageInputOutput16" VkPhysicalDevice16BitStorageFeatures where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDevice16BitStorageFeatures, storageInputOutput16}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDevice16BitStorageFeatures, storageInputOutput16} instance {-# OVERLAPPING #-} CanWriteField "storageInputOutput16" VkPhysicalDevice16BitStorageFeatures where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDevice16BitStorageFeatures, storageInputOutput16} instance Show VkPhysicalDevice16BitStorageFeatures where showsPrec d x = showString "VkPhysicalDevice16BitStorageFeatures {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "storageBuffer16BitAccess = " . showsPrec d (getField @"storageBuffer16BitAccess" x) . showString ", " . showString "uniformAndStorageBuffer16BitAccess = " . showsPrec d (getField @"uniformAndStorageBuffer16BitAccess" x) . showString ", " . showString "storagePushConstant16 = " . showsPrec d (getField @"storagePushConstant16" x) . showString ", " . showString "storageInputOutput16 = " . showsPrec d (getField @"storageInputOutput16" x) . showChar '}' -- | Alias for `VkPhysicalDevice16BitStorageFeatures` type VkPhysicalDevice16BitStorageFeaturesKHR = VkPhysicalDevice16BitStorageFeatures -- | > typedef struct VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT { -- > VkStructureType sType; -- > void* pNext; -- > VkBool32 advancedBlendCoherentOperations; -- > } VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT; -- -- data VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT = VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT## Addr## ByteArray## instance Eq VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT where (VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT## a _) == x@(VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT where (VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT## a _) `compare` x@(VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT where sizeOf ~_ = #{size VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT where unsafeAddr (VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT where type StructFields VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT = '["sType", "pNext", "advancedBlendCoherentOperations"] -- ' closing tick for hsc2hs type CUnionType VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT = 'False -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT = '[VkPhysicalDeviceFeatures2] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT where type FieldType "sType" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT = VkStructureType type FieldOptional "sType" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT = #{offset VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT, sType} type FieldIsArray "sType" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT where type FieldType "pNext" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT = #{offset VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT, pNext} type FieldIsArray "pNext" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT, pNext} instance {-# OVERLAPPING #-} HasField "advancedBlendCoherentOperations" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT where type FieldType "advancedBlendCoherentOperations" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT = VkBool32 type FieldOptional "advancedBlendCoherentOperations" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "advancedBlendCoherentOperations" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT = #{offset VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT, advancedBlendCoherentOperations} type FieldIsArray "advancedBlendCoherentOperations" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT, advancedBlendCoherentOperations} instance {-# OVERLAPPING #-} CanReadField "advancedBlendCoherentOperations" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT, advancedBlendCoherentOperations}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT, advancedBlendCoherentOperations} instance {-# OVERLAPPING #-} CanWriteField "advancedBlendCoherentOperations" VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT, advancedBlendCoherentOperations} instance Show VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT where showsPrec d x = showString "VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "advancedBlendCoherentOperations = " . showsPrec d (getField @"advancedBlendCoherentOperations" x) . showChar '}' -- | > typedef struct VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT { -- > VkStructureType sType; -- > void* pNext; -- > uint32_t advancedBlendMaxColorAttachments; -- > VkBool32 advancedBlendIndependentBlend; -- > VkBool32 advancedBlendNonPremultipliedSrcColor; -- > VkBool32 advancedBlendNonPremultipliedDstColor; -- > VkBool32 advancedBlendCorrelatedOverlap; -- > VkBool32 advancedBlendAllOperations; -- > } VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT; -- -- data VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT## Addr## ByteArray## instance Eq VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT## a _) == x@(VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT## a _) `compare` x@(VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where sizeOf ~_ = #{size VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where unsafeAddr (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where type StructFields VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = '["sType", "pNext", "advancedBlendMaxColorAttachments", -- ' closing tick for hsc2hs "advancedBlendIndependentBlend", "advancedBlendNonPremultipliedSrcColor", "advancedBlendNonPremultipliedDstColor", "advancedBlendCorrelatedOverlap", "advancedBlendAllOperations"] type CUnionType VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = 'True -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where type FieldType "sType" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = VkStructureType type FieldOptional "sType" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, sType} type FieldIsArray "sType" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where type FieldType "pNext" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, pNext} type FieldIsArray "pNext" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, pNext} instance {-# OVERLAPPING #-} HasField "advancedBlendMaxColorAttachments" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where type FieldType "advancedBlendMaxColorAttachments" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = Word32 type FieldOptional "advancedBlendMaxColorAttachments" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "advancedBlendMaxColorAttachments" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendMaxColorAttachments} type FieldIsArray "advancedBlendMaxColorAttachments" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendMaxColorAttachments} instance {-# OVERLAPPING #-} CanReadField "advancedBlendMaxColorAttachments" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendMaxColorAttachments}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendMaxColorAttachments} instance {-# OVERLAPPING #-} CanWriteField "advancedBlendMaxColorAttachments" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendMaxColorAttachments} instance {-# OVERLAPPING #-} HasField "advancedBlendIndependentBlend" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where type FieldType "advancedBlendIndependentBlend" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = VkBool32 type FieldOptional "advancedBlendIndependentBlend" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "advancedBlendIndependentBlend" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendIndependentBlend} type FieldIsArray "advancedBlendIndependentBlend" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendIndependentBlend} instance {-# OVERLAPPING #-} CanReadField "advancedBlendIndependentBlend" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendIndependentBlend}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendIndependentBlend} instance {-# OVERLAPPING #-} CanWriteField "advancedBlendIndependentBlend" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendIndependentBlend} instance {-# OVERLAPPING #-} HasField "advancedBlendNonPremultipliedSrcColor" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where type FieldType "advancedBlendNonPremultipliedSrcColor" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = VkBool32 type FieldOptional "advancedBlendNonPremultipliedSrcColor" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "advancedBlendNonPremultipliedSrcColor" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendNonPremultipliedSrcColor} type FieldIsArray "advancedBlendNonPremultipliedSrcColor" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendNonPremultipliedSrcColor} instance {-# OVERLAPPING #-} CanReadField "advancedBlendNonPremultipliedSrcColor" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendNonPremultipliedSrcColor}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendNonPremultipliedSrcColor} instance {-# OVERLAPPING #-} CanWriteField "advancedBlendNonPremultipliedSrcColor" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendNonPremultipliedSrcColor} instance {-# OVERLAPPING #-} HasField "advancedBlendNonPremultipliedDstColor" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where type FieldType "advancedBlendNonPremultipliedDstColor" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = VkBool32 type FieldOptional "advancedBlendNonPremultipliedDstColor" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "advancedBlendNonPremultipliedDstColor" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendNonPremultipliedDstColor} type FieldIsArray "advancedBlendNonPremultipliedDstColor" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendNonPremultipliedDstColor} instance {-# OVERLAPPING #-} CanReadField "advancedBlendNonPremultipliedDstColor" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendNonPremultipliedDstColor}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendNonPremultipliedDstColor} instance {-# OVERLAPPING #-} CanWriteField "advancedBlendNonPremultipliedDstColor" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendNonPremultipliedDstColor} instance {-# OVERLAPPING #-} HasField "advancedBlendCorrelatedOverlap" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where type FieldType "advancedBlendCorrelatedOverlap" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = VkBool32 type FieldOptional "advancedBlendCorrelatedOverlap" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "advancedBlendCorrelatedOverlap" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendCorrelatedOverlap} type FieldIsArray "advancedBlendCorrelatedOverlap" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendCorrelatedOverlap} instance {-# OVERLAPPING #-} CanReadField "advancedBlendCorrelatedOverlap" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendCorrelatedOverlap}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendCorrelatedOverlap} instance {-# OVERLAPPING #-} CanWriteField "advancedBlendCorrelatedOverlap" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendCorrelatedOverlap} instance {-# OVERLAPPING #-} HasField "advancedBlendAllOperations" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where type FieldType "advancedBlendAllOperations" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = VkBool32 type FieldOptional "advancedBlendAllOperations" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "advancedBlendAllOperations" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendAllOperations} type FieldIsArray "advancedBlendAllOperations" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendAllOperations} instance {-# OVERLAPPING #-} CanReadField "advancedBlendAllOperations" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendAllOperations}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendAllOperations} instance {-# OVERLAPPING #-} CanWriteField "advancedBlendAllOperations" VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT, advancedBlendAllOperations} instance Show VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT where showsPrec d x = showString "VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "advancedBlendMaxColorAttachments = " . showsPrec d (getField @"advancedBlendMaxColorAttachments" x) . showString ", " . showString "advancedBlendIndependentBlend = " . showsPrec d (getField @"advancedBlendIndependentBlend" x) . showString ", " . showString "advancedBlendNonPremultipliedSrcColor = " . showsPrec d (getField @"advancedBlendNonPremultipliedSrcColor" x) . showString ", " . showString "advancedBlendNonPremultipliedDstColor = " . showsPrec d (getField @"advancedBlendNonPremultipliedDstColor" x) . showString ", " . showString "advancedBlendCorrelatedOverlap = " . showsPrec d (getField @"advancedBlendCorrelatedOverlap" x) . showString ", " . showString "advancedBlendAllOperations = " . showsPrec d (getField @"advancedBlendAllOperations" x) . showChar '}' -- | > typedef struct VkPhysicalDeviceConservativeRasterizationPropertiesEXT { -- > VkStructureType sType; -- > void* pNext; -- > float primitiveOverestimationSize; -- > float maxExtraPrimitiveOverestimationSize; -- > float extraPrimitiveOverestimationSizeGranularity; -- > VkBool32 primitiveUnderestimation; -- > VkBool32 conservativePointAndLineRasterization; -- > VkBool32 degenerateTrianglesRasterized; -- > VkBool32 degenerateLinesRasterized; -- > VkBool32 fullyCoveredFragmentShaderInputVariable; -- > VkBool32 conservativeRasterizationPostDepthCoverage; -- > } VkPhysicalDeviceConservativeRasterizationPropertiesEXT; -- -- data VkPhysicalDeviceConservativeRasterizationPropertiesEXT = VkPhysicalDeviceConservativeRasterizationPropertiesEXT## Addr## ByteArray## instance Eq VkPhysicalDeviceConservativeRasterizationPropertiesEXT where (VkPhysicalDeviceConservativeRasterizationPropertiesEXT## a _) == x@(VkPhysicalDeviceConservativeRasterizationPropertiesEXT## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceConservativeRasterizationPropertiesEXT where (VkPhysicalDeviceConservativeRasterizationPropertiesEXT## a _) `compare` x@(VkPhysicalDeviceConservativeRasterizationPropertiesEXT## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceConservativeRasterizationPropertiesEXT where sizeOf ~_ = #{size VkPhysicalDeviceConservativeRasterizationPropertiesEXT} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceConservativeRasterizationPropertiesEXT} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceConservativeRasterizationPropertiesEXT where unsafeAddr (VkPhysicalDeviceConservativeRasterizationPropertiesEXT## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceConservativeRasterizationPropertiesEXT## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceConservativeRasterizationPropertiesEXT## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceConservativeRasterizationPropertiesEXT where type StructFields VkPhysicalDeviceConservativeRasterizationPropertiesEXT = '["sType", "pNext", "primitiveOverestimationSize", -- ' closing tick for hsc2hs "maxExtraPrimitiveOverestimationSize", "extraPrimitiveOverestimationSizeGranularity", "primitiveUnderestimation", "conservativePointAndLineRasterization", "degenerateTrianglesRasterized", "degenerateLinesRasterized", "fullyCoveredFragmentShaderInputVariable", "conservativeRasterizationPostDepthCoverage"] type CUnionType VkPhysicalDeviceConservativeRasterizationPropertiesEXT = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceConservativeRasterizationPropertiesEXT = 'False -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceConservativeRasterizationPropertiesEXT = '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where type FieldType "sType" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = VkStructureType type FieldOptional "sType" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, sType} type FieldIsArray "sType" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where type FieldType "pNext" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, pNext} type FieldIsArray "pNext" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, pNext} instance {-# OVERLAPPING #-} HasField "primitiveOverestimationSize" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where type FieldType "primitiveOverestimationSize" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = #{type float} type FieldOptional "primitiveOverestimationSize" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "primitiveOverestimationSize" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, primitiveOverestimationSize} type FieldIsArray "primitiveOverestimationSize" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, primitiveOverestimationSize} instance {-# OVERLAPPING #-} CanReadField "primitiveOverestimationSize" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, primitiveOverestimationSize}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, primitiveOverestimationSize} instance {-# OVERLAPPING #-} CanWriteField "primitiveOverestimationSize" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, primitiveOverestimationSize} instance {-# OVERLAPPING #-} HasField "maxExtraPrimitiveOverestimationSize" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where type FieldType "maxExtraPrimitiveOverestimationSize" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = #{type float} type FieldOptional "maxExtraPrimitiveOverestimationSize" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "maxExtraPrimitiveOverestimationSize" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, maxExtraPrimitiveOverestimationSize} type FieldIsArray "maxExtraPrimitiveOverestimationSize" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, maxExtraPrimitiveOverestimationSize} instance {-# OVERLAPPING #-} CanReadField "maxExtraPrimitiveOverestimationSize" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, maxExtraPrimitiveOverestimationSize}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, maxExtraPrimitiveOverestimationSize} instance {-# OVERLAPPING #-} CanWriteField "maxExtraPrimitiveOverestimationSize" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, maxExtraPrimitiveOverestimationSize} instance {-# OVERLAPPING #-} HasField "extraPrimitiveOverestimationSizeGranularity" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where type FieldType "extraPrimitiveOverestimationSizeGranularity" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = #{type float} type FieldOptional "extraPrimitiveOverestimationSizeGranularity" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "extraPrimitiveOverestimationSizeGranularity" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, extraPrimitiveOverestimationSizeGranularity} type FieldIsArray "extraPrimitiveOverestimationSizeGranularity" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, extraPrimitiveOverestimationSizeGranularity} instance {-# OVERLAPPING #-} CanReadField "extraPrimitiveOverestimationSizeGranularity" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, extraPrimitiveOverestimationSizeGranularity}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, extraPrimitiveOverestimationSizeGranularity} instance {-# OVERLAPPING #-} CanWriteField "extraPrimitiveOverestimationSizeGranularity" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, extraPrimitiveOverestimationSizeGranularity} instance {-# OVERLAPPING #-} HasField "primitiveUnderestimation" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where type FieldType "primitiveUnderestimation" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = VkBool32 type FieldOptional "primitiveUnderestimation" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "primitiveUnderestimation" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, primitiveUnderestimation} type FieldIsArray "primitiveUnderestimation" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, primitiveUnderestimation} instance {-# OVERLAPPING #-} CanReadField "primitiveUnderestimation" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, primitiveUnderestimation}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, primitiveUnderestimation} instance {-# OVERLAPPING #-} CanWriteField "primitiveUnderestimation" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, primitiveUnderestimation} instance {-# OVERLAPPING #-} HasField "conservativePointAndLineRasterization" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where type FieldType "conservativePointAndLineRasterization" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = VkBool32 type FieldOptional "conservativePointAndLineRasterization" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "conservativePointAndLineRasterization" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, conservativePointAndLineRasterization} type FieldIsArray "conservativePointAndLineRasterization" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, conservativePointAndLineRasterization} instance {-# OVERLAPPING #-} CanReadField "conservativePointAndLineRasterization" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, conservativePointAndLineRasterization}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, conservativePointAndLineRasterization} instance {-# OVERLAPPING #-} CanWriteField "conservativePointAndLineRasterization" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, conservativePointAndLineRasterization} instance {-# OVERLAPPING #-} HasField "degenerateTrianglesRasterized" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where type FieldType "degenerateTrianglesRasterized" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = VkBool32 type FieldOptional "degenerateTrianglesRasterized" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "degenerateTrianglesRasterized" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, degenerateTrianglesRasterized} type FieldIsArray "degenerateTrianglesRasterized" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, degenerateTrianglesRasterized} instance {-# OVERLAPPING #-} CanReadField "degenerateTrianglesRasterized" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, degenerateTrianglesRasterized}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, degenerateTrianglesRasterized} instance {-# OVERLAPPING #-} CanWriteField "degenerateTrianglesRasterized" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, degenerateTrianglesRasterized} instance {-# OVERLAPPING #-} HasField "degenerateLinesRasterized" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where type FieldType "degenerateLinesRasterized" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = VkBool32 type FieldOptional "degenerateLinesRasterized" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "degenerateLinesRasterized" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, degenerateLinesRasterized} type FieldIsArray "degenerateLinesRasterized" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, degenerateLinesRasterized} instance {-# OVERLAPPING #-} CanReadField "degenerateLinesRasterized" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, degenerateLinesRasterized}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, degenerateLinesRasterized} instance {-# OVERLAPPING #-} CanWriteField "degenerateLinesRasterized" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, degenerateLinesRasterized} instance {-# OVERLAPPING #-} HasField "fullyCoveredFragmentShaderInputVariable" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where type FieldType "fullyCoveredFragmentShaderInputVariable" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = VkBool32 type FieldOptional "fullyCoveredFragmentShaderInputVariable" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "fullyCoveredFragmentShaderInputVariable" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, fullyCoveredFragmentShaderInputVariable} type FieldIsArray "fullyCoveredFragmentShaderInputVariable" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, fullyCoveredFragmentShaderInputVariable} instance {-# OVERLAPPING #-} CanReadField "fullyCoveredFragmentShaderInputVariable" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, fullyCoveredFragmentShaderInputVariable}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, fullyCoveredFragmentShaderInputVariable} instance {-# OVERLAPPING #-} CanWriteField "fullyCoveredFragmentShaderInputVariable" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, fullyCoveredFragmentShaderInputVariable} instance {-# OVERLAPPING #-} HasField "conservativeRasterizationPostDepthCoverage" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where type FieldType "conservativeRasterizationPostDepthCoverage" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = VkBool32 type FieldOptional "conservativeRasterizationPostDepthCoverage" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "conservativeRasterizationPostDepthCoverage" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, conservativeRasterizationPostDepthCoverage} type FieldIsArray "conservativeRasterizationPostDepthCoverage" VkPhysicalDeviceConservativeRasterizationPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, conservativeRasterizationPostDepthCoverage} instance {-# OVERLAPPING #-} CanReadField "conservativeRasterizationPostDepthCoverage" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, conservativeRasterizationPostDepthCoverage}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, conservativeRasterizationPostDepthCoverage} instance {-# OVERLAPPING #-} CanWriteField "conservativeRasterizationPostDepthCoverage" VkPhysicalDeviceConservativeRasterizationPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceConservativeRasterizationPropertiesEXT, conservativeRasterizationPostDepthCoverage} instance Show VkPhysicalDeviceConservativeRasterizationPropertiesEXT where showsPrec d x = showString "VkPhysicalDeviceConservativeRasterizationPropertiesEXT {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "primitiveOverestimationSize = " . showsPrec d (getField @"primitiveOverestimationSize" x) . showString ", " . showString "maxExtraPrimitiveOverestimationSize = " . showsPrec d (getField @"maxExtraPrimitiveOverestimationSize" x) . showString ", " . showString "extraPrimitiveOverestimationSizeGranularity = " . showsPrec d (getField @"extraPrimitiveOverestimationSizeGranularity" x) . showString ", " . showString "primitiveUnderestimation = " . showsPrec d (getField @"primitiveUnderestimation" x) . showString ", " . showString "conservativePointAndLineRasterization = " . showsPrec d (getField @"conservativePointAndLineRasterization" x) . showString ", " . showString "degenerateTrianglesRasterized = " . showsPrec d (getField @"degenerateTrianglesRasterized" x) . showString ", " . showString "degenerateLinesRasterized = " . showsPrec d (getField @"degenerateLinesRasterized" x) . showString ", " . showString "fullyCoveredFragmentShaderInputVariable = " . showsPrec d (getField @"fullyCoveredFragmentShaderInputVariable" x) . showString ", " . showString "conservativeRasterizationPostDepthCoverage = " . showsPrec d (getField @"conservativeRasterizationPostDepthCoverage" x) . showChar '}' -- | > typedef struct VkPhysicalDeviceDescriptorIndexingFeaturesEXT { -- > VkStructureType sType; -- > void* pNext; -- > VkBool32 shaderInputAttachmentArrayDynamicIndexing; -- > VkBool32 shaderUniformTexelBufferArrayDynamicIndexing; -- > VkBool32 shaderStorageTexelBufferArrayDynamicIndexing; -- > VkBool32 shaderUniformBufferArrayNonUniformIndexing; -- > VkBool32 shaderSampledImageArrayNonUniformIndexing; -- > VkBool32 shaderStorageBufferArrayNonUniformIndexing; -- > VkBool32 shaderStorageImageArrayNonUniformIndexing; -- > VkBool32 shaderInputAttachmentArrayNonUniformIndexing; -- > VkBool32 shaderUniformTexelBufferArrayNonUniformIndexing; -- > VkBool32 shaderStorageTexelBufferArrayNonUniformIndexing; -- > VkBool32 descriptorBindingUniformBufferUpdateAfterBind; -- > VkBool32 descriptorBindingSampledImageUpdateAfterBind; -- > VkBool32 descriptorBindingStorageImageUpdateAfterBind; -- > VkBool32 descriptorBindingStorageBufferUpdateAfterBind; -- > VkBool32 descriptorBindingUniformTexelBufferUpdateAfterBind; -- > VkBool32 descriptorBindingStorageTexelBufferUpdateAfterBind; -- > VkBool32 descriptorBindingUpdateUnusedWhilePending; -- > VkBool32 descriptorBindingPartiallyBound; -- > VkBool32 descriptorBindingVariableDescriptorCount; -- > VkBool32 runtimeDescriptorArray; -- > } VkPhysicalDeviceDescriptorIndexingFeaturesEXT; -- -- data VkPhysicalDeviceDescriptorIndexingFeaturesEXT = VkPhysicalDeviceDescriptorIndexingFeaturesEXT## Addr## ByteArray## instance Eq VkPhysicalDeviceDescriptorIndexingFeaturesEXT where (VkPhysicalDeviceDescriptorIndexingFeaturesEXT## a _) == x@(VkPhysicalDeviceDescriptorIndexingFeaturesEXT## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceDescriptorIndexingFeaturesEXT where (VkPhysicalDeviceDescriptorIndexingFeaturesEXT## a _) `compare` x@(VkPhysicalDeviceDescriptorIndexingFeaturesEXT## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceDescriptorIndexingFeaturesEXT where sizeOf ~_ = #{size VkPhysicalDeviceDescriptorIndexingFeaturesEXT} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceDescriptorIndexingFeaturesEXT} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceDescriptorIndexingFeaturesEXT where unsafeAddr (VkPhysicalDeviceDescriptorIndexingFeaturesEXT## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceDescriptorIndexingFeaturesEXT## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceDescriptorIndexingFeaturesEXT## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceDescriptorIndexingFeaturesEXT where type StructFields VkPhysicalDeviceDescriptorIndexingFeaturesEXT = '["sType", "pNext", "shaderInputAttachmentArrayDynamicIndexing", -- ' closing tick for hsc2hs "shaderUniformTexelBufferArrayDynamicIndexing", "shaderStorageTexelBufferArrayDynamicIndexing", "shaderUniformBufferArrayNonUniformIndexing", "shaderSampledImageArrayNonUniformIndexing", "shaderStorageBufferArrayNonUniformIndexing", "shaderStorageImageArrayNonUniformIndexing", "shaderInputAttachmentArrayNonUniformIndexing", "shaderUniformTexelBufferArrayNonUniformIndexing", "shaderStorageTexelBufferArrayNonUniformIndexing", "descriptorBindingUniformBufferUpdateAfterBind", "descriptorBindingSampledImageUpdateAfterBind", "descriptorBindingStorageImageUpdateAfterBind", "descriptorBindingStorageBufferUpdateAfterBind", "descriptorBindingUniformTexelBufferUpdateAfterBind", "descriptorBindingStorageTexelBufferUpdateAfterBind", "descriptorBindingUpdateUnusedWhilePending", "descriptorBindingPartiallyBound", "descriptorBindingVariableDescriptorCount", "runtimeDescriptorArray"] type CUnionType VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceDescriptorIndexingFeaturesEXT = '[VkPhysicalDeviceFeatures2, VkDeviceCreateInfo] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where type FieldType "sType" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = VkStructureType type FieldOptional "sType" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, sType} type FieldIsArray "sType" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where type FieldType "pNext" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, pNext} type FieldIsArray "pNext" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, pNext} instance {-# OVERLAPPING #-} HasField "shaderInputAttachmentArrayDynamicIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where type FieldType "shaderInputAttachmentArrayDynamicIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = VkBool32 type FieldOptional "shaderInputAttachmentArrayDynamicIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "shaderInputAttachmentArrayDynamicIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderInputAttachmentArrayDynamicIndexing} type FieldIsArray "shaderInputAttachmentArrayDynamicIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderInputAttachmentArrayDynamicIndexing} instance {-# OVERLAPPING #-} CanReadField "shaderInputAttachmentArrayDynamicIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderInputAttachmentArrayDynamicIndexing}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderInputAttachmentArrayDynamicIndexing} instance {-# OVERLAPPING #-} CanWriteField "shaderInputAttachmentArrayDynamicIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderInputAttachmentArrayDynamicIndexing} instance {-# OVERLAPPING #-} HasField "shaderUniformTexelBufferArrayDynamicIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where type FieldType "shaderUniformTexelBufferArrayDynamicIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = VkBool32 type FieldOptional "shaderUniformTexelBufferArrayDynamicIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "shaderUniformTexelBufferArrayDynamicIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderUniformTexelBufferArrayDynamicIndexing} type FieldIsArray "shaderUniformTexelBufferArrayDynamicIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderUniformTexelBufferArrayDynamicIndexing} instance {-# OVERLAPPING #-} CanReadField "shaderUniformTexelBufferArrayDynamicIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderUniformTexelBufferArrayDynamicIndexing}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderUniformTexelBufferArrayDynamicIndexing} instance {-# OVERLAPPING #-} CanWriteField "shaderUniformTexelBufferArrayDynamicIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderUniformTexelBufferArrayDynamicIndexing} instance {-# OVERLAPPING #-} HasField "shaderStorageTexelBufferArrayDynamicIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where type FieldType "shaderStorageTexelBufferArrayDynamicIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = VkBool32 type FieldOptional "shaderStorageTexelBufferArrayDynamicIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "shaderStorageTexelBufferArrayDynamicIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderStorageTexelBufferArrayDynamicIndexing} type FieldIsArray "shaderStorageTexelBufferArrayDynamicIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderStorageTexelBufferArrayDynamicIndexing} instance {-# OVERLAPPING #-} CanReadField "shaderStorageTexelBufferArrayDynamicIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderStorageTexelBufferArrayDynamicIndexing}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderStorageTexelBufferArrayDynamicIndexing} instance {-# OVERLAPPING #-} CanWriteField "shaderStorageTexelBufferArrayDynamicIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderStorageTexelBufferArrayDynamicIndexing} instance {-# OVERLAPPING #-} HasField "shaderUniformBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where type FieldType "shaderUniformBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = VkBool32 type FieldOptional "shaderUniformBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "shaderUniformBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderUniformBufferArrayNonUniformIndexing} type FieldIsArray "shaderUniformBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderUniformBufferArrayNonUniformIndexing} instance {-# OVERLAPPING #-} CanReadField "shaderUniformBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderUniformBufferArrayNonUniformIndexing}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderUniformBufferArrayNonUniformIndexing} instance {-# OVERLAPPING #-} CanWriteField "shaderUniformBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderUniformBufferArrayNonUniformIndexing} instance {-# OVERLAPPING #-} HasField "shaderSampledImageArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where type FieldType "shaderSampledImageArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = VkBool32 type FieldOptional "shaderSampledImageArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "shaderSampledImageArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderSampledImageArrayNonUniformIndexing} type FieldIsArray "shaderSampledImageArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderSampledImageArrayNonUniformIndexing} instance {-# OVERLAPPING #-} CanReadField "shaderSampledImageArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderSampledImageArrayNonUniformIndexing}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderSampledImageArrayNonUniformIndexing} instance {-# OVERLAPPING #-} CanWriteField "shaderSampledImageArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderSampledImageArrayNonUniformIndexing} instance {-# OVERLAPPING #-} HasField "shaderStorageBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where type FieldType "shaderStorageBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = VkBool32 type FieldOptional "shaderStorageBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "shaderStorageBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderStorageBufferArrayNonUniformIndexing} type FieldIsArray "shaderStorageBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderStorageBufferArrayNonUniformIndexing} instance {-# OVERLAPPING #-} CanReadField "shaderStorageBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderStorageBufferArrayNonUniformIndexing}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderStorageBufferArrayNonUniformIndexing} instance {-# OVERLAPPING #-} CanWriteField "shaderStorageBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderStorageBufferArrayNonUniformIndexing} instance {-# OVERLAPPING #-} HasField "shaderStorageImageArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where type FieldType "shaderStorageImageArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = VkBool32 type FieldOptional "shaderStorageImageArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "shaderStorageImageArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderStorageImageArrayNonUniformIndexing} type FieldIsArray "shaderStorageImageArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderStorageImageArrayNonUniformIndexing} instance {-# OVERLAPPING #-} CanReadField "shaderStorageImageArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderStorageImageArrayNonUniformIndexing}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderStorageImageArrayNonUniformIndexing} instance {-# OVERLAPPING #-} CanWriteField "shaderStorageImageArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderStorageImageArrayNonUniformIndexing} instance {-# OVERLAPPING #-} HasField "shaderInputAttachmentArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where type FieldType "shaderInputAttachmentArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = VkBool32 type FieldOptional "shaderInputAttachmentArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "shaderInputAttachmentArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderInputAttachmentArrayNonUniformIndexing} type FieldIsArray "shaderInputAttachmentArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderInputAttachmentArrayNonUniformIndexing} instance {-# OVERLAPPING #-} CanReadField "shaderInputAttachmentArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderInputAttachmentArrayNonUniformIndexing}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderInputAttachmentArrayNonUniformIndexing} instance {-# OVERLAPPING #-} CanWriteField "shaderInputAttachmentArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderInputAttachmentArrayNonUniformIndexing} instance {-# OVERLAPPING #-} HasField "shaderUniformTexelBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where type FieldType "shaderUniformTexelBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = VkBool32 type FieldOptional "shaderUniformTexelBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "shaderUniformTexelBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderUniformTexelBufferArrayNonUniformIndexing} type FieldIsArray "shaderUniformTexelBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderUniformTexelBufferArrayNonUniformIndexing} instance {-# OVERLAPPING #-} CanReadField "shaderUniformTexelBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderUniformTexelBufferArrayNonUniformIndexing}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderUniformTexelBufferArrayNonUniformIndexing} instance {-# OVERLAPPING #-} CanWriteField "shaderUniformTexelBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderUniformTexelBufferArrayNonUniformIndexing} instance {-# OVERLAPPING #-} HasField "shaderStorageTexelBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where type FieldType "shaderStorageTexelBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = VkBool32 type FieldOptional "shaderStorageTexelBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "shaderStorageTexelBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderStorageTexelBufferArrayNonUniformIndexing} type FieldIsArray "shaderStorageTexelBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderStorageTexelBufferArrayNonUniformIndexing} instance {-# OVERLAPPING #-} CanReadField "shaderStorageTexelBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderStorageTexelBufferArrayNonUniformIndexing}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderStorageTexelBufferArrayNonUniformIndexing} instance {-# OVERLAPPING #-} CanWriteField "shaderStorageTexelBufferArrayNonUniformIndexing" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, shaderStorageTexelBufferArrayNonUniformIndexing} instance {-# OVERLAPPING #-} HasField "descriptorBindingUniformBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where type FieldType "descriptorBindingUniformBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = VkBool32 type FieldOptional "descriptorBindingUniformBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "descriptorBindingUniformBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingUniformBufferUpdateAfterBind} type FieldIsArray "descriptorBindingUniformBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingUniformBufferUpdateAfterBind} instance {-# OVERLAPPING #-} CanReadField "descriptorBindingUniformBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingUniformBufferUpdateAfterBind}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingUniformBufferUpdateAfterBind} instance {-# OVERLAPPING #-} CanWriteField "descriptorBindingUniformBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingUniformBufferUpdateAfterBind} instance {-# OVERLAPPING #-} HasField "descriptorBindingSampledImageUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where type FieldType "descriptorBindingSampledImageUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = VkBool32 type FieldOptional "descriptorBindingSampledImageUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "descriptorBindingSampledImageUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingSampledImageUpdateAfterBind} type FieldIsArray "descriptorBindingSampledImageUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingSampledImageUpdateAfterBind} instance {-# OVERLAPPING #-} CanReadField "descriptorBindingSampledImageUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingSampledImageUpdateAfterBind}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingSampledImageUpdateAfterBind} instance {-# OVERLAPPING #-} CanWriteField "descriptorBindingSampledImageUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingSampledImageUpdateAfterBind} instance {-# OVERLAPPING #-} HasField "descriptorBindingStorageImageUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where type FieldType "descriptorBindingStorageImageUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = VkBool32 type FieldOptional "descriptorBindingStorageImageUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "descriptorBindingStorageImageUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingStorageImageUpdateAfterBind} type FieldIsArray "descriptorBindingStorageImageUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingStorageImageUpdateAfterBind} instance {-# OVERLAPPING #-} CanReadField "descriptorBindingStorageImageUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingStorageImageUpdateAfterBind}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingStorageImageUpdateAfterBind} instance {-# OVERLAPPING #-} CanWriteField "descriptorBindingStorageImageUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingStorageImageUpdateAfterBind} instance {-# OVERLAPPING #-} HasField "descriptorBindingStorageBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where type FieldType "descriptorBindingStorageBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = VkBool32 type FieldOptional "descriptorBindingStorageBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "descriptorBindingStorageBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingStorageBufferUpdateAfterBind} type FieldIsArray "descriptorBindingStorageBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingStorageBufferUpdateAfterBind} instance {-# OVERLAPPING #-} CanReadField "descriptorBindingStorageBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingStorageBufferUpdateAfterBind}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingStorageBufferUpdateAfterBind} instance {-# OVERLAPPING #-} CanWriteField "descriptorBindingStorageBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingStorageBufferUpdateAfterBind} instance {-# OVERLAPPING #-} HasField "descriptorBindingUniformTexelBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where type FieldType "descriptorBindingUniformTexelBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = VkBool32 type FieldOptional "descriptorBindingUniformTexelBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "descriptorBindingUniformTexelBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingUniformTexelBufferUpdateAfterBind} type FieldIsArray "descriptorBindingUniformTexelBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingUniformTexelBufferUpdateAfterBind} instance {-# OVERLAPPING #-} CanReadField "descriptorBindingUniformTexelBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingUniformTexelBufferUpdateAfterBind}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingUniformTexelBufferUpdateAfterBind} instance {-# OVERLAPPING #-} CanWriteField "descriptorBindingUniformTexelBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingUniformTexelBufferUpdateAfterBind} instance {-# OVERLAPPING #-} HasField "descriptorBindingStorageTexelBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where type FieldType "descriptorBindingStorageTexelBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = VkBool32 type FieldOptional "descriptorBindingStorageTexelBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "descriptorBindingStorageTexelBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingStorageTexelBufferUpdateAfterBind} type FieldIsArray "descriptorBindingStorageTexelBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingStorageTexelBufferUpdateAfterBind} instance {-# OVERLAPPING #-} CanReadField "descriptorBindingStorageTexelBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingStorageTexelBufferUpdateAfterBind}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingStorageTexelBufferUpdateAfterBind} instance {-# OVERLAPPING #-} CanWriteField "descriptorBindingStorageTexelBufferUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingStorageTexelBufferUpdateAfterBind} instance {-# OVERLAPPING #-} HasField "descriptorBindingUpdateUnusedWhilePending" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where type FieldType "descriptorBindingUpdateUnusedWhilePending" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = VkBool32 type FieldOptional "descriptorBindingUpdateUnusedWhilePending" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "descriptorBindingUpdateUnusedWhilePending" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingUpdateUnusedWhilePending} type FieldIsArray "descriptorBindingUpdateUnusedWhilePending" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingUpdateUnusedWhilePending} instance {-# OVERLAPPING #-} CanReadField "descriptorBindingUpdateUnusedWhilePending" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingUpdateUnusedWhilePending}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingUpdateUnusedWhilePending} instance {-# OVERLAPPING #-} CanWriteField "descriptorBindingUpdateUnusedWhilePending" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingUpdateUnusedWhilePending} instance {-# OVERLAPPING #-} HasField "descriptorBindingPartiallyBound" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where type FieldType "descriptorBindingPartiallyBound" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = VkBool32 type FieldOptional "descriptorBindingPartiallyBound" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "descriptorBindingPartiallyBound" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingPartiallyBound} type FieldIsArray "descriptorBindingPartiallyBound" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingPartiallyBound} instance {-# OVERLAPPING #-} CanReadField "descriptorBindingPartiallyBound" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingPartiallyBound}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingPartiallyBound} instance {-# OVERLAPPING #-} CanWriteField "descriptorBindingPartiallyBound" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingPartiallyBound} instance {-# OVERLAPPING #-} HasField "descriptorBindingVariableDescriptorCount" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where type FieldType "descriptorBindingVariableDescriptorCount" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = VkBool32 type FieldOptional "descriptorBindingVariableDescriptorCount" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "descriptorBindingVariableDescriptorCount" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingVariableDescriptorCount} type FieldIsArray "descriptorBindingVariableDescriptorCount" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingVariableDescriptorCount} instance {-# OVERLAPPING #-} CanReadField "descriptorBindingVariableDescriptorCount" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingVariableDescriptorCount}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingVariableDescriptorCount} instance {-# OVERLAPPING #-} CanWriteField "descriptorBindingVariableDescriptorCount" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, descriptorBindingVariableDescriptorCount} instance {-# OVERLAPPING #-} HasField "runtimeDescriptorArray" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where type FieldType "runtimeDescriptorArray" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = VkBool32 type FieldOptional "runtimeDescriptorArray" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "runtimeDescriptorArray" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, runtimeDescriptorArray} type FieldIsArray "runtimeDescriptorArray" VkPhysicalDeviceDescriptorIndexingFeaturesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, runtimeDescriptorArray} instance {-# OVERLAPPING #-} CanReadField "runtimeDescriptorArray" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, runtimeDescriptorArray}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, runtimeDescriptorArray} instance {-# OVERLAPPING #-} CanWriteField "runtimeDescriptorArray" VkPhysicalDeviceDescriptorIndexingFeaturesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingFeaturesEXT, runtimeDescriptorArray} instance Show VkPhysicalDeviceDescriptorIndexingFeaturesEXT where showsPrec d x = showString "VkPhysicalDeviceDescriptorIndexingFeaturesEXT {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "shaderInputAttachmentArrayDynamicIndexing = " . showsPrec d (getField @"shaderInputAttachmentArrayDynamicIndexing" x) . showString ", " . showString "shaderUniformTexelBufferArrayDynamicIndexing = " . showsPrec d (getField @"shaderUniformTexelBufferArrayDynamicIndexing" x) . showString ", " . showString "shaderStorageTexelBufferArrayDynamicIndexing = " . showsPrec d (getField @"shaderStorageTexelBufferArrayDynamicIndexing" x) . showString ", " . showString "shaderUniformBufferArrayNonUniformIndexing = " . showsPrec d (getField @"shaderUniformBufferArrayNonUniformIndexing" x) . showString ", " . showString "shaderSampledImageArrayNonUniformIndexing = " . showsPrec d (getField @"shaderSampledImageArrayNonUniformIndexing" x) . showString ", " . showString "shaderStorageBufferArrayNonUniformIndexing = " . showsPrec d (getField @"shaderStorageBufferArrayNonUniformIndexing" x) . showString ", " . showString "shaderStorageImageArrayNonUniformIndexing = " . showsPrec d (getField @"shaderStorageImageArrayNonUniformIndexing" x) . showString ", " . showString "shaderInputAttachmentArrayNonUniformIndexing = " . showsPrec d (getField @"shaderInputAttachmentArrayNonUniformIndexing" x) . showString ", " . showString "shaderUniformTexelBufferArrayNonUniformIndexing = " . showsPrec d (getField @"shaderUniformTexelBufferArrayNonUniformIndexing" x) . showString ", " . showString "shaderStorageTexelBufferArrayNonUniformIndexing = " . showsPrec d (getField @"shaderStorageTexelBufferArrayNonUniformIndexing" x) . showString ", " . showString "descriptorBindingUniformBufferUpdateAfterBind = " . showsPrec d (getField @"descriptorBindingUniformBufferUpdateAfterBind" x) . showString ", " . showString "descriptorBindingSampledImageUpdateAfterBind = " . showsPrec d (getField @"descriptorBindingSampledImageUpdateAfterBind" x) . showString ", " . showString "descriptorBindingStorageImageUpdateAfterBind = " . showsPrec d (getField @"descriptorBindingStorageImageUpdateAfterBind" x) . showString ", " . showString "descriptorBindingStorageBufferUpdateAfterBind = " . showsPrec d (getField @"descriptorBindingStorageBufferUpdateAfterBind" x) . showString ", " . showString "descriptorBindingUniformTexelBufferUpdateAfterBind = " . showsPrec d (getField @"descriptorBindingUniformTexelBufferUpdateAfterBind" x) . showString ", " . showString "descriptorBindingStorageTexelBufferUpdateAfterBind = " . showsPrec d (getField @"descriptorBindingStorageTexelBufferUpdateAfterBind" x) . showString ", " . showString "descriptorBindingUpdateUnusedWhilePending = " . showsPrec d (getField @"descriptorBindingUpdateUnusedWhilePending" x) . showString ", " . showString "descriptorBindingPartiallyBound = " . showsPrec d (getField @"descriptorBindingPartiallyBound" x) . showString ", " . showString "descriptorBindingVariableDescriptorCount = " . showsPrec d (getField @"descriptorBindingVariableDescriptorCount" x) . showString ", " . showString "runtimeDescriptorArray = " . showsPrec d (getField @"runtimeDescriptorArray" x) . showChar '}' -- | > typedef struct VkPhysicalDeviceDescriptorIndexingPropertiesEXT { -- > VkStructureType sType; -- > void* pNext; -- > uint32_t maxUpdateAfterBindDescriptorsInAllPools; -- > VkBool32 shaderUniformBufferArrayNonUniformIndexingNative; -- > VkBool32 shaderSampledImageArrayNonUniformIndexingNative; -- > VkBool32 shaderStorageBufferArrayNonUniformIndexingNative; -- > VkBool32 shaderStorageImageArrayNonUniformIndexingNative; -- > VkBool32 shaderInputAttachmentArrayNonUniformIndexingNative; -- > VkBool32 robustBufferAccessUpdateAfterBind; -- > VkBool32 quadDivergentImplicitLod; -- > uint32_t maxPerStageDescriptorUpdateAfterBindSamplers; -- > uint32_t maxPerStageDescriptorUpdateAfterBindUniformBuffers; -- > uint32_t maxPerStageDescriptorUpdateAfterBindStorageBuffers; -- > uint32_t maxPerStageDescriptorUpdateAfterBindSampledImages; -- > uint32_t maxPerStageDescriptorUpdateAfterBindStorageImages; -- > uint32_t maxPerStageDescriptorUpdateAfterBindInputAttachments; -- > uint32_t maxPerStageUpdateAfterBindResources; -- > uint32_t maxDescriptorSetUpdateAfterBindSamplers; -- > uint32_t maxDescriptorSetUpdateAfterBindUniformBuffers; -- > uint32_t maxDescriptorSetUpdateAfterBindUniformBuffersDynamic; -- > uint32_t maxDescriptorSetUpdateAfterBindStorageBuffers; -- > uint32_t maxDescriptorSetUpdateAfterBindStorageBuffersDynamic; -- > uint32_t maxDescriptorSetUpdateAfterBindSampledImages; -- > uint32_t maxDescriptorSetUpdateAfterBindStorageImages; -- > uint32_t maxDescriptorSetUpdateAfterBindInputAttachments; -- > } VkPhysicalDeviceDescriptorIndexingPropertiesEXT; -- -- data VkPhysicalDeviceDescriptorIndexingPropertiesEXT = VkPhysicalDeviceDescriptorIndexingPropertiesEXT## Addr## ByteArray## instance Eq VkPhysicalDeviceDescriptorIndexingPropertiesEXT where (VkPhysicalDeviceDescriptorIndexingPropertiesEXT## a _) == x@(VkPhysicalDeviceDescriptorIndexingPropertiesEXT## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceDescriptorIndexingPropertiesEXT where (VkPhysicalDeviceDescriptorIndexingPropertiesEXT## a _) `compare` x@(VkPhysicalDeviceDescriptorIndexingPropertiesEXT## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceDescriptorIndexingPropertiesEXT where sizeOf ~_ = #{size VkPhysicalDeviceDescriptorIndexingPropertiesEXT} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceDescriptorIndexingPropertiesEXT} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceDescriptorIndexingPropertiesEXT where unsafeAddr (VkPhysicalDeviceDescriptorIndexingPropertiesEXT## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceDescriptorIndexingPropertiesEXT## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceDescriptorIndexingPropertiesEXT## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type StructFields VkPhysicalDeviceDescriptorIndexingPropertiesEXT = '["sType", "pNext", "maxUpdateAfterBindDescriptorsInAllPools", -- ' closing tick for hsc2hs "shaderUniformBufferArrayNonUniformIndexingNative", "shaderSampledImageArrayNonUniformIndexingNative", "shaderStorageBufferArrayNonUniformIndexingNative", "shaderStorageImageArrayNonUniformIndexingNative", "shaderInputAttachmentArrayNonUniformIndexingNative", "robustBufferAccessUpdateAfterBind", "quadDivergentImplicitLod", "maxPerStageDescriptorUpdateAfterBindSamplers", "maxPerStageDescriptorUpdateAfterBindUniformBuffers", "maxPerStageDescriptorUpdateAfterBindStorageBuffers", "maxPerStageDescriptorUpdateAfterBindSampledImages", "maxPerStageDescriptorUpdateAfterBindStorageImages", "maxPerStageDescriptorUpdateAfterBindInputAttachments", "maxPerStageUpdateAfterBindResources", "maxDescriptorSetUpdateAfterBindSamplers", "maxDescriptorSetUpdateAfterBindUniformBuffers", "maxDescriptorSetUpdateAfterBindUniformBuffersDynamic", "maxDescriptorSetUpdateAfterBindStorageBuffers", "maxDescriptorSetUpdateAfterBindStorageBuffersDynamic", "maxDescriptorSetUpdateAfterBindSampledImages", "maxDescriptorSetUpdateAfterBindStorageImages", "maxDescriptorSetUpdateAfterBindInputAttachments"] type CUnionType VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'True -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceDescriptorIndexingPropertiesEXT = '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type FieldType "sType" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = VkStructureType type FieldOptional "sType" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, sType} type FieldIsArray "sType" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type FieldType "pNext" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, pNext} type FieldIsArray "pNext" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, pNext} instance {-# OVERLAPPING #-} HasField "maxUpdateAfterBindDescriptorsInAllPools" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type FieldType "maxUpdateAfterBindDescriptorsInAllPools" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = Word32 type FieldOptional "maxUpdateAfterBindDescriptorsInAllPools" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "maxUpdateAfterBindDescriptorsInAllPools" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxUpdateAfterBindDescriptorsInAllPools} type FieldIsArray "maxUpdateAfterBindDescriptorsInAllPools" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxUpdateAfterBindDescriptorsInAllPools} instance {-# OVERLAPPING #-} CanReadField "maxUpdateAfterBindDescriptorsInAllPools" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxUpdateAfterBindDescriptorsInAllPools}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxUpdateAfterBindDescriptorsInAllPools} instance {-# OVERLAPPING #-} CanWriteField "maxUpdateAfterBindDescriptorsInAllPools" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxUpdateAfterBindDescriptorsInAllPools} instance {-# OVERLAPPING #-} HasField "shaderUniformBufferArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type FieldType "shaderUniformBufferArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = VkBool32 type FieldOptional "shaderUniformBufferArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "shaderUniformBufferArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, shaderUniformBufferArrayNonUniformIndexingNative} type FieldIsArray "shaderUniformBufferArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, shaderUniformBufferArrayNonUniformIndexingNative} instance {-# OVERLAPPING #-} CanReadField "shaderUniformBufferArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, shaderUniformBufferArrayNonUniformIndexingNative}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, shaderUniformBufferArrayNonUniformIndexingNative} instance {-# OVERLAPPING #-} CanWriteField "shaderUniformBufferArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, shaderUniformBufferArrayNonUniformIndexingNative} instance {-# OVERLAPPING #-} HasField "shaderSampledImageArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type FieldType "shaderSampledImageArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = VkBool32 type FieldOptional "shaderSampledImageArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "shaderSampledImageArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, shaderSampledImageArrayNonUniformIndexingNative} type FieldIsArray "shaderSampledImageArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, shaderSampledImageArrayNonUniformIndexingNative} instance {-# OVERLAPPING #-} CanReadField "shaderSampledImageArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, shaderSampledImageArrayNonUniformIndexingNative}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, shaderSampledImageArrayNonUniformIndexingNative} instance {-# OVERLAPPING #-} CanWriteField "shaderSampledImageArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, shaderSampledImageArrayNonUniformIndexingNative} instance {-# OVERLAPPING #-} HasField "shaderStorageBufferArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type FieldType "shaderStorageBufferArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = VkBool32 type FieldOptional "shaderStorageBufferArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "shaderStorageBufferArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, shaderStorageBufferArrayNonUniformIndexingNative} type FieldIsArray "shaderStorageBufferArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, shaderStorageBufferArrayNonUniformIndexingNative} instance {-# OVERLAPPING #-} CanReadField "shaderStorageBufferArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, shaderStorageBufferArrayNonUniformIndexingNative}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, shaderStorageBufferArrayNonUniformIndexingNative} instance {-# OVERLAPPING #-} CanWriteField "shaderStorageBufferArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, shaderStorageBufferArrayNonUniformIndexingNative} instance {-# OVERLAPPING #-} HasField "shaderStorageImageArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type FieldType "shaderStorageImageArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = VkBool32 type FieldOptional "shaderStorageImageArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "shaderStorageImageArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, shaderStorageImageArrayNonUniformIndexingNative} type FieldIsArray "shaderStorageImageArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, shaderStorageImageArrayNonUniformIndexingNative} instance {-# OVERLAPPING #-} CanReadField "shaderStorageImageArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, shaderStorageImageArrayNonUniformIndexingNative}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, shaderStorageImageArrayNonUniformIndexingNative} instance {-# OVERLAPPING #-} CanWriteField "shaderStorageImageArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, shaderStorageImageArrayNonUniformIndexingNative} instance {-# OVERLAPPING #-} HasField "shaderInputAttachmentArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type FieldType "shaderInputAttachmentArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = VkBool32 type FieldOptional "shaderInputAttachmentArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "shaderInputAttachmentArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, shaderInputAttachmentArrayNonUniformIndexingNative} type FieldIsArray "shaderInputAttachmentArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, shaderInputAttachmentArrayNonUniformIndexingNative} instance {-# OVERLAPPING #-} CanReadField "shaderInputAttachmentArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, shaderInputAttachmentArrayNonUniformIndexingNative}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, shaderInputAttachmentArrayNonUniformIndexingNative} instance {-# OVERLAPPING #-} CanWriteField "shaderInputAttachmentArrayNonUniformIndexingNative" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, shaderInputAttachmentArrayNonUniformIndexingNative} instance {-# OVERLAPPING #-} HasField "robustBufferAccessUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type FieldType "robustBufferAccessUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = VkBool32 type FieldOptional "robustBufferAccessUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "robustBufferAccessUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, robustBufferAccessUpdateAfterBind} type FieldIsArray "robustBufferAccessUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, robustBufferAccessUpdateAfterBind} instance {-# OVERLAPPING #-} CanReadField "robustBufferAccessUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, robustBufferAccessUpdateAfterBind}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, robustBufferAccessUpdateAfterBind} instance {-# OVERLAPPING #-} CanWriteField "robustBufferAccessUpdateAfterBind" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, robustBufferAccessUpdateAfterBind} instance {-# OVERLAPPING #-} HasField "quadDivergentImplicitLod" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type FieldType "quadDivergentImplicitLod" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = VkBool32 type FieldOptional "quadDivergentImplicitLod" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "quadDivergentImplicitLod" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, quadDivergentImplicitLod} type FieldIsArray "quadDivergentImplicitLod" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, quadDivergentImplicitLod} instance {-# OVERLAPPING #-} CanReadField "quadDivergentImplicitLod" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, quadDivergentImplicitLod}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, quadDivergentImplicitLod} instance {-# OVERLAPPING #-} CanWriteField "quadDivergentImplicitLod" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, quadDivergentImplicitLod} instance {-# OVERLAPPING #-} HasField "maxPerStageDescriptorUpdateAfterBindSamplers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type FieldType "maxPerStageDescriptorUpdateAfterBindSamplers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = Word32 type FieldOptional "maxPerStageDescriptorUpdateAfterBindSamplers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "maxPerStageDescriptorUpdateAfterBindSamplers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindSamplers} type FieldIsArray "maxPerStageDescriptorUpdateAfterBindSamplers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindSamplers} instance {-# OVERLAPPING #-} CanReadField "maxPerStageDescriptorUpdateAfterBindSamplers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindSamplers}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindSamplers} instance {-# OVERLAPPING #-} CanWriteField "maxPerStageDescriptorUpdateAfterBindSamplers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindSamplers} instance {-# OVERLAPPING #-} HasField "maxPerStageDescriptorUpdateAfterBindUniformBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type FieldType "maxPerStageDescriptorUpdateAfterBindUniformBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = Word32 type FieldOptional "maxPerStageDescriptorUpdateAfterBindUniformBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "maxPerStageDescriptorUpdateAfterBindUniformBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindUniformBuffers} type FieldIsArray "maxPerStageDescriptorUpdateAfterBindUniformBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindUniformBuffers} instance {-# OVERLAPPING #-} CanReadField "maxPerStageDescriptorUpdateAfterBindUniformBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindUniformBuffers}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindUniformBuffers} instance {-# OVERLAPPING #-} CanWriteField "maxPerStageDescriptorUpdateAfterBindUniformBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindUniformBuffers} instance {-# OVERLAPPING #-} HasField "maxPerStageDescriptorUpdateAfterBindStorageBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type FieldType "maxPerStageDescriptorUpdateAfterBindStorageBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = Word32 type FieldOptional "maxPerStageDescriptorUpdateAfterBindStorageBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "maxPerStageDescriptorUpdateAfterBindStorageBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindStorageBuffers} type FieldIsArray "maxPerStageDescriptorUpdateAfterBindStorageBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindStorageBuffers} instance {-# OVERLAPPING #-} CanReadField "maxPerStageDescriptorUpdateAfterBindStorageBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindStorageBuffers}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindStorageBuffers} instance {-# OVERLAPPING #-} CanWriteField "maxPerStageDescriptorUpdateAfterBindStorageBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindStorageBuffers} instance {-# OVERLAPPING #-} HasField "maxPerStageDescriptorUpdateAfterBindSampledImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type FieldType "maxPerStageDescriptorUpdateAfterBindSampledImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = Word32 type FieldOptional "maxPerStageDescriptorUpdateAfterBindSampledImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "maxPerStageDescriptorUpdateAfterBindSampledImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindSampledImages} type FieldIsArray "maxPerStageDescriptorUpdateAfterBindSampledImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindSampledImages} instance {-# OVERLAPPING #-} CanReadField "maxPerStageDescriptorUpdateAfterBindSampledImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindSampledImages}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindSampledImages} instance {-# OVERLAPPING #-} CanWriteField "maxPerStageDescriptorUpdateAfterBindSampledImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindSampledImages} instance {-# OVERLAPPING #-} HasField "maxPerStageDescriptorUpdateAfterBindStorageImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type FieldType "maxPerStageDescriptorUpdateAfterBindStorageImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = Word32 type FieldOptional "maxPerStageDescriptorUpdateAfterBindStorageImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "maxPerStageDescriptorUpdateAfterBindStorageImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindStorageImages} type FieldIsArray "maxPerStageDescriptorUpdateAfterBindStorageImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindStorageImages} instance {-# OVERLAPPING #-} CanReadField "maxPerStageDescriptorUpdateAfterBindStorageImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindStorageImages}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindStorageImages} instance {-# OVERLAPPING #-} CanWriteField "maxPerStageDescriptorUpdateAfterBindStorageImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindStorageImages} instance {-# OVERLAPPING #-} HasField "maxPerStageDescriptorUpdateAfterBindInputAttachments" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type FieldType "maxPerStageDescriptorUpdateAfterBindInputAttachments" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = Word32 type FieldOptional "maxPerStageDescriptorUpdateAfterBindInputAttachments" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "maxPerStageDescriptorUpdateAfterBindInputAttachments" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindInputAttachments} type FieldIsArray "maxPerStageDescriptorUpdateAfterBindInputAttachments" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindInputAttachments} instance {-# OVERLAPPING #-} CanReadField "maxPerStageDescriptorUpdateAfterBindInputAttachments" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindInputAttachments}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindInputAttachments} instance {-# OVERLAPPING #-} CanWriteField "maxPerStageDescriptorUpdateAfterBindInputAttachments" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageDescriptorUpdateAfterBindInputAttachments} instance {-# OVERLAPPING #-} HasField "maxPerStageUpdateAfterBindResources" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type FieldType "maxPerStageUpdateAfterBindResources" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = Word32 type FieldOptional "maxPerStageUpdateAfterBindResources" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "maxPerStageUpdateAfterBindResources" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageUpdateAfterBindResources} type FieldIsArray "maxPerStageUpdateAfterBindResources" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageUpdateAfterBindResources} instance {-# OVERLAPPING #-} CanReadField "maxPerStageUpdateAfterBindResources" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageUpdateAfterBindResources}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageUpdateAfterBindResources} instance {-# OVERLAPPING #-} CanWriteField "maxPerStageUpdateAfterBindResources" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxPerStageUpdateAfterBindResources} instance {-# OVERLAPPING #-} HasField "maxDescriptorSetUpdateAfterBindSamplers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type FieldType "maxDescriptorSetUpdateAfterBindSamplers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = Word32 type FieldOptional "maxDescriptorSetUpdateAfterBindSamplers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "maxDescriptorSetUpdateAfterBindSamplers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindSamplers} type FieldIsArray "maxDescriptorSetUpdateAfterBindSamplers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindSamplers} instance {-# OVERLAPPING #-} CanReadField "maxDescriptorSetUpdateAfterBindSamplers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindSamplers}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindSamplers} instance {-# OVERLAPPING #-} CanWriteField "maxDescriptorSetUpdateAfterBindSamplers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindSamplers} instance {-# OVERLAPPING #-} HasField "maxDescriptorSetUpdateAfterBindUniformBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type FieldType "maxDescriptorSetUpdateAfterBindUniformBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = Word32 type FieldOptional "maxDescriptorSetUpdateAfterBindUniformBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "maxDescriptorSetUpdateAfterBindUniformBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindUniformBuffers} type FieldIsArray "maxDescriptorSetUpdateAfterBindUniformBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindUniformBuffers} instance {-# OVERLAPPING #-} CanReadField "maxDescriptorSetUpdateAfterBindUniformBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindUniformBuffers}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindUniformBuffers} instance {-# OVERLAPPING #-} CanWriteField "maxDescriptorSetUpdateAfterBindUniformBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindUniformBuffers} instance {-# OVERLAPPING #-} HasField "maxDescriptorSetUpdateAfterBindUniformBuffersDynamic" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type FieldType "maxDescriptorSetUpdateAfterBindUniformBuffersDynamic" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = Word32 type FieldOptional "maxDescriptorSetUpdateAfterBindUniformBuffersDynamic" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "maxDescriptorSetUpdateAfterBindUniformBuffersDynamic" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindUniformBuffersDynamic} type FieldIsArray "maxDescriptorSetUpdateAfterBindUniformBuffersDynamic" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindUniformBuffersDynamic} instance {-# OVERLAPPING #-} CanReadField "maxDescriptorSetUpdateAfterBindUniformBuffersDynamic" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindUniformBuffersDynamic}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindUniformBuffersDynamic} instance {-# OVERLAPPING #-} CanWriteField "maxDescriptorSetUpdateAfterBindUniformBuffersDynamic" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindUniformBuffersDynamic} instance {-# OVERLAPPING #-} HasField "maxDescriptorSetUpdateAfterBindStorageBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type FieldType "maxDescriptorSetUpdateAfterBindStorageBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = Word32 type FieldOptional "maxDescriptorSetUpdateAfterBindStorageBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "maxDescriptorSetUpdateAfterBindStorageBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindStorageBuffers} type FieldIsArray "maxDescriptorSetUpdateAfterBindStorageBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindStorageBuffers} instance {-# OVERLAPPING #-} CanReadField "maxDescriptorSetUpdateAfterBindStorageBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindStorageBuffers}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindStorageBuffers} instance {-# OVERLAPPING #-} CanWriteField "maxDescriptorSetUpdateAfterBindStorageBuffers" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindStorageBuffers} instance {-# OVERLAPPING #-} HasField "maxDescriptorSetUpdateAfterBindStorageBuffersDynamic" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type FieldType "maxDescriptorSetUpdateAfterBindStorageBuffersDynamic" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = Word32 type FieldOptional "maxDescriptorSetUpdateAfterBindStorageBuffersDynamic" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "maxDescriptorSetUpdateAfterBindStorageBuffersDynamic" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindStorageBuffersDynamic} type FieldIsArray "maxDescriptorSetUpdateAfterBindStorageBuffersDynamic" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindStorageBuffersDynamic} instance {-# OVERLAPPING #-} CanReadField "maxDescriptorSetUpdateAfterBindStorageBuffersDynamic" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindStorageBuffersDynamic}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindStorageBuffersDynamic} instance {-# OVERLAPPING #-} CanWriteField "maxDescriptorSetUpdateAfterBindStorageBuffersDynamic" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindStorageBuffersDynamic} instance {-# OVERLAPPING #-} HasField "maxDescriptorSetUpdateAfterBindSampledImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type FieldType "maxDescriptorSetUpdateAfterBindSampledImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = Word32 type FieldOptional "maxDescriptorSetUpdateAfterBindSampledImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "maxDescriptorSetUpdateAfterBindSampledImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindSampledImages} type FieldIsArray "maxDescriptorSetUpdateAfterBindSampledImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindSampledImages} instance {-# OVERLAPPING #-} CanReadField "maxDescriptorSetUpdateAfterBindSampledImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindSampledImages}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindSampledImages} instance {-# OVERLAPPING #-} CanWriteField "maxDescriptorSetUpdateAfterBindSampledImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindSampledImages} instance {-# OVERLAPPING #-} HasField "maxDescriptorSetUpdateAfterBindStorageImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type FieldType "maxDescriptorSetUpdateAfterBindStorageImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = Word32 type FieldOptional "maxDescriptorSetUpdateAfterBindStorageImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "maxDescriptorSetUpdateAfterBindStorageImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindStorageImages} type FieldIsArray "maxDescriptorSetUpdateAfterBindStorageImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindStorageImages} instance {-# OVERLAPPING #-} CanReadField "maxDescriptorSetUpdateAfterBindStorageImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindStorageImages}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindStorageImages} instance {-# OVERLAPPING #-} CanWriteField "maxDescriptorSetUpdateAfterBindStorageImages" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindStorageImages} instance {-# OVERLAPPING #-} HasField "maxDescriptorSetUpdateAfterBindInputAttachments" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where type FieldType "maxDescriptorSetUpdateAfterBindInputAttachments" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = Word32 type FieldOptional "maxDescriptorSetUpdateAfterBindInputAttachments" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "maxDescriptorSetUpdateAfterBindInputAttachments" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindInputAttachments} type FieldIsArray "maxDescriptorSetUpdateAfterBindInputAttachments" VkPhysicalDeviceDescriptorIndexingPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindInputAttachments} instance {-# OVERLAPPING #-} CanReadField "maxDescriptorSetUpdateAfterBindInputAttachments" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindInputAttachments}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindInputAttachments} instance {-# OVERLAPPING #-} CanWriteField "maxDescriptorSetUpdateAfterBindInputAttachments" VkPhysicalDeviceDescriptorIndexingPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDescriptorIndexingPropertiesEXT, maxDescriptorSetUpdateAfterBindInputAttachments} instance Show VkPhysicalDeviceDescriptorIndexingPropertiesEXT where showsPrec d x = showString "VkPhysicalDeviceDescriptorIndexingPropertiesEXT {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "maxUpdateAfterBindDescriptorsInAllPools = " . showsPrec d (getField @"maxUpdateAfterBindDescriptorsInAllPools" x) . showString ", " . showString "shaderUniformBufferArrayNonUniformIndexingNative = " . showsPrec d (getField @"shaderUniformBufferArrayNonUniformIndexingNative" x) . showString ", " . showString "shaderSampledImageArrayNonUniformIndexingNative = " . showsPrec d (getField @"shaderSampledImageArrayNonUniformIndexingNative" x) . showString ", " . showString "shaderStorageBufferArrayNonUniformIndexingNative = " . showsPrec d (getField @"shaderStorageBufferArrayNonUniformIndexingNative" x) . showString ", " . showString "shaderStorageImageArrayNonUniformIndexingNative = " . showsPrec d (getField @"shaderStorageImageArrayNonUniformIndexingNative" x) . showString ", " . showString "shaderInputAttachmentArrayNonUniformIndexingNative = " . showsPrec d (getField @"shaderInputAttachmentArrayNonUniformIndexingNative" x) . showString ", " . showString "robustBufferAccessUpdateAfterBind = " . showsPrec d (getField @"robustBufferAccessUpdateAfterBind" x) . showString ", " . showString "quadDivergentImplicitLod = " . showsPrec d (getField @"quadDivergentImplicitLod" x) . showString ", " . showString "maxPerStageDescriptorUpdateAfterBindSamplers = " . showsPrec d (getField @"maxPerStageDescriptorUpdateAfterBindSamplers" x) . showString ", " . showString "maxPerStageDescriptorUpdateAfterBindUniformBuffers = " . showsPrec d (getField @"maxPerStageDescriptorUpdateAfterBindUniformBuffers" x) . showString ", " . showString "maxPerStageDescriptorUpdateAfterBindStorageBuffers = " . showsPrec d (getField @"maxPerStageDescriptorUpdateAfterBindStorageBuffers" x) . showString ", " . showString "maxPerStageDescriptorUpdateAfterBindSampledImages = " . showsPrec d (getField @"maxPerStageDescriptorUpdateAfterBindSampledImages" x) . showString ", " . showString "maxPerStageDescriptorUpdateAfterBindStorageImages = " . showsPrec d (getField @"maxPerStageDescriptorUpdateAfterBindStorageImages" x) . showString ", " . showString "maxPerStageDescriptorUpdateAfterBindInputAttachments = " . showsPrec d (getField @"maxPerStageDescriptorUpdateAfterBindInputAttachments" x) . showString ", " . showString "maxPerStageUpdateAfterBindResources = " . showsPrec d (getField @"maxPerStageUpdateAfterBindResources" x) . showString ", " . showString "maxDescriptorSetUpdateAfterBindSamplers = " . showsPrec d (getField @"maxDescriptorSetUpdateAfterBindSamplers" x) . showString ", " . showString "maxDescriptorSetUpdateAfterBindUniformBuffers = " . showsPrec d (getField @"maxDescriptorSetUpdateAfterBindUniformBuffers" x) . showString ", " . showString "maxDescriptorSetUpdateAfterBindUniformBuffersDynamic = " . showsPrec d (getField @"maxDescriptorSetUpdateAfterBindUniformBuffersDynamic" x) . showString ", " . showString "maxDescriptorSetUpdateAfterBindStorageBuffers = " . showsPrec d (getField @"maxDescriptorSetUpdateAfterBindStorageBuffers" x) . showString ", " . showString "maxDescriptorSetUpdateAfterBindStorageBuffersDynamic = " . showsPrec d (getField @"maxDescriptorSetUpdateAfterBindStorageBuffersDynamic" x) . showString ", " . showString "maxDescriptorSetUpdateAfterBindSampledImages = " . showsPrec d (getField @"maxDescriptorSetUpdateAfterBindSampledImages" x) . showString ", " . showString "maxDescriptorSetUpdateAfterBindStorageImages = " . showsPrec d (getField @"maxDescriptorSetUpdateAfterBindStorageImages" x) . showString ", " . showString "maxDescriptorSetUpdateAfterBindInputAttachments = " . showsPrec d (getField @"maxDescriptorSetUpdateAfterBindInputAttachments" x) . showChar '}' -- | > typedef struct VkPhysicalDeviceDiscardRectanglePropertiesEXT { -- > VkStructureType sType; -- > void* pNext; -- > uint32_t maxDiscardRectangles; -- > } VkPhysicalDeviceDiscardRectanglePropertiesEXT; -- -- data VkPhysicalDeviceDiscardRectanglePropertiesEXT = VkPhysicalDeviceDiscardRectanglePropertiesEXT## Addr## ByteArray## instance Eq VkPhysicalDeviceDiscardRectanglePropertiesEXT where (VkPhysicalDeviceDiscardRectanglePropertiesEXT## a _) == x@(VkPhysicalDeviceDiscardRectanglePropertiesEXT## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceDiscardRectanglePropertiesEXT where (VkPhysicalDeviceDiscardRectanglePropertiesEXT## a _) `compare` x@(VkPhysicalDeviceDiscardRectanglePropertiesEXT## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceDiscardRectanglePropertiesEXT where sizeOf ~_ = #{size VkPhysicalDeviceDiscardRectanglePropertiesEXT} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceDiscardRectanglePropertiesEXT} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceDiscardRectanglePropertiesEXT where unsafeAddr (VkPhysicalDeviceDiscardRectanglePropertiesEXT## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceDiscardRectanglePropertiesEXT## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceDiscardRectanglePropertiesEXT## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceDiscardRectanglePropertiesEXT where type StructFields VkPhysicalDeviceDiscardRectanglePropertiesEXT = '["sType", "pNext", "maxDiscardRectangles"] -- ' closing tick for hsc2hs type CUnionType VkPhysicalDeviceDiscardRectanglePropertiesEXT = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceDiscardRectanglePropertiesEXT = 'False -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceDiscardRectanglePropertiesEXT = '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceDiscardRectanglePropertiesEXT where type FieldType "sType" VkPhysicalDeviceDiscardRectanglePropertiesEXT = VkStructureType type FieldOptional "sType" VkPhysicalDeviceDiscardRectanglePropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceDiscardRectanglePropertiesEXT = #{offset VkPhysicalDeviceDiscardRectanglePropertiesEXT, sType} type FieldIsArray "sType" VkPhysicalDeviceDiscardRectanglePropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDiscardRectanglePropertiesEXT, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceDiscardRectanglePropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDiscardRectanglePropertiesEXT, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDiscardRectanglePropertiesEXT, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceDiscardRectanglePropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDiscardRectanglePropertiesEXT, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceDiscardRectanglePropertiesEXT where type FieldType "pNext" VkPhysicalDeviceDiscardRectanglePropertiesEXT = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceDiscardRectanglePropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceDiscardRectanglePropertiesEXT = #{offset VkPhysicalDeviceDiscardRectanglePropertiesEXT, pNext} type FieldIsArray "pNext" VkPhysicalDeviceDiscardRectanglePropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDiscardRectanglePropertiesEXT, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceDiscardRectanglePropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDiscardRectanglePropertiesEXT, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDiscardRectanglePropertiesEXT, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceDiscardRectanglePropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDiscardRectanglePropertiesEXT, pNext} instance {-# OVERLAPPING #-} HasField "maxDiscardRectangles" VkPhysicalDeviceDiscardRectanglePropertiesEXT where type FieldType "maxDiscardRectangles" VkPhysicalDeviceDiscardRectanglePropertiesEXT = Word32 type FieldOptional "maxDiscardRectangles" VkPhysicalDeviceDiscardRectanglePropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "maxDiscardRectangles" VkPhysicalDeviceDiscardRectanglePropertiesEXT = #{offset VkPhysicalDeviceDiscardRectanglePropertiesEXT, maxDiscardRectangles} type FieldIsArray "maxDiscardRectangles" VkPhysicalDeviceDiscardRectanglePropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceDiscardRectanglePropertiesEXT, maxDiscardRectangles} instance {-# OVERLAPPING #-} CanReadField "maxDiscardRectangles" VkPhysicalDeviceDiscardRectanglePropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceDiscardRectanglePropertiesEXT, maxDiscardRectangles}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceDiscardRectanglePropertiesEXT, maxDiscardRectangles} instance {-# OVERLAPPING #-} CanWriteField "maxDiscardRectangles" VkPhysicalDeviceDiscardRectanglePropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceDiscardRectanglePropertiesEXT, maxDiscardRectangles} instance Show VkPhysicalDeviceDiscardRectanglePropertiesEXT where showsPrec d x = showString "VkPhysicalDeviceDiscardRectanglePropertiesEXT {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "maxDiscardRectangles = " . showsPrec d (getField @"maxDiscardRectangles" x) . showChar '}' -- | > typedef struct VkPhysicalDeviceExternalBufferInfo { -- > VkStructureType sType; -- > const void* pNext; -- > VkBufferCreateFlags flags; -- > VkBufferUsageFlags usage; -- > VkExternalMemoryHandleTypeFlagBits handleType; -- > } VkPhysicalDeviceExternalBufferInfo; -- -- data VkPhysicalDeviceExternalBufferInfo = VkPhysicalDeviceExternalBufferInfo## Addr## ByteArray## instance Eq VkPhysicalDeviceExternalBufferInfo where (VkPhysicalDeviceExternalBufferInfo## a _) == x@(VkPhysicalDeviceExternalBufferInfo## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceExternalBufferInfo where (VkPhysicalDeviceExternalBufferInfo## a _) `compare` x@(VkPhysicalDeviceExternalBufferInfo## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceExternalBufferInfo where sizeOf ~_ = #{size VkPhysicalDeviceExternalBufferInfo} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceExternalBufferInfo} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceExternalBufferInfo where unsafeAddr (VkPhysicalDeviceExternalBufferInfo## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceExternalBufferInfo## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceExternalBufferInfo## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceExternalBufferInfo where type StructFields VkPhysicalDeviceExternalBufferInfo = '["sType", "pNext", "flags", "usage", "handleType"] -- ' closing tick for hsc2hs type CUnionType VkPhysicalDeviceExternalBufferInfo = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceExternalBufferInfo = 'False -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceExternalBufferInfo = '[] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceExternalBufferInfo where type FieldType "sType" VkPhysicalDeviceExternalBufferInfo = VkStructureType type FieldOptional "sType" VkPhysicalDeviceExternalBufferInfo = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceExternalBufferInfo = #{offset VkPhysicalDeviceExternalBufferInfo, sType} type FieldIsArray "sType" VkPhysicalDeviceExternalBufferInfo = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceExternalBufferInfo, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceExternalBufferInfo where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceExternalBufferInfo, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceExternalBufferInfo, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceExternalBufferInfo where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceExternalBufferInfo, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceExternalBufferInfo where type FieldType "pNext" VkPhysicalDeviceExternalBufferInfo = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceExternalBufferInfo = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceExternalBufferInfo = #{offset VkPhysicalDeviceExternalBufferInfo, pNext} type FieldIsArray "pNext" VkPhysicalDeviceExternalBufferInfo = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceExternalBufferInfo, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceExternalBufferInfo where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceExternalBufferInfo, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceExternalBufferInfo, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceExternalBufferInfo where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceExternalBufferInfo, pNext} instance {-# OVERLAPPING #-} HasField "flags" VkPhysicalDeviceExternalBufferInfo where type FieldType "flags" VkPhysicalDeviceExternalBufferInfo = VkBufferCreateFlags type FieldOptional "flags" VkPhysicalDeviceExternalBufferInfo = 'True -- ' closing tick for hsc2hs type FieldOffset "flags" VkPhysicalDeviceExternalBufferInfo = #{offset VkPhysicalDeviceExternalBufferInfo, flags} type FieldIsArray "flags" VkPhysicalDeviceExternalBufferInfo = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = True {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceExternalBufferInfo, flags} instance {-# OVERLAPPING #-} CanReadField "flags" VkPhysicalDeviceExternalBufferInfo where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceExternalBufferInfo, flags}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceExternalBufferInfo, flags} instance {-# OVERLAPPING #-} CanWriteField "flags" VkPhysicalDeviceExternalBufferInfo where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceExternalBufferInfo, flags} instance {-# OVERLAPPING #-} HasField "usage" VkPhysicalDeviceExternalBufferInfo where type FieldType "usage" VkPhysicalDeviceExternalBufferInfo = VkBufferUsageFlags type FieldOptional "usage" VkPhysicalDeviceExternalBufferInfo = 'False -- ' closing tick for hsc2hs type FieldOffset "usage" VkPhysicalDeviceExternalBufferInfo = #{offset VkPhysicalDeviceExternalBufferInfo, usage} type FieldIsArray "usage" VkPhysicalDeviceExternalBufferInfo = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceExternalBufferInfo, usage} instance {-# OVERLAPPING #-} CanReadField "usage" VkPhysicalDeviceExternalBufferInfo where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceExternalBufferInfo, usage}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceExternalBufferInfo, usage} instance {-# OVERLAPPING #-} CanWriteField "usage" VkPhysicalDeviceExternalBufferInfo where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceExternalBufferInfo, usage} instance {-# OVERLAPPING #-} HasField "handleType" VkPhysicalDeviceExternalBufferInfo where type FieldType "handleType" VkPhysicalDeviceExternalBufferInfo = VkExternalMemoryHandleTypeFlagBits type FieldOptional "handleType" VkPhysicalDeviceExternalBufferInfo = 'False -- ' closing tick for hsc2hs type FieldOffset "handleType" VkPhysicalDeviceExternalBufferInfo = #{offset VkPhysicalDeviceExternalBufferInfo, handleType} type FieldIsArray "handleType" VkPhysicalDeviceExternalBufferInfo = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceExternalBufferInfo, handleType} instance {-# OVERLAPPING #-} CanReadField "handleType" VkPhysicalDeviceExternalBufferInfo where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceExternalBufferInfo, handleType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceExternalBufferInfo, handleType} instance {-# OVERLAPPING #-} CanWriteField "handleType" VkPhysicalDeviceExternalBufferInfo where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceExternalBufferInfo, handleType} instance Show VkPhysicalDeviceExternalBufferInfo where showsPrec d x = showString "VkPhysicalDeviceExternalBufferInfo {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "flags = " . showsPrec d (getField @"flags" x) . showString ", " . showString "usage = " . showsPrec d (getField @"usage" x) . showString ", " . showString "handleType = " . showsPrec d (getField @"handleType" x) . showChar '}' -- | Alias for `VkPhysicalDeviceExternalBufferInfo` type VkPhysicalDeviceExternalBufferInfoKHR = VkPhysicalDeviceExternalBufferInfo -- | > typedef struct VkPhysicalDeviceExternalFenceInfo { -- > VkStructureType sType; -- > const void* pNext; -- > VkExternalFenceHandleTypeFlagBits handleType; -- > } VkPhysicalDeviceExternalFenceInfo; -- -- data VkPhysicalDeviceExternalFenceInfo = VkPhysicalDeviceExternalFenceInfo## Addr## ByteArray## instance Eq VkPhysicalDeviceExternalFenceInfo where (VkPhysicalDeviceExternalFenceInfo## a _) == x@(VkPhysicalDeviceExternalFenceInfo## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceExternalFenceInfo where (VkPhysicalDeviceExternalFenceInfo## a _) `compare` x@(VkPhysicalDeviceExternalFenceInfo## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceExternalFenceInfo where sizeOf ~_ = #{size VkPhysicalDeviceExternalFenceInfo} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceExternalFenceInfo} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceExternalFenceInfo where unsafeAddr (VkPhysicalDeviceExternalFenceInfo## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceExternalFenceInfo## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceExternalFenceInfo## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceExternalFenceInfo where type StructFields VkPhysicalDeviceExternalFenceInfo = '["sType", "pNext", "handleType"] -- ' closing tick for hsc2hs type CUnionType VkPhysicalDeviceExternalFenceInfo = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceExternalFenceInfo = 'False -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceExternalFenceInfo = '[] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceExternalFenceInfo where type FieldType "sType" VkPhysicalDeviceExternalFenceInfo = VkStructureType type FieldOptional "sType" VkPhysicalDeviceExternalFenceInfo = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceExternalFenceInfo = #{offset VkPhysicalDeviceExternalFenceInfo, sType} type FieldIsArray "sType" VkPhysicalDeviceExternalFenceInfo = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceExternalFenceInfo, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceExternalFenceInfo where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceExternalFenceInfo, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceExternalFenceInfo, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceExternalFenceInfo where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceExternalFenceInfo, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceExternalFenceInfo where type FieldType "pNext" VkPhysicalDeviceExternalFenceInfo = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceExternalFenceInfo = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceExternalFenceInfo = #{offset VkPhysicalDeviceExternalFenceInfo, pNext} type FieldIsArray "pNext" VkPhysicalDeviceExternalFenceInfo = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceExternalFenceInfo, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceExternalFenceInfo where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceExternalFenceInfo, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceExternalFenceInfo, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceExternalFenceInfo where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceExternalFenceInfo, pNext} instance {-# OVERLAPPING #-} HasField "handleType" VkPhysicalDeviceExternalFenceInfo where type FieldType "handleType" VkPhysicalDeviceExternalFenceInfo = VkExternalFenceHandleTypeFlagBits type FieldOptional "handleType" VkPhysicalDeviceExternalFenceInfo = 'False -- ' closing tick for hsc2hs type FieldOffset "handleType" VkPhysicalDeviceExternalFenceInfo = #{offset VkPhysicalDeviceExternalFenceInfo, handleType} type FieldIsArray "handleType" VkPhysicalDeviceExternalFenceInfo = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceExternalFenceInfo, handleType} instance {-# OVERLAPPING #-} CanReadField "handleType" VkPhysicalDeviceExternalFenceInfo where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceExternalFenceInfo, handleType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceExternalFenceInfo, handleType} instance {-# OVERLAPPING #-} CanWriteField "handleType" VkPhysicalDeviceExternalFenceInfo where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceExternalFenceInfo, handleType} instance Show VkPhysicalDeviceExternalFenceInfo where showsPrec d x = showString "VkPhysicalDeviceExternalFenceInfo {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "handleType = " . showsPrec d (getField @"handleType" x) . showChar '}' -- | Alias for `VkPhysicalDeviceExternalFenceInfo` type VkPhysicalDeviceExternalFenceInfoKHR = VkPhysicalDeviceExternalFenceInfo -- | > typedef struct VkPhysicalDeviceExternalImageFormatInfo { -- > VkStructureType sType; -- > const void* pNext; -- > VkExternalMemoryHandleTypeFlagBits handleType; -- > } VkPhysicalDeviceExternalImageFormatInfo; -- -- data VkPhysicalDeviceExternalImageFormatInfo = VkPhysicalDeviceExternalImageFormatInfo## Addr## ByteArray## instance Eq VkPhysicalDeviceExternalImageFormatInfo where (VkPhysicalDeviceExternalImageFormatInfo## a _) == x@(VkPhysicalDeviceExternalImageFormatInfo## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceExternalImageFormatInfo where (VkPhysicalDeviceExternalImageFormatInfo## a _) `compare` x@(VkPhysicalDeviceExternalImageFormatInfo## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceExternalImageFormatInfo where sizeOf ~_ = #{size VkPhysicalDeviceExternalImageFormatInfo} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceExternalImageFormatInfo} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceExternalImageFormatInfo where unsafeAddr (VkPhysicalDeviceExternalImageFormatInfo## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceExternalImageFormatInfo## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceExternalImageFormatInfo## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceExternalImageFormatInfo where type StructFields VkPhysicalDeviceExternalImageFormatInfo = '["sType", "pNext", "handleType"] -- ' closing tick for hsc2hs type CUnionType VkPhysicalDeviceExternalImageFormatInfo = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceExternalImageFormatInfo = 'False -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceExternalImageFormatInfo = '[VkPhysicalDeviceImageFormatInfo2] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceExternalImageFormatInfo where type FieldType "sType" VkPhysicalDeviceExternalImageFormatInfo = VkStructureType type FieldOptional "sType" VkPhysicalDeviceExternalImageFormatInfo = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceExternalImageFormatInfo = #{offset VkPhysicalDeviceExternalImageFormatInfo, sType} type FieldIsArray "sType" VkPhysicalDeviceExternalImageFormatInfo = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceExternalImageFormatInfo, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceExternalImageFormatInfo where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceExternalImageFormatInfo, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceExternalImageFormatInfo, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceExternalImageFormatInfo where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceExternalImageFormatInfo, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceExternalImageFormatInfo where type FieldType "pNext" VkPhysicalDeviceExternalImageFormatInfo = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceExternalImageFormatInfo = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceExternalImageFormatInfo = #{offset VkPhysicalDeviceExternalImageFormatInfo, pNext} type FieldIsArray "pNext" VkPhysicalDeviceExternalImageFormatInfo = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceExternalImageFormatInfo, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceExternalImageFormatInfo where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceExternalImageFormatInfo, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceExternalImageFormatInfo, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceExternalImageFormatInfo where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceExternalImageFormatInfo, pNext} instance {-# OVERLAPPING #-} HasField "handleType" VkPhysicalDeviceExternalImageFormatInfo where type FieldType "handleType" VkPhysicalDeviceExternalImageFormatInfo = VkExternalMemoryHandleTypeFlagBits type FieldOptional "handleType" VkPhysicalDeviceExternalImageFormatInfo = 'True -- ' closing tick for hsc2hs type FieldOffset "handleType" VkPhysicalDeviceExternalImageFormatInfo = #{offset VkPhysicalDeviceExternalImageFormatInfo, handleType} type FieldIsArray "handleType" VkPhysicalDeviceExternalImageFormatInfo = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = True {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceExternalImageFormatInfo, handleType} instance {-# OVERLAPPING #-} CanReadField "handleType" VkPhysicalDeviceExternalImageFormatInfo where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceExternalImageFormatInfo, handleType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceExternalImageFormatInfo, handleType} instance {-# OVERLAPPING #-} CanWriteField "handleType" VkPhysicalDeviceExternalImageFormatInfo where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceExternalImageFormatInfo, handleType} instance Show VkPhysicalDeviceExternalImageFormatInfo where showsPrec d x = showString "VkPhysicalDeviceExternalImageFormatInfo {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "handleType = " . showsPrec d (getField @"handleType" x) . showChar '}' -- | Alias for `VkPhysicalDeviceExternalImageFormatInfo` type VkPhysicalDeviceExternalImageFormatInfoKHR = VkPhysicalDeviceExternalImageFormatInfo -- | > typedef struct VkPhysicalDeviceExternalMemoryHostPropertiesEXT { -- > VkStructureType sType; -- > void* pNext; -- > VkDeviceSize minImportedHostPointerAlignment; -- > } VkPhysicalDeviceExternalMemoryHostPropertiesEXT; -- -- data VkPhysicalDeviceExternalMemoryHostPropertiesEXT = VkPhysicalDeviceExternalMemoryHostPropertiesEXT## Addr## ByteArray## instance Eq VkPhysicalDeviceExternalMemoryHostPropertiesEXT where (VkPhysicalDeviceExternalMemoryHostPropertiesEXT## a _) == x@(VkPhysicalDeviceExternalMemoryHostPropertiesEXT## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceExternalMemoryHostPropertiesEXT where (VkPhysicalDeviceExternalMemoryHostPropertiesEXT## a _) `compare` x@(VkPhysicalDeviceExternalMemoryHostPropertiesEXT## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceExternalMemoryHostPropertiesEXT where sizeOf ~_ = #{size VkPhysicalDeviceExternalMemoryHostPropertiesEXT} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceExternalMemoryHostPropertiesEXT} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceExternalMemoryHostPropertiesEXT where unsafeAddr (VkPhysicalDeviceExternalMemoryHostPropertiesEXT## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceExternalMemoryHostPropertiesEXT## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceExternalMemoryHostPropertiesEXT## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceExternalMemoryHostPropertiesEXT where type StructFields VkPhysicalDeviceExternalMemoryHostPropertiesEXT = '["sType", "pNext", "minImportedHostPointerAlignment"] -- ' closing tick for hsc2hs type CUnionType VkPhysicalDeviceExternalMemoryHostPropertiesEXT = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceExternalMemoryHostPropertiesEXT = 'False -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceExternalMemoryHostPropertiesEXT = '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceExternalMemoryHostPropertiesEXT where type FieldType "sType" VkPhysicalDeviceExternalMemoryHostPropertiesEXT = VkStructureType type FieldOptional "sType" VkPhysicalDeviceExternalMemoryHostPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceExternalMemoryHostPropertiesEXT = #{offset VkPhysicalDeviceExternalMemoryHostPropertiesEXT, sType} type FieldIsArray "sType" VkPhysicalDeviceExternalMemoryHostPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceExternalMemoryHostPropertiesEXT, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceExternalMemoryHostPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceExternalMemoryHostPropertiesEXT, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceExternalMemoryHostPropertiesEXT, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceExternalMemoryHostPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceExternalMemoryHostPropertiesEXT, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceExternalMemoryHostPropertiesEXT where type FieldType "pNext" VkPhysicalDeviceExternalMemoryHostPropertiesEXT = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceExternalMemoryHostPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceExternalMemoryHostPropertiesEXT = #{offset VkPhysicalDeviceExternalMemoryHostPropertiesEXT, pNext} type FieldIsArray "pNext" VkPhysicalDeviceExternalMemoryHostPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceExternalMemoryHostPropertiesEXT, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceExternalMemoryHostPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceExternalMemoryHostPropertiesEXT, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceExternalMemoryHostPropertiesEXT, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceExternalMemoryHostPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceExternalMemoryHostPropertiesEXT, pNext} instance {-# OVERLAPPING #-} HasField "minImportedHostPointerAlignment" VkPhysicalDeviceExternalMemoryHostPropertiesEXT where type FieldType "minImportedHostPointerAlignment" VkPhysicalDeviceExternalMemoryHostPropertiesEXT = VkDeviceSize type FieldOptional "minImportedHostPointerAlignment" VkPhysicalDeviceExternalMemoryHostPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "minImportedHostPointerAlignment" VkPhysicalDeviceExternalMemoryHostPropertiesEXT = #{offset VkPhysicalDeviceExternalMemoryHostPropertiesEXT, minImportedHostPointerAlignment} type FieldIsArray "minImportedHostPointerAlignment" VkPhysicalDeviceExternalMemoryHostPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceExternalMemoryHostPropertiesEXT, minImportedHostPointerAlignment} instance {-# OVERLAPPING #-} CanReadField "minImportedHostPointerAlignment" VkPhysicalDeviceExternalMemoryHostPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceExternalMemoryHostPropertiesEXT, minImportedHostPointerAlignment}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceExternalMemoryHostPropertiesEXT, minImportedHostPointerAlignment} instance {-# OVERLAPPING #-} CanWriteField "minImportedHostPointerAlignment" VkPhysicalDeviceExternalMemoryHostPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceExternalMemoryHostPropertiesEXT, minImportedHostPointerAlignment} instance Show VkPhysicalDeviceExternalMemoryHostPropertiesEXT where showsPrec d x = showString "VkPhysicalDeviceExternalMemoryHostPropertiesEXT {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "minImportedHostPointerAlignment = " . showsPrec d (getField @"minImportedHostPointerAlignment" x) . showChar '}' -- | > typedef struct VkPhysicalDeviceExternalSemaphoreInfo { -- > VkStructureType sType; -- > const void* pNext; -- > VkExternalSemaphoreHandleTypeFlagBits handleType; -- > } VkPhysicalDeviceExternalSemaphoreInfo; -- -- data VkPhysicalDeviceExternalSemaphoreInfo = VkPhysicalDeviceExternalSemaphoreInfo## Addr## ByteArray## instance Eq VkPhysicalDeviceExternalSemaphoreInfo where (VkPhysicalDeviceExternalSemaphoreInfo## a _) == x@(VkPhysicalDeviceExternalSemaphoreInfo## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceExternalSemaphoreInfo where (VkPhysicalDeviceExternalSemaphoreInfo## a _) `compare` x@(VkPhysicalDeviceExternalSemaphoreInfo## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceExternalSemaphoreInfo where sizeOf ~_ = #{size VkPhysicalDeviceExternalSemaphoreInfo} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceExternalSemaphoreInfo} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceExternalSemaphoreInfo where unsafeAddr (VkPhysicalDeviceExternalSemaphoreInfo## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceExternalSemaphoreInfo## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceExternalSemaphoreInfo## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceExternalSemaphoreInfo where type StructFields VkPhysicalDeviceExternalSemaphoreInfo = '["sType", "pNext", "handleType"] -- ' closing tick for hsc2hs type CUnionType VkPhysicalDeviceExternalSemaphoreInfo = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceExternalSemaphoreInfo = 'False -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceExternalSemaphoreInfo = '[] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceExternalSemaphoreInfo where type FieldType "sType" VkPhysicalDeviceExternalSemaphoreInfo = VkStructureType type FieldOptional "sType" VkPhysicalDeviceExternalSemaphoreInfo = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceExternalSemaphoreInfo = #{offset VkPhysicalDeviceExternalSemaphoreInfo, sType} type FieldIsArray "sType" VkPhysicalDeviceExternalSemaphoreInfo = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceExternalSemaphoreInfo, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceExternalSemaphoreInfo where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceExternalSemaphoreInfo, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceExternalSemaphoreInfo, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceExternalSemaphoreInfo where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceExternalSemaphoreInfo, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceExternalSemaphoreInfo where type FieldType "pNext" VkPhysicalDeviceExternalSemaphoreInfo = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceExternalSemaphoreInfo = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceExternalSemaphoreInfo = #{offset VkPhysicalDeviceExternalSemaphoreInfo, pNext} type FieldIsArray "pNext" VkPhysicalDeviceExternalSemaphoreInfo = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceExternalSemaphoreInfo, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceExternalSemaphoreInfo where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceExternalSemaphoreInfo, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceExternalSemaphoreInfo, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceExternalSemaphoreInfo where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceExternalSemaphoreInfo, pNext} instance {-# OVERLAPPING #-} HasField "handleType" VkPhysicalDeviceExternalSemaphoreInfo where type FieldType "handleType" VkPhysicalDeviceExternalSemaphoreInfo = VkExternalSemaphoreHandleTypeFlagBits type FieldOptional "handleType" VkPhysicalDeviceExternalSemaphoreInfo = 'False -- ' closing tick for hsc2hs type FieldOffset "handleType" VkPhysicalDeviceExternalSemaphoreInfo = #{offset VkPhysicalDeviceExternalSemaphoreInfo, handleType} type FieldIsArray "handleType" VkPhysicalDeviceExternalSemaphoreInfo = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceExternalSemaphoreInfo, handleType} instance {-# OVERLAPPING #-} CanReadField "handleType" VkPhysicalDeviceExternalSemaphoreInfo where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceExternalSemaphoreInfo, handleType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceExternalSemaphoreInfo, handleType} instance {-# OVERLAPPING #-} CanWriteField "handleType" VkPhysicalDeviceExternalSemaphoreInfo where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceExternalSemaphoreInfo, handleType} instance Show VkPhysicalDeviceExternalSemaphoreInfo where showsPrec d x = showString "VkPhysicalDeviceExternalSemaphoreInfo {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "handleType = " . showsPrec d (getField @"handleType" x) . showChar '}' -- | Alias for `VkPhysicalDeviceExternalSemaphoreInfo` type VkPhysicalDeviceExternalSemaphoreInfoKHR = VkPhysicalDeviceExternalSemaphoreInfo -- | > typedef struct VkPhysicalDeviceFeatures2 { -- > VkStructureType sType; -- > void* pNext; -- > VkPhysicalDeviceFeatures features; -- > } VkPhysicalDeviceFeatures2; -- -- data VkPhysicalDeviceFeatures2 = VkPhysicalDeviceFeatures2## Addr## ByteArray## instance Eq VkPhysicalDeviceFeatures2 where (VkPhysicalDeviceFeatures2## a _) == x@(VkPhysicalDeviceFeatures2## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceFeatures2 where (VkPhysicalDeviceFeatures2## a _) `compare` x@(VkPhysicalDeviceFeatures2## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceFeatures2 where sizeOf ~_ = #{size VkPhysicalDeviceFeatures2} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceFeatures2} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceFeatures2 where unsafeAddr (VkPhysicalDeviceFeatures2## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceFeatures2## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceFeatures2## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceFeatures2 where type StructFields VkPhysicalDeviceFeatures2 = '["sType", "pNext", "features"] -- ' closing tick for hsc2hs type CUnionType VkPhysicalDeviceFeatures2 = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceFeatures2 = 'False -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceFeatures2 = '[VkDeviceCreateInfo] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceFeatures2 where type FieldType "sType" VkPhysicalDeviceFeatures2 = VkStructureType type FieldOptional "sType" VkPhysicalDeviceFeatures2 = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceFeatures2 = #{offset VkPhysicalDeviceFeatures2, sType} type FieldIsArray "sType" VkPhysicalDeviceFeatures2 = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceFeatures2, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceFeatures2 where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceFeatures2, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceFeatures2, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceFeatures2 where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceFeatures2, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceFeatures2 where type FieldType "pNext" VkPhysicalDeviceFeatures2 = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceFeatures2 = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceFeatures2 = #{offset VkPhysicalDeviceFeatures2, pNext} type FieldIsArray "pNext" VkPhysicalDeviceFeatures2 = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceFeatures2, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceFeatures2 where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceFeatures2, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceFeatures2, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceFeatures2 where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceFeatures2, pNext} instance {-# OVERLAPPING #-} HasField "features" VkPhysicalDeviceFeatures2 where type FieldType "features" VkPhysicalDeviceFeatures2 = VkPhysicalDeviceFeatures type FieldOptional "features" VkPhysicalDeviceFeatures2 = 'False -- ' closing tick for hsc2hs type FieldOffset "features" VkPhysicalDeviceFeatures2 = #{offset VkPhysicalDeviceFeatures2, features} type FieldIsArray "features" VkPhysicalDeviceFeatures2 = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceFeatures2, features} instance {-# OVERLAPPING #-} CanReadField "features" VkPhysicalDeviceFeatures2 where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceFeatures2, features}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceFeatures2, features} instance {-# OVERLAPPING #-} CanWriteField "features" VkPhysicalDeviceFeatures2 where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceFeatures2, features} instance Show VkPhysicalDeviceFeatures2 where showsPrec d x = showString "VkPhysicalDeviceFeatures2 {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "features = " . showsPrec d (getField @"features" x) . showChar '}' -- | Alias for `VkPhysicalDeviceFeatures2` type VkPhysicalDeviceFeatures2KHR = VkPhysicalDeviceFeatures2 -- | > typedef struct VkPhysicalDeviceGroupProperties { -- > VkStructureType sType; -- > void* pNext; -- > uint32_t physicalDeviceCount; -- > VkPhysicalDevice physicalDevices[VK_MAX_DEVICE_GROUP_SIZE]; -- > VkBool32 subsetAllocation; -- > } VkPhysicalDeviceGroupProperties; -- -- data VkPhysicalDeviceGroupProperties = VkPhysicalDeviceGroupProperties## Addr## ByteArray## instance Eq VkPhysicalDeviceGroupProperties where (VkPhysicalDeviceGroupProperties## a _) == x@(VkPhysicalDeviceGroupProperties## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceGroupProperties where (VkPhysicalDeviceGroupProperties## a _) `compare` x@(VkPhysicalDeviceGroupProperties## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceGroupProperties where sizeOf ~_ = #{size VkPhysicalDeviceGroupProperties} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceGroupProperties} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceGroupProperties where unsafeAddr (VkPhysicalDeviceGroupProperties## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceGroupProperties## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceGroupProperties## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceGroupProperties where type StructFields VkPhysicalDeviceGroupProperties = '["sType", "pNext", "physicalDeviceCount", "physicalDevices", -- ' closing tick for hsc2hs "subsetAllocation"] type CUnionType VkPhysicalDeviceGroupProperties = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceGroupProperties = 'True -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceGroupProperties = '[] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceGroupProperties where type FieldType "sType" VkPhysicalDeviceGroupProperties = VkStructureType type FieldOptional "sType" VkPhysicalDeviceGroupProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceGroupProperties = #{offset VkPhysicalDeviceGroupProperties, sType} type FieldIsArray "sType" VkPhysicalDeviceGroupProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceGroupProperties, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceGroupProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceGroupProperties, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceGroupProperties, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceGroupProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceGroupProperties, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceGroupProperties where type FieldType "pNext" VkPhysicalDeviceGroupProperties = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceGroupProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceGroupProperties = #{offset VkPhysicalDeviceGroupProperties, pNext} type FieldIsArray "pNext" VkPhysicalDeviceGroupProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceGroupProperties, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceGroupProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceGroupProperties, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceGroupProperties, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceGroupProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceGroupProperties, pNext} instance {-# OVERLAPPING #-} HasField "physicalDeviceCount" VkPhysicalDeviceGroupProperties where type FieldType "physicalDeviceCount" VkPhysicalDeviceGroupProperties = Word32 type FieldOptional "physicalDeviceCount" VkPhysicalDeviceGroupProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "physicalDeviceCount" VkPhysicalDeviceGroupProperties = #{offset VkPhysicalDeviceGroupProperties, physicalDeviceCount} type FieldIsArray "physicalDeviceCount" VkPhysicalDeviceGroupProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceGroupProperties, physicalDeviceCount} instance {-# OVERLAPPING #-} CanReadField "physicalDeviceCount" VkPhysicalDeviceGroupProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceGroupProperties, physicalDeviceCount}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceGroupProperties, physicalDeviceCount} instance {-# OVERLAPPING #-} CanWriteField "physicalDeviceCount" VkPhysicalDeviceGroupProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceGroupProperties, physicalDeviceCount} instance {-# OVERLAPPING #-} HasField "physicalDevices" VkPhysicalDeviceGroupProperties where type FieldType "physicalDevices" VkPhysicalDeviceGroupProperties = VkPhysicalDevice type FieldOptional "physicalDevices" VkPhysicalDeviceGroupProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "physicalDevices" VkPhysicalDeviceGroupProperties = #{offset VkPhysicalDeviceGroupProperties, physicalDevices} type FieldIsArray "physicalDevices" VkPhysicalDeviceGroupProperties = 'True -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceGroupProperties, physicalDevices} instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "physicalDevices" idx VkPhysicalDeviceGroupProperties) => CanReadFieldArray "physicalDevices" idx VkPhysicalDeviceGroupProperties where {-# SPECIALISE instance CanReadFieldArray "physicalDevices" 0 VkPhysicalDeviceGroupProperties #-} {-# SPECIALISE instance CanReadFieldArray "physicalDevices" 1 VkPhysicalDeviceGroupProperties #-} {-# SPECIALISE instance CanReadFieldArray "physicalDevices" 2 VkPhysicalDeviceGroupProperties #-} {-# SPECIALISE instance CanReadFieldArray "physicalDevices" 3 VkPhysicalDeviceGroupProperties #-} type FieldArrayLength "physicalDevices" VkPhysicalDeviceGroupProperties = VK_MAX_DEVICE_GROUP_SIZE {-# INLINE fieldArrayLength #-} fieldArrayLength = VK_MAX_DEVICE_GROUP_SIZE {-# INLINE getFieldArray #-} getFieldArray = f where {-# NOINLINE f #-} f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off) off = #{offset VkPhysicalDeviceGroupProperties, physicalDevices} + sizeOf (undefined :: VkPhysicalDevice) * fromInteger (natVal' (proxy## :: Proxy## idx)) -- ' closing tick for hsc2hs {-# INLINE readFieldArray #-} readFieldArray p = peekByteOff p (#{offset VkPhysicalDeviceGroupProperties, physicalDevices} + sizeOf (undefined :: VkPhysicalDevice) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "physicalDevices" idx VkPhysicalDeviceGroupProperties) => CanWriteFieldArray "physicalDevices" idx VkPhysicalDeviceGroupProperties where {-# SPECIALISE instance CanWriteFieldArray "physicalDevices" 0 VkPhysicalDeviceGroupProperties #-} {-# SPECIALISE instance CanWriteFieldArray "physicalDevices" 1 VkPhysicalDeviceGroupProperties #-} {-# SPECIALISE instance CanWriteFieldArray "physicalDevices" 2 VkPhysicalDeviceGroupProperties #-} {-# SPECIALISE instance CanWriteFieldArray "physicalDevices" 3 VkPhysicalDeviceGroupProperties #-} {-# INLINE writeFieldArray #-} writeFieldArray p = pokeByteOff p (#{offset VkPhysicalDeviceGroupProperties, physicalDevices} + sizeOf (undefined :: VkPhysicalDevice) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "subsetAllocation" VkPhysicalDeviceGroupProperties where type FieldType "subsetAllocation" VkPhysicalDeviceGroupProperties = VkBool32 type FieldOptional "subsetAllocation" VkPhysicalDeviceGroupProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "subsetAllocation" VkPhysicalDeviceGroupProperties = #{offset VkPhysicalDeviceGroupProperties, subsetAllocation} type FieldIsArray "subsetAllocation" VkPhysicalDeviceGroupProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceGroupProperties, subsetAllocation} instance {-# OVERLAPPING #-} CanReadField "subsetAllocation" VkPhysicalDeviceGroupProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceGroupProperties, subsetAllocation}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceGroupProperties, subsetAllocation} instance {-# OVERLAPPING #-} CanWriteField "subsetAllocation" VkPhysicalDeviceGroupProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceGroupProperties, subsetAllocation} instance Show VkPhysicalDeviceGroupProperties where showsPrec d x = showString "VkPhysicalDeviceGroupProperties {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "physicalDeviceCount = " . showsPrec d (getField @"physicalDeviceCount" x) . showString ", " . (showString "physicalDevices = [" . showsPrec d (let s = sizeOf (undefined :: FieldType "physicalDevices" VkPhysicalDeviceGroupProperties) o = fieldOffset @"physicalDevices" @VkPhysicalDeviceGroupProperties f i = peekByteOff (unsafePtr x) i :: IO (FieldType "physicalDevices" VkPhysicalDeviceGroupProperties) in unsafeDupablePerformIO . mapM f $ map (\ i -> o + i * s) [0 .. VK_MAX_DEVICE_GROUP_SIZE - 1]) . showChar ']') . showString ", " . showString "subsetAllocation = " . showsPrec d (getField @"subsetAllocation" x) . showChar '}' -- | Alias for `VkPhysicalDeviceGroupProperties` type VkPhysicalDeviceGroupPropertiesKHR = VkPhysicalDeviceGroupProperties -- | > typedef struct VkPhysicalDeviceIDProperties { -- > VkStructureType sType; -- > void* pNext; -- > uint8_t deviceUUID[VK_UUID_SIZE]; -- > uint8_t driverUUID[VK_UUID_SIZE]; -- > uint8_t deviceLUID[VK_LUID_SIZE]; -- > uint32_t deviceNodeMask; -- > VkBool32 deviceLUIDValid; -- > } VkPhysicalDeviceIDProperties; -- -- data VkPhysicalDeviceIDProperties = VkPhysicalDeviceIDProperties## Addr## ByteArray## instance Eq VkPhysicalDeviceIDProperties where (VkPhysicalDeviceIDProperties## a _) == x@(VkPhysicalDeviceIDProperties## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceIDProperties where (VkPhysicalDeviceIDProperties## a _) `compare` x@(VkPhysicalDeviceIDProperties## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceIDProperties where sizeOf ~_ = #{size VkPhysicalDeviceIDProperties} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceIDProperties} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceIDProperties where unsafeAddr (VkPhysicalDeviceIDProperties## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceIDProperties## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceIDProperties## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceIDProperties where type StructFields VkPhysicalDeviceIDProperties = '["sType", "pNext", "deviceUUID", "driverUUID", "deviceLUID", -- ' closing tick for hsc2hs "deviceNodeMask", "deviceLUIDValid"] type CUnionType VkPhysicalDeviceIDProperties = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceIDProperties = 'True -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceIDProperties = '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceIDProperties where type FieldType "sType" VkPhysicalDeviceIDProperties = VkStructureType type FieldOptional "sType" VkPhysicalDeviceIDProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceIDProperties = #{offset VkPhysicalDeviceIDProperties, sType} type FieldIsArray "sType" VkPhysicalDeviceIDProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceIDProperties, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceIDProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceIDProperties, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceIDProperties, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceIDProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceIDProperties, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceIDProperties where type FieldType "pNext" VkPhysicalDeviceIDProperties = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceIDProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceIDProperties = #{offset VkPhysicalDeviceIDProperties, pNext} type FieldIsArray "pNext" VkPhysicalDeviceIDProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceIDProperties, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceIDProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceIDProperties, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceIDProperties, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceIDProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceIDProperties, pNext} instance {-# OVERLAPPING #-} HasField "deviceUUID" VkPhysicalDeviceIDProperties where type FieldType "deviceUUID" VkPhysicalDeviceIDProperties = Word8 type FieldOptional "deviceUUID" VkPhysicalDeviceIDProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "deviceUUID" VkPhysicalDeviceIDProperties = #{offset VkPhysicalDeviceIDProperties, deviceUUID} type FieldIsArray "deviceUUID" VkPhysicalDeviceIDProperties = 'True -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceIDProperties, deviceUUID} instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "deviceUUID" idx VkPhysicalDeviceIDProperties) => CanReadFieldArray "deviceUUID" idx VkPhysicalDeviceIDProperties where {-# SPECIALISE instance CanReadFieldArray "deviceUUID" 0 VkPhysicalDeviceIDProperties #-} {-# SPECIALISE instance CanReadFieldArray "deviceUUID" 1 VkPhysicalDeviceIDProperties #-} {-# SPECIALISE instance CanReadFieldArray "deviceUUID" 2 VkPhysicalDeviceIDProperties #-} {-# SPECIALISE instance CanReadFieldArray "deviceUUID" 3 VkPhysicalDeviceIDProperties #-} type FieldArrayLength "deviceUUID" VkPhysicalDeviceIDProperties = VK_UUID_SIZE {-# INLINE fieldArrayLength #-} fieldArrayLength = VK_UUID_SIZE {-# INLINE getFieldArray #-} getFieldArray = f where {-# NOINLINE f #-} f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off) off = #{offset VkPhysicalDeviceIDProperties, deviceUUID} + sizeOf (undefined :: Word8) * fromInteger (natVal' (proxy## :: Proxy## idx)) -- ' closing tick for hsc2hs {-# INLINE readFieldArray #-} readFieldArray p = peekByteOff p (#{offset VkPhysicalDeviceIDProperties, deviceUUID} + sizeOf (undefined :: Word8) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "deviceUUID" idx VkPhysicalDeviceIDProperties) => CanWriteFieldArray "deviceUUID" idx VkPhysicalDeviceIDProperties where {-# SPECIALISE instance CanWriteFieldArray "deviceUUID" 0 VkPhysicalDeviceIDProperties #-} {-# SPECIALISE instance CanWriteFieldArray "deviceUUID" 1 VkPhysicalDeviceIDProperties #-} {-# SPECIALISE instance CanWriteFieldArray "deviceUUID" 2 VkPhysicalDeviceIDProperties #-} {-# SPECIALISE instance CanWriteFieldArray "deviceUUID" 3 VkPhysicalDeviceIDProperties #-} {-# INLINE writeFieldArray #-} writeFieldArray p = pokeByteOff p (#{offset VkPhysicalDeviceIDProperties, deviceUUID} + sizeOf (undefined :: Word8) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "driverUUID" VkPhysicalDeviceIDProperties where type FieldType "driverUUID" VkPhysicalDeviceIDProperties = Word8 type FieldOptional "driverUUID" VkPhysicalDeviceIDProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "driverUUID" VkPhysicalDeviceIDProperties = #{offset VkPhysicalDeviceIDProperties, driverUUID} type FieldIsArray "driverUUID" VkPhysicalDeviceIDProperties = 'True -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceIDProperties, driverUUID} instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "driverUUID" idx VkPhysicalDeviceIDProperties) => CanReadFieldArray "driverUUID" idx VkPhysicalDeviceIDProperties where {-# SPECIALISE instance CanReadFieldArray "driverUUID" 0 VkPhysicalDeviceIDProperties #-} {-# SPECIALISE instance CanReadFieldArray "driverUUID" 1 VkPhysicalDeviceIDProperties #-} {-# SPECIALISE instance CanReadFieldArray "driverUUID" 2 VkPhysicalDeviceIDProperties #-} {-# SPECIALISE instance CanReadFieldArray "driverUUID" 3 VkPhysicalDeviceIDProperties #-} type FieldArrayLength "driverUUID" VkPhysicalDeviceIDProperties = VK_UUID_SIZE {-# INLINE fieldArrayLength #-} fieldArrayLength = VK_UUID_SIZE {-# INLINE getFieldArray #-} getFieldArray = f where {-# NOINLINE f #-} f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off) off = #{offset VkPhysicalDeviceIDProperties, driverUUID} + sizeOf (undefined :: Word8) * fromInteger (natVal' (proxy## :: Proxy## idx)) -- ' closing tick for hsc2hs {-# INLINE readFieldArray #-} readFieldArray p = peekByteOff p (#{offset VkPhysicalDeviceIDProperties, driverUUID} + sizeOf (undefined :: Word8) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "driverUUID" idx VkPhysicalDeviceIDProperties) => CanWriteFieldArray "driverUUID" idx VkPhysicalDeviceIDProperties where {-# SPECIALISE instance CanWriteFieldArray "driverUUID" 0 VkPhysicalDeviceIDProperties #-} {-# SPECIALISE instance CanWriteFieldArray "driverUUID" 1 VkPhysicalDeviceIDProperties #-} {-# SPECIALISE instance CanWriteFieldArray "driverUUID" 2 VkPhysicalDeviceIDProperties #-} {-# SPECIALISE instance CanWriteFieldArray "driverUUID" 3 VkPhysicalDeviceIDProperties #-} {-# INLINE writeFieldArray #-} writeFieldArray p = pokeByteOff p (#{offset VkPhysicalDeviceIDProperties, driverUUID} + sizeOf (undefined :: Word8) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "deviceLUID" VkPhysicalDeviceIDProperties where type FieldType "deviceLUID" VkPhysicalDeviceIDProperties = Word8 type FieldOptional "deviceLUID" VkPhysicalDeviceIDProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "deviceLUID" VkPhysicalDeviceIDProperties = #{offset VkPhysicalDeviceIDProperties, deviceLUID} type FieldIsArray "deviceLUID" VkPhysicalDeviceIDProperties = 'True -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceIDProperties, deviceLUID} instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "deviceLUID" idx VkPhysicalDeviceIDProperties) => CanReadFieldArray "deviceLUID" idx VkPhysicalDeviceIDProperties where {-# SPECIALISE instance CanReadFieldArray "deviceLUID" 0 VkPhysicalDeviceIDProperties #-} {-# SPECIALISE instance CanReadFieldArray "deviceLUID" 1 VkPhysicalDeviceIDProperties #-} {-# SPECIALISE instance CanReadFieldArray "deviceLUID" 2 VkPhysicalDeviceIDProperties #-} {-# SPECIALISE instance CanReadFieldArray "deviceLUID" 3 VkPhysicalDeviceIDProperties #-} type FieldArrayLength "deviceLUID" VkPhysicalDeviceIDProperties = VK_LUID_SIZE {-# INLINE fieldArrayLength #-} fieldArrayLength = VK_LUID_SIZE {-# INLINE getFieldArray #-} getFieldArray = f where {-# NOINLINE f #-} f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off) off = #{offset VkPhysicalDeviceIDProperties, deviceLUID} + sizeOf (undefined :: Word8) * fromInteger (natVal' (proxy## :: Proxy## idx)) -- ' closing tick for hsc2hs {-# INLINE readFieldArray #-} readFieldArray p = peekByteOff p (#{offset VkPhysicalDeviceIDProperties, deviceLUID} + sizeOf (undefined :: Word8) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "deviceLUID" idx VkPhysicalDeviceIDProperties) => CanWriteFieldArray "deviceLUID" idx VkPhysicalDeviceIDProperties where {-# SPECIALISE instance CanWriteFieldArray "deviceLUID" 0 VkPhysicalDeviceIDProperties #-} {-# SPECIALISE instance CanWriteFieldArray "deviceLUID" 1 VkPhysicalDeviceIDProperties #-} {-# SPECIALISE instance CanWriteFieldArray "deviceLUID" 2 VkPhysicalDeviceIDProperties #-} {-# SPECIALISE instance CanWriteFieldArray "deviceLUID" 3 VkPhysicalDeviceIDProperties #-} {-# INLINE writeFieldArray #-} writeFieldArray p = pokeByteOff p (#{offset VkPhysicalDeviceIDProperties, deviceLUID} + sizeOf (undefined :: Word8) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "deviceNodeMask" VkPhysicalDeviceIDProperties where type FieldType "deviceNodeMask" VkPhysicalDeviceIDProperties = Word32 type FieldOptional "deviceNodeMask" VkPhysicalDeviceIDProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "deviceNodeMask" VkPhysicalDeviceIDProperties = #{offset VkPhysicalDeviceIDProperties, deviceNodeMask} type FieldIsArray "deviceNodeMask" VkPhysicalDeviceIDProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceIDProperties, deviceNodeMask} instance {-# OVERLAPPING #-} CanReadField "deviceNodeMask" VkPhysicalDeviceIDProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceIDProperties, deviceNodeMask}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceIDProperties, deviceNodeMask} instance {-# OVERLAPPING #-} CanWriteField "deviceNodeMask" VkPhysicalDeviceIDProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceIDProperties, deviceNodeMask} instance {-# OVERLAPPING #-} HasField "deviceLUIDValid" VkPhysicalDeviceIDProperties where type FieldType "deviceLUIDValid" VkPhysicalDeviceIDProperties = VkBool32 type FieldOptional "deviceLUIDValid" VkPhysicalDeviceIDProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "deviceLUIDValid" VkPhysicalDeviceIDProperties = #{offset VkPhysicalDeviceIDProperties, deviceLUIDValid} type FieldIsArray "deviceLUIDValid" VkPhysicalDeviceIDProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceIDProperties, deviceLUIDValid} instance {-# OVERLAPPING #-} CanReadField "deviceLUIDValid" VkPhysicalDeviceIDProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceIDProperties, deviceLUIDValid}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceIDProperties, deviceLUIDValid} instance {-# OVERLAPPING #-} CanWriteField "deviceLUIDValid" VkPhysicalDeviceIDProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceIDProperties, deviceLUIDValid} instance Show VkPhysicalDeviceIDProperties where showsPrec d x = showString "VkPhysicalDeviceIDProperties {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . (showString "deviceUUID = [" . showsPrec d (let s = sizeOf (undefined :: FieldType "deviceUUID" VkPhysicalDeviceIDProperties) o = fieldOffset @"deviceUUID" @VkPhysicalDeviceIDProperties f i = peekByteOff (unsafePtr x) i :: IO (FieldType "deviceUUID" VkPhysicalDeviceIDProperties) in unsafeDupablePerformIO . mapM f $ map (\ i -> o + i * s) [0 .. VK_UUID_SIZE - 1]) . showChar ']') . showString ", " . (showString "driverUUID = [" . showsPrec d (let s = sizeOf (undefined :: FieldType "driverUUID" VkPhysicalDeviceIDProperties) o = fieldOffset @"driverUUID" @VkPhysicalDeviceIDProperties f i = peekByteOff (unsafePtr x) i :: IO (FieldType "driverUUID" VkPhysicalDeviceIDProperties) in unsafeDupablePerformIO . mapM f $ map (\ i -> o + i * s) [0 .. VK_UUID_SIZE - 1]) . showChar ']') . showString ", " . (showString "deviceLUID = [" . showsPrec d (let s = sizeOf (undefined :: FieldType "deviceLUID" VkPhysicalDeviceIDProperties) o = fieldOffset @"deviceLUID" @VkPhysicalDeviceIDProperties f i = peekByteOff (unsafePtr x) i :: IO (FieldType "deviceLUID" VkPhysicalDeviceIDProperties) in unsafeDupablePerformIO . mapM f $ map (\ i -> o + i * s) [0 .. VK_LUID_SIZE - 1]) . showChar ']') . showString ", " . showString "deviceNodeMask = " . showsPrec d (getField @"deviceNodeMask" x) . showString ", " . showString "deviceLUIDValid = " . showsPrec d (getField @"deviceLUIDValid" x) . showChar '}' -- | Alias for `VkPhysicalDeviceIDProperties` type VkPhysicalDeviceIDPropertiesKHR = VkPhysicalDeviceIDProperties -- | > typedef struct VkPhysicalDeviceImageFormatInfo2 { -- > VkStructureType sType; -- > const void* pNext; -- > VkFormat format; -- > VkImageType type; -- > VkImageTiling tiling; -- > VkImageUsageFlags usage; -- > VkImageCreateFlags flags; -- > } VkPhysicalDeviceImageFormatInfo2; -- -- data VkPhysicalDeviceImageFormatInfo2 = VkPhysicalDeviceImageFormatInfo2## Addr## ByteArray## instance Eq VkPhysicalDeviceImageFormatInfo2 where (VkPhysicalDeviceImageFormatInfo2## a _) == x@(VkPhysicalDeviceImageFormatInfo2## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceImageFormatInfo2 where (VkPhysicalDeviceImageFormatInfo2## a _) `compare` x@(VkPhysicalDeviceImageFormatInfo2## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceImageFormatInfo2 where sizeOf ~_ = #{size VkPhysicalDeviceImageFormatInfo2} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceImageFormatInfo2} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceImageFormatInfo2 where unsafeAddr (VkPhysicalDeviceImageFormatInfo2## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceImageFormatInfo2## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceImageFormatInfo2## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceImageFormatInfo2 where type StructFields VkPhysicalDeviceImageFormatInfo2 = '["sType", "pNext", "format", "type", "tiling", "usage", "flags"] -- ' closing tick for hsc2hs type CUnionType VkPhysicalDeviceImageFormatInfo2 = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceImageFormatInfo2 = 'False -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceImageFormatInfo2 = '[] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceImageFormatInfo2 where type FieldType "sType" VkPhysicalDeviceImageFormatInfo2 = VkStructureType type FieldOptional "sType" VkPhysicalDeviceImageFormatInfo2 = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceImageFormatInfo2 = #{offset VkPhysicalDeviceImageFormatInfo2, sType} type FieldIsArray "sType" VkPhysicalDeviceImageFormatInfo2 = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceImageFormatInfo2, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceImageFormatInfo2 where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceImageFormatInfo2, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceImageFormatInfo2, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceImageFormatInfo2 where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceImageFormatInfo2, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceImageFormatInfo2 where type FieldType "pNext" VkPhysicalDeviceImageFormatInfo2 = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceImageFormatInfo2 = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceImageFormatInfo2 = #{offset VkPhysicalDeviceImageFormatInfo2, pNext} type FieldIsArray "pNext" VkPhysicalDeviceImageFormatInfo2 = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceImageFormatInfo2, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceImageFormatInfo2 where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceImageFormatInfo2, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceImageFormatInfo2, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceImageFormatInfo2 where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceImageFormatInfo2, pNext} instance {-# OVERLAPPING #-} HasField "format" VkPhysicalDeviceImageFormatInfo2 where type FieldType "format" VkPhysicalDeviceImageFormatInfo2 = VkFormat type FieldOptional "format" VkPhysicalDeviceImageFormatInfo2 = 'False -- ' closing tick for hsc2hs type FieldOffset "format" VkPhysicalDeviceImageFormatInfo2 = #{offset VkPhysicalDeviceImageFormatInfo2, format} type FieldIsArray "format" VkPhysicalDeviceImageFormatInfo2 = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceImageFormatInfo2, format} instance {-# OVERLAPPING #-} CanReadField "format" VkPhysicalDeviceImageFormatInfo2 where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceImageFormatInfo2, format}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceImageFormatInfo2, format} instance {-# OVERLAPPING #-} CanWriteField "format" VkPhysicalDeviceImageFormatInfo2 where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceImageFormatInfo2, format} instance {-# OVERLAPPING #-} HasField "type" VkPhysicalDeviceImageFormatInfo2 where type FieldType "type" VkPhysicalDeviceImageFormatInfo2 = VkImageType type FieldOptional "type" VkPhysicalDeviceImageFormatInfo2 = 'False -- ' closing tick for hsc2hs type FieldOffset "type" VkPhysicalDeviceImageFormatInfo2 = #{offset VkPhysicalDeviceImageFormatInfo2, type} type FieldIsArray "type" VkPhysicalDeviceImageFormatInfo2 = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceImageFormatInfo2, type} instance {-# OVERLAPPING #-} CanReadField "type" VkPhysicalDeviceImageFormatInfo2 where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceImageFormatInfo2, type}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceImageFormatInfo2, type} instance {-# OVERLAPPING #-} CanWriteField "type" VkPhysicalDeviceImageFormatInfo2 where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceImageFormatInfo2, type} instance {-# OVERLAPPING #-} HasField "tiling" VkPhysicalDeviceImageFormatInfo2 where type FieldType "tiling" VkPhysicalDeviceImageFormatInfo2 = VkImageTiling type FieldOptional "tiling" VkPhysicalDeviceImageFormatInfo2 = 'False -- ' closing tick for hsc2hs type FieldOffset "tiling" VkPhysicalDeviceImageFormatInfo2 = #{offset VkPhysicalDeviceImageFormatInfo2, tiling} type FieldIsArray "tiling" VkPhysicalDeviceImageFormatInfo2 = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceImageFormatInfo2, tiling} instance {-# OVERLAPPING #-} CanReadField "tiling" VkPhysicalDeviceImageFormatInfo2 where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceImageFormatInfo2, tiling}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceImageFormatInfo2, tiling} instance {-# OVERLAPPING #-} CanWriteField "tiling" VkPhysicalDeviceImageFormatInfo2 where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceImageFormatInfo2, tiling} instance {-# OVERLAPPING #-} HasField "usage" VkPhysicalDeviceImageFormatInfo2 where type FieldType "usage" VkPhysicalDeviceImageFormatInfo2 = VkImageUsageFlags type FieldOptional "usage" VkPhysicalDeviceImageFormatInfo2 = 'False -- ' closing tick for hsc2hs type FieldOffset "usage" VkPhysicalDeviceImageFormatInfo2 = #{offset VkPhysicalDeviceImageFormatInfo2, usage} type FieldIsArray "usage" VkPhysicalDeviceImageFormatInfo2 = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceImageFormatInfo2, usage} instance {-# OVERLAPPING #-} CanReadField "usage" VkPhysicalDeviceImageFormatInfo2 where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceImageFormatInfo2, usage}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceImageFormatInfo2, usage} instance {-# OVERLAPPING #-} CanWriteField "usage" VkPhysicalDeviceImageFormatInfo2 where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceImageFormatInfo2, usage} instance {-# OVERLAPPING #-} HasField "flags" VkPhysicalDeviceImageFormatInfo2 where type FieldType "flags" VkPhysicalDeviceImageFormatInfo2 = VkImageCreateFlags type FieldOptional "flags" VkPhysicalDeviceImageFormatInfo2 = 'True -- ' closing tick for hsc2hs type FieldOffset "flags" VkPhysicalDeviceImageFormatInfo2 = #{offset VkPhysicalDeviceImageFormatInfo2, flags} type FieldIsArray "flags" VkPhysicalDeviceImageFormatInfo2 = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = True {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceImageFormatInfo2, flags} instance {-# OVERLAPPING #-} CanReadField "flags" VkPhysicalDeviceImageFormatInfo2 where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceImageFormatInfo2, flags}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceImageFormatInfo2, flags} instance {-# OVERLAPPING #-} CanWriteField "flags" VkPhysicalDeviceImageFormatInfo2 where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceImageFormatInfo2, flags} instance Show VkPhysicalDeviceImageFormatInfo2 where showsPrec d x = showString "VkPhysicalDeviceImageFormatInfo2 {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "format = " . showsPrec d (getField @"format" x) . showString ", " . showString "type = " . showsPrec d (getField @"type" x) . showString ", " . showString "tiling = " . showsPrec d (getField @"tiling" x) . showString ", " . showString "usage = " . showsPrec d (getField @"usage" x) . showString ", " . showString "flags = " . showsPrec d (getField @"flags" x) . showChar '}' -- | Alias for `VkPhysicalDeviceImageFormatInfo2` type VkPhysicalDeviceImageFormatInfo2KHR = VkPhysicalDeviceImageFormatInfo2 -- | > typedef struct VkPhysicalDeviceLimits { -- > uint32_t maxImageDimension1D; -- > uint32_t maxImageDimension2D; -- > uint32_t maxImageDimension3D; -- > uint32_t maxImageDimensionCube; -- > uint32_t maxImageArrayLayers; -- > uint32_t maxTexelBufferElements; -- > uint32_t maxUniformBufferRange; -- > uint32_t maxStorageBufferRange; -- > uint32_t maxPushConstantsSize; -- > uint32_t maxMemoryAllocationCount; -- > uint32_t maxSamplerAllocationCount; -- > VkDeviceSize bufferImageGranularity; -- > VkDeviceSize sparseAddressSpaceSize; -- > uint32_t maxBoundDescriptorSets; -- > uint32_t maxPerStageDescriptorSamplers; -- > uint32_t maxPerStageDescriptorUniformBuffers; -- > uint32_t maxPerStageDescriptorStorageBuffers; -- > uint32_t maxPerStageDescriptorSampledImages; -- > uint32_t maxPerStageDescriptorStorageImages; -- > uint32_t maxPerStageDescriptorInputAttachments; -- > uint32_t maxPerStageResources; -- > uint32_t maxDescriptorSetSamplers; -- > uint32_t maxDescriptorSetUniformBuffers; -- > uint32_t maxDescriptorSetUniformBuffersDynamic; -- > uint32_t maxDescriptorSetStorageBuffers; -- > uint32_t maxDescriptorSetStorageBuffersDynamic; -- > uint32_t maxDescriptorSetSampledImages; -- > uint32_t maxDescriptorSetStorageImages; -- > uint32_t maxDescriptorSetInputAttachments; -- > uint32_t maxVertexInputAttributes; -- > uint32_t maxVertexInputBindings; -- > uint32_t maxVertexInputAttributeOffset; -- > uint32_t maxVertexInputBindingStride; -- > uint32_t maxVertexOutputComponents; -- > uint32_t maxTessellationGenerationLevel; -- > uint32_t maxTessellationPatchSize; -- > uint32_t maxTessellationControlPerVertexInputComponents; -- > uint32_t maxTessellationControlPerVertexOutputComponents; -- > uint32_t maxTessellationControlPerPatchOutputComponents; -- > uint32_t maxTessellationControlTotalOutputComponents; -- > uint32_t maxTessellationEvaluationInputComponents; -- > uint32_t maxTessellationEvaluationOutputComponents; -- > uint32_t maxGeometryShaderInvocations; -- > uint32_t maxGeometryInputComponents; -- > uint32_t maxGeometryOutputComponents; -- > uint32_t maxGeometryOutputVertices; -- > uint32_t maxGeometryTotalOutputComponents; -- > uint32_t maxFragmentInputComponents; -- > uint32_t maxFragmentOutputAttachments; -- > uint32_t maxFragmentDualSrcAttachments; -- > uint32_t maxFragmentCombinedOutputResources; -- > uint32_t maxComputeSharedMemorySize; -- > uint32_t maxComputeWorkGroupCount[3]; -- > uint32_t maxComputeWorkGroupInvocations; -- > uint32_t maxComputeWorkGroupSize[3]; -- > uint32_t subPixelPrecisionBits; -- > uint32_t subTexelPrecisionBits; -- > uint32_t mipmapPrecisionBits; -- > uint32_t maxDrawIndexedIndexValue; -- > uint32_t maxDrawIndirectCount; -- > float maxSamplerLodBias; -- > float maxSamplerAnisotropy; -- > uint32_t maxViewports; -- > uint32_t maxViewportDimensions[2]; -- > float viewportBoundsRange[2]; -- > uint32_t viewportSubPixelBits; -- > size_t minMemoryMapAlignment; -- > VkDeviceSize minTexelBufferOffsetAlignment; -- > VkDeviceSize minUniformBufferOffsetAlignment; -- > VkDeviceSize minStorageBufferOffsetAlignment; -- > int32_t minTexelOffset; -- > uint32_t maxTexelOffset; -- > int32_t minTexelGatherOffset; -- > uint32_t maxTexelGatherOffset; -- > float minInterpolationOffset; -- > float maxInterpolationOffset; -- > uint32_t subPixelInterpolationOffsetBits; -- > uint32_t maxFramebufferWidth; -- > uint32_t maxFramebufferHeight; -- > uint32_t maxFramebufferLayers; -- > VkSampleCountFlags framebufferColorSampleCounts; -- > VkSampleCountFlags framebufferDepthSampleCounts; -- > VkSampleCountFlags framebufferStencilSampleCounts; -- > VkSampleCountFlags framebufferNoAttachmentsSampleCounts; -- > uint32_t maxColorAttachments; -- > VkSampleCountFlags sampledImageColorSampleCounts; -- > VkSampleCountFlags sampledImageIntegerSampleCounts; -- > VkSampleCountFlags sampledImageDepthSampleCounts; -- > VkSampleCountFlags sampledImageStencilSampleCounts; -- > VkSampleCountFlags storageImageSampleCounts; -- > uint32_t maxSampleMaskWords; -- > VkBool32 timestampComputeAndGraphics; -- > float timestampPeriod; -- > uint32_t maxClipDistances; -- > uint32_t maxCullDistances; -- > uint32_t maxCombinedClipAndCullDistances; -- > uint32_t discreteQueuePriorities; -- > float pointSizeRange[2]; -- > float lineWidthRange[2]; -- > float pointSizeGranularity; -- > float lineWidthGranularity; -- > VkBool32 strictLines; -- > VkBool32 standardSampleLocations; -- > VkDeviceSize optimalBufferCopyOffsetAlignment; -- > VkDeviceSize optimalBufferCopyRowPitchAlignment; -- > VkDeviceSize nonCoherentAtomSize; -- > } VkPhysicalDeviceLimits; -- -- data VkPhysicalDeviceLimits = VkPhysicalDeviceLimits## Addr## ByteArray## instance Eq VkPhysicalDeviceLimits where (VkPhysicalDeviceLimits## a _) == x@(VkPhysicalDeviceLimits## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceLimits where (VkPhysicalDeviceLimits## a _) `compare` x@(VkPhysicalDeviceLimits## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceLimits where sizeOf ~_ = #{size VkPhysicalDeviceLimits} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceLimits} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceLimits where unsafeAddr (VkPhysicalDeviceLimits## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceLimits## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceLimits## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceLimits where type StructFields VkPhysicalDeviceLimits = '["maxImageDimension1D", "maxImageDimension2D", -- ' closing tick for hsc2hs "maxImageDimension3D", "maxImageDimensionCube", "maxImageArrayLayers", "maxTexelBufferElements", "maxUniformBufferRange", "maxStorageBufferRange", "maxPushConstantsSize", "maxMemoryAllocationCount", "maxSamplerAllocationCount", "bufferImageGranularity", "sparseAddressSpaceSize", "maxBoundDescriptorSets", "maxPerStageDescriptorSamplers", "maxPerStageDescriptorUniformBuffers", "maxPerStageDescriptorStorageBuffers", "maxPerStageDescriptorSampledImages", "maxPerStageDescriptorStorageImages", "maxPerStageDescriptorInputAttachments", "maxPerStageResources", "maxDescriptorSetSamplers", "maxDescriptorSetUniformBuffers", "maxDescriptorSetUniformBuffersDynamic", "maxDescriptorSetStorageBuffers", "maxDescriptorSetStorageBuffersDynamic", "maxDescriptorSetSampledImages", "maxDescriptorSetStorageImages", "maxDescriptorSetInputAttachments", "maxVertexInputAttributes", "maxVertexInputBindings", "maxVertexInputAttributeOffset", "maxVertexInputBindingStride", "maxVertexOutputComponents", "maxTessellationGenerationLevel", "maxTessellationPatchSize", "maxTessellationControlPerVertexInputComponents", "maxTessellationControlPerVertexOutputComponents", "maxTessellationControlPerPatchOutputComponents", "maxTessellationControlTotalOutputComponents", "maxTessellationEvaluationInputComponents", "maxTessellationEvaluationOutputComponents", "maxGeometryShaderInvocations", "maxGeometryInputComponents", "maxGeometryOutputComponents", "maxGeometryOutputVertices", "maxGeometryTotalOutputComponents", "maxFragmentInputComponents", "maxFragmentOutputAttachments", "maxFragmentDualSrcAttachments", "maxFragmentCombinedOutputResources", "maxComputeSharedMemorySize", "maxComputeWorkGroupCount", "maxComputeWorkGroupInvocations", "maxComputeWorkGroupSize", "subPixelPrecisionBits", "subTexelPrecisionBits", "mipmapPrecisionBits", "maxDrawIndexedIndexValue", "maxDrawIndirectCount", "maxSamplerLodBias", "maxSamplerAnisotropy", "maxViewports", "maxViewportDimensions", "viewportBoundsRange", "viewportSubPixelBits", "minMemoryMapAlignment", "minTexelBufferOffsetAlignment", "minUniformBufferOffsetAlignment", "minStorageBufferOffsetAlignment", "minTexelOffset", "maxTexelOffset", "minTexelGatherOffset", "maxTexelGatherOffset", "minInterpolationOffset", "maxInterpolationOffset", "subPixelInterpolationOffsetBits", "maxFramebufferWidth", "maxFramebufferHeight", "maxFramebufferLayers", "framebufferColorSampleCounts", "framebufferDepthSampleCounts", "framebufferStencilSampleCounts", "framebufferNoAttachmentsSampleCounts", "maxColorAttachments", "sampledImageColorSampleCounts", "sampledImageIntegerSampleCounts", "sampledImageDepthSampleCounts", "sampledImageStencilSampleCounts", "storageImageSampleCounts", "maxSampleMaskWords", "timestampComputeAndGraphics", "timestampPeriod", "maxClipDistances", "maxCullDistances", "maxCombinedClipAndCullDistances", "discreteQueuePriorities", "pointSizeRange", "lineWidthRange", "pointSizeGranularity", "lineWidthGranularity", "strictLines", "standardSampleLocations", "optimalBufferCopyOffsetAlignment", "optimalBufferCopyRowPitchAlignment", "nonCoherentAtomSize"] type CUnionType VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceLimits = 'True -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceLimits = '[] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "maxImageDimension1D" VkPhysicalDeviceLimits where type FieldType "maxImageDimension1D" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxImageDimension1D" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxImageDimension1D" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxImageDimension1D} type FieldIsArray "maxImageDimension1D" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxImageDimension1D} instance {-# OVERLAPPING #-} CanReadField "maxImageDimension1D" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxImageDimension1D}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxImageDimension1D} instance {-# OVERLAPPING #-} CanWriteField "maxImageDimension1D" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxImageDimension1D} instance {-# OVERLAPPING #-} HasField "maxImageDimension2D" VkPhysicalDeviceLimits where type FieldType "maxImageDimension2D" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxImageDimension2D" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxImageDimension2D" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxImageDimension2D} type FieldIsArray "maxImageDimension2D" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxImageDimension2D} instance {-# OVERLAPPING #-} CanReadField "maxImageDimension2D" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxImageDimension2D}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxImageDimension2D} instance {-# OVERLAPPING #-} CanWriteField "maxImageDimension2D" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxImageDimension2D} instance {-# OVERLAPPING #-} HasField "maxImageDimension3D" VkPhysicalDeviceLimits where type FieldType "maxImageDimension3D" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxImageDimension3D" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxImageDimension3D" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxImageDimension3D} type FieldIsArray "maxImageDimension3D" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxImageDimension3D} instance {-# OVERLAPPING #-} CanReadField "maxImageDimension3D" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxImageDimension3D}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxImageDimension3D} instance {-# OVERLAPPING #-} CanWriteField "maxImageDimension3D" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxImageDimension3D} instance {-# OVERLAPPING #-} HasField "maxImageDimensionCube" VkPhysicalDeviceLimits where type FieldType "maxImageDimensionCube" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxImageDimensionCube" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxImageDimensionCube" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxImageDimensionCube} type FieldIsArray "maxImageDimensionCube" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxImageDimensionCube} instance {-# OVERLAPPING #-} CanReadField "maxImageDimensionCube" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxImageDimensionCube}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxImageDimensionCube} instance {-# OVERLAPPING #-} CanWriteField "maxImageDimensionCube" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxImageDimensionCube} instance {-# OVERLAPPING #-} HasField "maxImageArrayLayers" VkPhysicalDeviceLimits where type FieldType "maxImageArrayLayers" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxImageArrayLayers" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxImageArrayLayers" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxImageArrayLayers} type FieldIsArray "maxImageArrayLayers" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxImageArrayLayers} instance {-# OVERLAPPING #-} CanReadField "maxImageArrayLayers" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxImageArrayLayers}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxImageArrayLayers} instance {-# OVERLAPPING #-} CanWriteField "maxImageArrayLayers" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxImageArrayLayers} instance {-# OVERLAPPING #-} HasField "maxTexelBufferElements" VkPhysicalDeviceLimits where type FieldType "maxTexelBufferElements" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxTexelBufferElements" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxTexelBufferElements" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxTexelBufferElements} type FieldIsArray "maxTexelBufferElements" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxTexelBufferElements} instance {-# OVERLAPPING #-} CanReadField "maxTexelBufferElements" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxTexelBufferElements}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxTexelBufferElements} instance {-# OVERLAPPING #-} CanWriteField "maxTexelBufferElements" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxTexelBufferElements} instance {-# OVERLAPPING #-} HasField "maxUniformBufferRange" VkPhysicalDeviceLimits where type FieldType "maxUniformBufferRange" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxUniformBufferRange" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxUniformBufferRange" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxUniformBufferRange} type FieldIsArray "maxUniformBufferRange" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxUniformBufferRange} instance {-# OVERLAPPING #-} CanReadField "maxUniformBufferRange" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxUniformBufferRange}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxUniformBufferRange} instance {-# OVERLAPPING #-} CanWriteField "maxUniformBufferRange" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxUniformBufferRange} instance {-# OVERLAPPING #-} HasField "maxStorageBufferRange" VkPhysicalDeviceLimits where type FieldType "maxStorageBufferRange" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxStorageBufferRange" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxStorageBufferRange" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxStorageBufferRange} type FieldIsArray "maxStorageBufferRange" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxStorageBufferRange} instance {-# OVERLAPPING #-} CanReadField "maxStorageBufferRange" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxStorageBufferRange}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxStorageBufferRange} instance {-# OVERLAPPING #-} CanWriteField "maxStorageBufferRange" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxStorageBufferRange} instance {-# OVERLAPPING #-} HasField "maxPushConstantsSize" VkPhysicalDeviceLimits where type FieldType "maxPushConstantsSize" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxPushConstantsSize" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxPushConstantsSize" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxPushConstantsSize} type FieldIsArray "maxPushConstantsSize" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxPushConstantsSize} instance {-# OVERLAPPING #-} CanReadField "maxPushConstantsSize" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxPushConstantsSize}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxPushConstantsSize} instance {-# OVERLAPPING #-} CanWriteField "maxPushConstantsSize" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxPushConstantsSize} instance {-# OVERLAPPING #-} HasField "maxMemoryAllocationCount" VkPhysicalDeviceLimits where type FieldType "maxMemoryAllocationCount" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxMemoryAllocationCount" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxMemoryAllocationCount" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxMemoryAllocationCount} type FieldIsArray "maxMemoryAllocationCount" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxMemoryAllocationCount} instance {-# OVERLAPPING #-} CanReadField "maxMemoryAllocationCount" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxMemoryAllocationCount}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxMemoryAllocationCount} instance {-# OVERLAPPING #-} CanWriteField "maxMemoryAllocationCount" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxMemoryAllocationCount} instance {-# OVERLAPPING #-} HasField "maxSamplerAllocationCount" VkPhysicalDeviceLimits where type FieldType "maxSamplerAllocationCount" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxSamplerAllocationCount" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxSamplerAllocationCount" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxSamplerAllocationCount} type FieldIsArray "maxSamplerAllocationCount" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxSamplerAllocationCount} instance {-# OVERLAPPING #-} CanReadField "maxSamplerAllocationCount" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxSamplerAllocationCount}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxSamplerAllocationCount} instance {-# OVERLAPPING #-} CanWriteField "maxSamplerAllocationCount" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxSamplerAllocationCount} instance {-# OVERLAPPING #-} HasField "bufferImageGranularity" VkPhysicalDeviceLimits where type FieldType "bufferImageGranularity" VkPhysicalDeviceLimits = VkDeviceSize type FieldOptional "bufferImageGranularity" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "bufferImageGranularity" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, bufferImageGranularity} type FieldIsArray "bufferImageGranularity" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, bufferImageGranularity} instance {-# OVERLAPPING #-} CanReadField "bufferImageGranularity" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, bufferImageGranularity}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, bufferImageGranularity} instance {-# OVERLAPPING #-} CanWriteField "bufferImageGranularity" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, bufferImageGranularity} instance {-# OVERLAPPING #-} HasField "sparseAddressSpaceSize" VkPhysicalDeviceLimits where type FieldType "sparseAddressSpaceSize" VkPhysicalDeviceLimits = VkDeviceSize type FieldOptional "sparseAddressSpaceSize" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "sparseAddressSpaceSize" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, sparseAddressSpaceSize} type FieldIsArray "sparseAddressSpaceSize" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, sparseAddressSpaceSize} instance {-# OVERLAPPING #-} CanReadField "sparseAddressSpaceSize" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, sparseAddressSpaceSize}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, sparseAddressSpaceSize} instance {-# OVERLAPPING #-} CanWriteField "sparseAddressSpaceSize" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, sparseAddressSpaceSize} instance {-# OVERLAPPING #-} HasField "maxBoundDescriptorSets" VkPhysicalDeviceLimits where type FieldType "maxBoundDescriptorSets" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxBoundDescriptorSets" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxBoundDescriptorSets" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxBoundDescriptorSets} type FieldIsArray "maxBoundDescriptorSets" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxBoundDescriptorSets} instance {-# OVERLAPPING #-} CanReadField "maxBoundDescriptorSets" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxBoundDescriptorSets}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxBoundDescriptorSets} instance {-# OVERLAPPING #-} CanWriteField "maxBoundDescriptorSets" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxBoundDescriptorSets} instance {-# OVERLAPPING #-} HasField "maxPerStageDescriptorSamplers" VkPhysicalDeviceLimits where type FieldType "maxPerStageDescriptorSamplers" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxPerStageDescriptorSamplers" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxPerStageDescriptorSamplers" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorSamplers} type FieldIsArray "maxPerStageDescriptorSamplers" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorSamplers} instance {-# OVERLAPPING #-} CanReadField "maxPerStageDescriptorSamplers" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorSamplers}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorSamplers} instance {-# OVERLAPPING #-} CanWriteField "maxPerStageDescriptorSamplers" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorSamplers} instance {-# OVERLAPPING #-} HasField "maxPerStageDescriptorUniformBuffers" VkPhysicalDeviceLimits where type FieldType "maxPerStageDescriptorUniformBuffers" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxPerStageDescriptorUniformBuffers" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxPerStageDescriptorUniformBuffers" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorUniformBuffers} type FieldIsArray "maxPerStageDescriptorUniformBuffers" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorUniformBuffers} instance {-# OVERLAPPING #-} CanReadField "maxPerStageDescriptorUniformBuffers" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorUniformBuffers}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorUniformBuffers} instance {-# OVERLAPPING #-} CanWriteField "maxPerStageDescriptorUniformBuffers" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorUniformBuffers} instance {-# OVERLAPPING #-} HasField "maxPerStageDescriptorStorageBuffers" VkPhysicalDeviceLimits where type FieldType "maxPerStageDescriptorStorageBuffers" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxPerStageDescriptorStorageBuffers" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxPerStageDescriptorStorageBuffers" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorStorageBuffers} type FieldIsArray "maxPerStageDescriptorStorageBuffers" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorStorageBuffers} instance {-# OVERLAPPING #-} CanReadField "maxPerStageDescriptorStorageBuffers" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorStorageBuffers}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorStorageBuffers} instance {-# OVERLAPPING #-} CanWriteField "maxPerStageDescriptorStorageBuffers" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorStorageBuffers} instance {-# OVERLAPPING #-} HasField "maxPerStageDescriptorSampledImages" VkPhysicalDeviceLimits where type FieldType "maxPerStageDescriptorSampledImages" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxPerStageDescriptorSampledImages" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxPerStageDescriptorSampledImages" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorSampledImages} type FieldIsArray "maxPerStageDescriptorSampledImages" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorSampledImages} instance {-# OVERLAPPING #-} CanReadField "maxPerStageDescriptorSampledImages" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorSampledImages}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorSampledImages} instance {-# OVERLAPPING #-} CanWriteField "maxPerStageDescriptorSampledImages" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorSampledImages} instance {-# OVERLAPPING #-} HasField "maxPerStageDescriptorStorageImages" VkPhysicalDeviceLimits where type FieldType "maxPerStageDescriptorStorageImages" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxPerStageDescriptorStorageImages" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxPerStageDescriptorStorageImages" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorStorageImages} type FieldIsArray "maxPerStageDescriptorStorageImages" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorStorageImages} instance {-# OVERLAPPING #-} CanReadField "maxPerStageDescriptorStorageImages" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorStorageImages}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorStorageImages} instance {-# OVERLAPPING #-} CanWriteField "maxPerStageDescriptorStorageImages" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorStorageImages} instance {-# OVERLAPPING #-} HasField "maxPerStageDescriptorInputAttachments" VkPhysicalDeviceLimits where type FieldType "maxPerStageDescriptorInputAttachments" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxPerStageDescriptorInputAttachments" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxPerStageDescriptorInputAttachments" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorInputAttachments} type FieldIsArray "maxPerStageDescriptorInputAttachments" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorInputAttachments} instance {-# OVERLAPPING #-} CanReadField "maxPerStageDescriptorInputAttachments" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorInputAttachments}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorInputAttachments} instance {-# OVERLAPPING #-} CanWriteField "maxPerStageDescriptorInputAttachments" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxPerStageDescriptorInputAttachments} instance {-# OVERLAPPING #-} HasField "maxPerStageResources" VkPhysicalDeviceLimits where type FieldType "maxPerStageResources" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxPerStageResources" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxPerStageResources" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxPerStageResources} type FieldIsArray "maxPerStageResources" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxPerStageResources} instance {-# OVERLAPPING #-} CanReadField "maxPerStageResources" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxPerStageResources}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxPerStageResources} instance {-# OVERLAPPING #-} CanWriteField "maxPerStageResources" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxPerStageResources} instance {-# OVERLAPPING #-} HasField "maxDescriptorSetSamplers" VkPhysicalDeviceLimits where type FieldType "maxDescriptorSetSamplers" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxDescriptorSetSamplers" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxDescriptorSetSamplers" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxDescriptorSetSamplers} type FieldIsArray "maxDescriptorSetSamplers" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxDescriptorSetSamplers} instance {-# OVERLAPPING #-} CanReadField "maxDescriptorSetSamplers" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxDescriptorSetSamplers}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxDescriptorSetSamplers} instance {-# OVERLAPPING #-} CanWriteField "maxDescriptorSetSamplers" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxDescriptorSetSamplers} instance {-# OVERLAPPING #-} HasField "maxDescriptorSetUniformBuffers" VkPhysicalDeviceLimits where type FieldType "maxDescriptorSetUniformBuffers" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxDescriptorSetUniformBuffers" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxDescriptorSetUniformBuffers" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxDescriptorSetUniformBuffers} type FieldIsArray "maxDescriptorSetUniformBuffers" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxDescriptorSetUniformBuffers} instance {-# OVERLAPPING #-} CanReadField "maxDescriptorSetUniformBuffers" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxDescriptorSetUniformBuffers}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxDescriptorSetUniformBuffers} instance {-# OVERLAPPING #-} CanWriteField "maxDescriptorSetUniformBuffers" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxDescriptorSetUniformBuffers} instance {-# OVERLAPPING #-} HasField "maxDescriptorSetUniformBuffersDynamic" VkPhysicalDeviceLimits where type FieldType "maxDescriptorSetUniformBuffersDynamic" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxDescriptorSetUniformBuffersDynamic" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxDescriptorSetUniformBuffersDynamic" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxDescriptorSetUniformBuffersDynamic} type FieldIsArray "maxDescriptorSetUniformBuffersDynamic" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxDescriptorSetUniformBuffersDynamic} instance {-# OVERLAPPING #-} CanReadField "maxDescriptorSetUniformBuffersDynamic" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxDescriptorSetUniformBuffersDynamic}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxDescriptorSetUniformBuffersDynamic} instance {-# OVERLAPPING #-} CanWriteField "maxDescriptorSetUniformBuffersDynamic" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxDescriptorSetUniformBuffersDynamic} instance {-# OVERLAPPING #-} HasField "maxDescriptorSetStorageBuffers" VkPhysicalDeviceLimits where type FieldType "maxDescriptorSetStorageBuffers" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxDescriptorSetStorageBuffers" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxDescriptorSetStorageBuffers" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxDescriptorSetStorageBuffers} type FieldIsArray "maxDescriptorSetStorageBuffers" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxDescriptorSetStorageBuffers} instance {-# OVERLAPPING #-} CanReadField "maxDescriptorSetStorageBuffers" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxDescriptorSetStorageBuffers}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxDescriptorSetStorageBuffers} instance {-# OVERLAPPING #-} CanWriteField "maxDescriptorSetStorageBuffers" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxDescriptorSetStorageBuffers} instance {-# OVERLAPPING #-} HasField "maxDescriptorSetStorageBuffersDynamic" VkPhysicalDeviceLimits where type FieldType "maxDescriptorSetStorageBuffersDynamic" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxDescriptorSetStorageBuffersDynamic" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxDescriptorSetStorageBuffersDynamic" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxDescriptorSetStorageBuffersDynamic} type FieldIsArray "maxDescriptorSetStorageBuffersDynamic" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxDescriptorSetStorageBuffersDynamic} instance {-# OVERLAPPING #-} CanReadField "maxDescriptorSetStorageBuffersDynamic" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxDescriptorSetStorageBuffersDynamic}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxDescriptorSetStorageBuffersDynamic} instance {-# OVERLAPPING #-} CanWriteField "maxDescriptorSetStorageBuffersDynamic" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxDescriptorSetStorageBuffersDynamic} instance {-# OVERLAPPING #-} HasField "maxDescriptorSetSampledImages" VkPhysicalDeviceLimits where type FieldType "maxDescriptorSetSampledImages" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxDescriptorSetSampledImages" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxDescriptorSetSampledImages" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxDescriptorSetSampledImages} type FieldIsArray "maxDescriptorSetSampledImages" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxDescriptorSetSampledImages} instance {-# OVERLAPPING #-} CanReadField "maxDescriptorSetSampledImages" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxDescriptorSetSampledImages}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxDescriptorSetSampledImages} instance {-# OVERLAPPING #-} CanWriteField "maxDescriptorSetSampledImages" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxDescriptorSetSampledImages} instance {-# OVERLAPPING #-} HasField "maxDescriptorSetStorageImages" VkPhysicalDeviceLimits where type FieldType "maxDescriptorSetStorageImages" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxDescriptorSetStorageImages" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxDescriptorSetStorageImages" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxDescriptorSetStorageImages} type FieldIsArray "maxDescriptorSetStorageImages" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxDescriptorSetStorageImages} instance {-# OVERLAPPING #-} CanReadField "maxDescriptorSetStorageImages" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxDescriptorSetStorageImages}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxDescriptorSetStorageImages} instance {-# OVERLAPPING #-} CanWriteField "maxDescriptorSetStorageImages" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxDescriptorSetStorageImages} instance {-# OVERLAPPING #-} HasField "maxDescriptorSetInputAttachments" VkPhysicalDeviceLimits where type FieldType "maxDescriptorSetInputAttachments" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxDescriptorSetInputAttachments" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxDescriptorSetInputAttachments" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxDescriptorSetInputAttachments} type FieldIsArray "maxDescriptorSetInputAttachments" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxDescriptorSetInputAttachments} instance {-# OVERLAPPING #-} CanReadField "maxDescriptorSetInputAttachments" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxDescriptorSetInputAttachments}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxDescriptorSetInputAttachments} instance {-# OVERLAPPING #-} CanWriteField "maxDescriptorSetInputAttachments" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxDescriptorSetInputAttachments} instance {-# OVERLAPPING #-} HasField "maxVertexInputAttributes" VkPhysicalDeviceLimits where type FieldType "maxVertexInputAttributes" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxVertexInputAttributes" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxVertexInputAttributes" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxVertexInputAttributes} type FieldIsArray "maxVertexInputAttributes" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxVertexInputAttributes} instance {-# OVERLAPPING #-} CanReadField "maxVertexInputAttributes" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxVertexInputAttributes}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxVertexInputAttributes} instance {-# OVERLAPPING #-} CanWriteField "maxVertexInputAttributes" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxVertexInputAttributes} instance {-# OVERLAPPING #-} HasField "maxVertexInputBindings" VkPhysicalDeviceLimits where type FieldType "maxVertexInputBindings" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxVertexInputBindings" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxVertexInputBindings" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxVertexInputBindings} type FieldIsArray "maxVertexInputBindings" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxVertexInputBindings} instance {-# OVERLAPPING #-} CanReadField "maxVertexInputBindings" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxVertexInputBindings}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxVertexInputBindings} instance {-# OVERLAPPING #-} CanWriteField "maxVertexInputBindings" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxVertexInputBindings} instance {-# OVERLAPPING #-} HasField "maxVertexInputAttributeOffset" VkPhysicalDeviceLimits where type FieldType "maxVertexInputAttributeOffset" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxVertexInputAttributeOffset" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxVertexInputAttributeOffset" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxVertexInputAttributeOffset} type FieldIsArray "maxVertexInputAttributeOffset" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxVertexInputAttributeOffset} instance {-# OVERLAPPING #-} CanReadField "maxVertexInputAttributeOffset" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxVertexInputAttributeOffset}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxVertexInputAttributeOffset} instance {-# OVERLAPPING #-} CanWriteField "maxVertexInputAttributeOffset" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxVertexInputAttributeOffset} instance {-# OVERLAPPING #-} HasField "maxVertexInputBindingStride" VkPhysicalDeviceLimits where type FieldType "maxVertexInputBindingStride" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxVertexInputBindingStride" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxVertexInputBindingStride" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxVertexInputBindingStride} type FieldIsArray "maxVertexInputBindingStride" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxVertexInputBindingStride} instance {-# OVERLAPPING #-} CanReadField "maxVertexInputBindingStride" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxVertexInputBindingStride}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxVertexInputBindingStride} instance {-# OVERLAPPING #-} CanWriteField "maxVertexInputBindingStride" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxVertexInputBindingStride} instance {-# OVERLAPPING #-} HasField "maxVertexOutputComponents" VkPhysicalDeviceLimits where type FieldType "maxVertexOutputComponents" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxVertexOutputComponents" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxVertexOutputComponents" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxVertexOutputComponents} type FieldIsArray "maxVertexOutputComponents" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxVertexOutputComponents} instance {-# OVERLAPPING #-} CanReadField "maxVertexOutputComponents" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxVertexOutputComponents}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxVertexOutputComponents} instance {-# OVERLAPPING #-} CanWriteField "maxVertexOutputComponents" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxVertexOutputComponents} instance {-# OVERLAPPING #-} HasField "maxTessellationGenerationLevel" VkPhysicalDeviceLimits where type FieldType "maxTessellationGenerationLevel" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxTessellationGenerationLevel" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxTessellationGenerationLevel" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxTessellationGenerationLevel} type FieldIsArray "maxTessellationGenerationLevel" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxTessellationGenerationLevel} instance {-# OVERLAPPING #-} CanReadField "maxTessellationGenerationLevel" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxTessellationGenerationLevel}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxTessellationGenerationLevel} instance {-# OVERLAPPING #-} CanWriteField "maxTessellationGenerationLevel" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxTessellationGenerationLevel} instance {-# OVERLAPPING #-} HasField "maxTessellationPatchSize" VkPhysicalDeviceLimits where type FieldType "maxTessellationPatchSize" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxTessellationPatchSize" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxTessellationPatchSize" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxTessellationPatchSize} type FieldIsArray "maxTessellationPatchSize" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxTessellationPatchSize} instance {-# OVERLAPPING #-} CanReadField "maxTessellationPatchSize" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxTessellationPatchSize}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxTessellationPatchSize} instance {-# OVERLAPPING #-} CanWriteField "maxTessellationPatchSize" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxTessellationPatchSize} instance {-# OVERLAPPING #-} HasField "maxTessellationControlPerVertexInputComponents" VkPhysicalDeviceLimits where type FieldType "maxTessellationControlPerVertexInputComponents" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxTessellationControlPerVertexInputComponents" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxTessellationControlPerVertexInputComponents" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxTessellationControlPerVertexInputComponents} type FieldIsArray "maxTessellationControlPerVertexInputComponents" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxTessellationControlPerVertexInputComponents} instance {-# OVERLAPPING #-} CanReadField "maxTessellationControlPerVertexInputComponents" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxTessellationControlPerVertexInputComponents}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxTessellationControlPerVertexInputComponents} instance {-# OVERLAPPING #-} CanWriteField "maxTessellationControlPerVertexInputComponents" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxTessellationControlPerVertexInputComponents} instance {-# OVERLAPPING #-} HasField "maxTessellationControlPerVertexOutputComponents" VkPhysicalDeviceLimits where type FieldType "maxTessellationControlPerVertexOutputComponents" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxTessellationControlPerVertexOutputComponents" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxTessellationControlPerVertexOutputComponents" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxTessellationControlPerVertexOutputComponents} type FieldIsArray "maxTessellationControlPerVertexOutputComponents" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxTessellationControlPerVertexOutputComponents} instance {-# OVERLAPPING #-} CanReadField "maxTessellationControlPerVertexOutputComponents" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxTessellationControlPerVertexOutputComponents}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxTessellationControlPerVertexOutputComponents} instance {-# OVERLAPPING #-} CanWriteField "maxTessellationControlPerVertexOutputComponents" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxTessellationControlPerVertexOutputComponents} instance {-# OVERLAPPING #-} HasField "maxTessellationControlPerPatchOutputComponents" VkPhysicalDeviceLimits where type FieldType "maxTessellationControlPerPatchOutputComponents" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxTessellationControlPerPatchOutputComponents" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxTessellationControlPerPatchOutputComponents" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxTessellationControlPerPatchOutputComponents} type FieldIsArray "maxTessellationControlPerPatchOutputComponents" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxTessellationControlPerPatchOutputComponents} instance {-# OVERLAPPING #-} CanReadField "maxTessellationControlPerPatchOutputComponents" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxTessellationControlPerPatchOutputComponents}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxTessellationControlPerPatchOutputComponents} instance {-# OVERLAPPING #-} CanWriteField "maxTessellationControlPerPatchOutputComponents" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxTessellationControlPerPatchOutputComponents} instance {-# OVERLAPPING #-} HasField "maxTessellationControlTotalOutputComponents" VkPhysicalDeviceLimits where type FieldType "maxTessellationControlTotalOutputComponents" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxTessellationControlTotalOutputComponents" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxTessellationControlTotalOutputComponents" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxTessellationControlTotalOutputComponents} type FieldIsArray "maxTessellationControlTotalOutputComponents" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxTessellationControlTotalOutputComponents} instance {-# OVERLAPPING #-} CanReadField "maxTessellationControlTotalOutputComponents" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxTessellationControlTotalOutputComponents}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxTessellationControlTotalOutputComponents} instance {-# OVERLAPPING #-} CanWriteField "maxTessellationControlTotalOutputComponents" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxTessellationControlTotalOutputComponents} instance {-# OVERLAPPING #-} HasField "maxTessellationEvaluationInputComponents" VkPhysicalDeviceLimits where type FieldType "maxTessellationEvaluationInputComponents" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxTessellationEvaluationInputComponents" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxTessellationEvaluationInputComponents" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxTessellationEvaluationInputComponents} type FieldIsArray "maxTessellationEvaluationInputComponents" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxTessellationEvaluationInputComponents} instance {-# OVERLAPPING #-} CanReadField "maxTessellationEvaluationInputComponents" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxTessellationEvaluationInputComponents}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxTessellationEvaluationInputComponents} instance {-# OVERLAPPING #-} CanWriteField "maxTessellationEvaluationInputComponents" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxTessellationEvaluationInputComponents} instance {-# OVERLAPPING #-} HasField "maxTessellationEvaluationOutputComponents" VkPhysicalDeviceLimits where type FieldType "maxTessellationEvaluationOutputComponents" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxTessellationEvaluationOutputComponents" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxTessellationEvaluationOutputComponents" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxTessellationEvaluationOutputComponents} type FieldIsArray "maxTessellationEvaluationOutputComponents" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxTessellationEvaluationOutputComponents} instance {-# OVERLAPPING #-} CanReadField "maxTessellationEvaluationOutputComponents" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxTessellationEvaluationOutputComponents}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxTessellationEvaluationOutputComponents} instance {-# OVERLAPPING #-} CanWriteField "maxTessellationEvaluationOutputComponents" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxTessellationEvaluationOutputComponents} instance {-# OVERLAPPING #-} HasField "maxGeometryShaderInvocations" VkPhysicalDeviceLimits where type FieldType "maxGeometryShaderInvocations" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxGeometryShaderInvocations" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxGeometryShaderInvocations" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxGeometryShaderInvocations} type FieldIsArray "maxGeometryShaderInvocations" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxGeometryShaderInvocations} instance {-# OVERLAPPING #-} CanReadField "maxGeometryShaderInvocations" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxGeometryShaderInvocations}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxGeometryShaderInvocations} instance {-# OVERLAPPING #-} CanWriteField "maxGeometryShaderInvocations" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxGeometryShaderInvocations} instance {-# OVERLAPPING #-} HasField "maxGeometryInputComponents" VkPhysicalDeviceLimits where type FieldType "maxGeometryInputComponents" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxGeometryInputComponents" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxGeometryInputComponents" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxGeometryInputComponents} type FieldIsArray "maxGeometryInputComponents" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxGeometryInputComponents} instance {-# OVERLAPPING #-} CanReadField "maxGeometryInputComponents" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxGeometryInputComponents}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxGeometryInputComponents} instance {-# OVERLAPPING #-} CanWriteField "maxGeometryInputComponents" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxGeometryInputComponents} instance {-# OVERLAPPING #-} HasField "maxGeometryOutputComponents" VkPhysicalDeviceLimits where type FieldType "maxGeometryOutputComponents" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxGeometryOutputComponents" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxGeometryOutputComponents" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxGeometryOutputComponents} type FieldIsArray "maxGeometryOutputComponents" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxGeometryOutputComponents} instance {-# OVERLAPPING #-} CanReadField "maxGeometryOutputComponents" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxGeometryOutputComponents}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxGeometryOutputComponents} instance {-# OVERLAPPING #-} CanWriteField "maxGeometryOutputComponents" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxGeometryOutputComponents} instance {-# OVERLAPPING #-} HasField "maxGeometryOutputVertices" VkPhysicalDeviceLimits where type FieldType "maxGeometryOutputVertices" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxGeometryOutputVertices" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxGeometryOutputVertices" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxGeometryOutputVertices} type FieldIsArray "maxGeometryOutputVertices" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxGeometryOutputVertices} instance {-# OVERLAPPING #-} CanReadField "maxGeometryOutputVertices" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxGeometryOutputVertices}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxGeometryOutputVertices} instance {-# OVERLAPPING #-} CanWriteField "maxGeometryOutputVertices" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxGeometryOutputVertices} instance {-# OVERLAPPING #-} HasField "maxGeometryTotalOutputComponents" VkPhysicalDeviceLimits where type FieldType "maxGeometryTotalOutputComponents" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxGeometryTotalOutputComponents" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxGeometryTotalOutputComponents" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxGeometryTotalOutputComponents} type FieldIsArray "maxGeometryTotalOutputComponents" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxGeometryTotalOutputComponents} instance {-# OVERLAPPING #-} CanReadField "maxGeometryTotalOutputComponents" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxGeometryTotalOutputComponents}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxGeometryTotalOutputComponents} instance {-# OVERLAPPING #-} CanWriteField "maxGeometryTotalOutputComponents" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxGeometryTotalOutputComponents} instance {-# OVERLAPPING #-} HasField "maxFragmentInputComponents" VkPhysicalDeviceLimits where type FieldType "maxFragmentInputComponents" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxFragmentInputComponents" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxFragmentInputComponents" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxFragmentInputComponents} type FieldIsArray "maxFragmentInputComponents" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxFragmentInputComponents} instance {-# OVERLAPPING #-} CanReadField "maxFragmentInputComponents" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxFragmentInputComponents}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxFragmentInputComponents} instance {-# OVERLAPPING #-} CanWriteField "maxFragmentInputComponents" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxFragmentInputComponents} instance {-# OVERLAPPING #-} HasField "maxFragmentOutputAttachments" VkPhysicalDeviceLimits where type FieldType "maxFragmentOutputAttachments" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxFragmentOutputAttachments" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxFragmentOutputAttachments" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxFragmentOutputAttachments} type FieldIsArray "maxFragmentOutputAttachments" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxFragmentOutputAttachments} instance {-# OVERLAPPING #-} CanReadField "maxFragmentOutputAttachments" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxFragmentOutputAttachments}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxFragmentOutputAttachments} instance {-# OVERLAPPING #-} CanWriteField "maxFragmentOutputAttachments" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxFragmentOutputAttachments} instance {-# OVERLAPPING #-} HasField "maxFragmentDualSrcAttachments" VkPhysicalDeviceLimits where type FieldType "maxFragmentDualSrcAttachments" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxFragmentDualSrcAttachments" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxFragmentDualSrcAttachments" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxFragmentDualSrcAttachments} type FieldIsArray "maxFragmentDualSrcAttachments" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxFragmentDualSrcAttachments} instance {-# OVERLAPPING #-} CanReadField "maxFragmentDualSrcAttachments" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxFragmentDualSrcAttachments}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxFragmentDualSrcAttachments} instance {-# OVERLAPPING #-} CanWriteField "maxFragmentDualSrcAttachments" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxFragmentDualSrcAttachments} instance {-# OVERLAPPING #-} HasField "maxFragmentCombinedOutputResources" VkPhysicalDeviceLimits where type FieldType "maxFragmentCombinedOutputResources" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxFragmentCombinedOutputResources" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxFragmentCombinedOutputResources" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxFragmentCombinedOutputResources} type FieldIsArray "maxFragmentCombinedOutputResources" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxFragmentCombinedOutputResources} instance {-# OVERLAPPING #-} CanReadField "maxFragmentCombinedOutputResources" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxFragmentCombinedOutputResources}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxFragmentCombinedOutputResources} instance {-# OVERLAPPING #-} CanWriteField "maxFragmentCombinedOutputResources" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxFragmentCombinedOutputResources} instance {-# OVERLAPPING #-} HasField "maxComputeSharedMemorySize" VkPhysicalDeviceLimits where type FieldType "maxComputeSharedMemorySize" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxComputeSharedMemorySize" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxComputeSharedMemorySize" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxComputeSharedMemorySize} type FieldIsArray "maxComputeSharedMemorySize" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxComputeSharedMemorySize} instance {-# OVERLAPPING #-} CanReadField "maxComputeSharedMemorySize" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxComputeSharedMemorySize}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxComputeSharedMemorySize} instance {-# OVERLAPPING #-} CanWriteField "maxComputeSharedMemorySize" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxComputeSharedMemorySize} instance {-# OVERLAPPING #-} HasField "maxComputeWorkGroupCount" VkPhysicalDeviceLimits where type FieldType "maxComputeWorkGroupCount" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxComputeWorkGroupCount" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxComputeWorkGroupCount" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxComputeWorkGroupCount} type FieldIsArray "maxComputeWorkGroupCount" VkPhysicalDeviceLimits = 'True -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxComputeWorkGroupCount} instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "maxComputeWorkGroupCount" idx VkPhysicalDeviceLimits) => CanReadFieldArray "maxComputeWorkGroupCount" idx VkPhysicalDeviceLimits where {-# SPECIALISE instance CanReadFieldArray "maxComputeWorkGroupCount" 0 VkPhysicalDeviceLimits #-} {-# SPECIALISE instance CanReadFieldArray "maxComputeWorkGroupCount" 1 VkPhysicalDeviceLimits #-} {-# SPECIALISE instance CanReadFieldArray "maxComputeWorkGroupCount" 2 VkPhysicalDeviceLimits #-} type FieldArrayLength "maxComputeWorkGroupCount" VkPhysicalDeviceLimits = 3 {-# INLINE fieldArrayLength #-} fieldArrayLength = 3 {-# INLINE getFieldArray #-} getFieldArray = f where {-# NOINLINE f #-} f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off) off = #{offset VkPhysicalDeviceLimits, maxComputeWorkGroupCount} + sizeOf (undefined :: Word32) * fromInteger (natVal' (proxy## :: Proxy## idx)) -- ' closing tick for hsc2hs {-# INLINE readFieldArray #-} readFieldArray p = peekByteOff p (#{offset VkPhysicalDeviceLimits, maxComputeWorkGroupCount} + sizeOf (undefined :: Word32) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "maxComputeWorkGroupCount" idx VkPhysicalDeviceLimits) => CanWriteFieldArray "maxComputeWorkGroupCount" idx VkPhysicalDeviceLimits where {-# SPECIALISE instance CanWriteFieldArray "maxComputeWorkGroupCount" 0 VkPhysicalDeviceLimits #-} {-# SPECIALISE instance CanWriteFieldArray "maxComputeWorkGroupCount" 1 VkPhysicalDeviceLimits #-} {-# SPECIALISE instance CanWriteFieldArray "maxComputeWorkGroupCount" 2 VkPhysicalDeviceLimits #-} {-# INLINE writeFieldArray #-} writeFieldArray p = pokeByteOff p (#{offset VkPhysicalDeviceLimits, maxComputeWorkGroupCount} + sizeOf (undefined :: Word32) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "maxComputeWorkGroupInvocations" VkPhysicalDeviceLimits where type FieldType "maxComputeWorkGroupInvocations" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxComputeWorkGroupInvocations" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxComputeWorkGroupInvocations" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxComputeWorkGroupInvocations} type FieldIsArray "maxComputeWorkGroupInvocations" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxComputeWorkGroupInvocations} instance {-# OVERLAPPING #-} CanReadField "maxComputeWorkGroupInvocations" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxComputeWorkGroupInvocations}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxComputeWorkGroupInvocations} instance {-# OVERLAPPING #-} CanWriteField "maxComputeWorkGroupInvocations" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxComputeWorkGroupInvocations} instance {-# OVERLAPPING #-} HasField "maxComputeWorkGroupSize" VkPhysicalDeviceLimits where type FieldType "maxComputeWorkGroupSize" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxComputeWorkGroupSize" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxComputeWorkGroupSize" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxComputeWorkGroupSize} type FieldIsArray "maxComputeWorkGroupSize" VkPhysicalDeviceLimits = 'True -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxComputeWorkGroupSize} instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "maxComputeWorkGroupSize" idx VkPhysicalDeviceLimits) => CanReadFieldArray "maxComputeWorkGroupSize" idx VkPhysicalDeviceLimits where {-# SPECIALISE instance CanReadFieldArray "maxComputeWorkGroupSize" 0 VkPhysicalDeviceLimits #-} {-# SPECIALISE instance CanReadFieldArray "maxComputeWorkGroupSize" 1 VkPhysicalDeviceLimits #-} {-# SPECIALISE instance CanReadFieldArray "maxComputeWorkGroupSize" 2 VkPhysicalDeviceLimits #-} type FieldArrayLength "maxComputeWorkGroupSize" VkPhysicalDeviceLimits = 3 {-# INLINE fieldArrayLength #-} fieldArrayLength = 3 {-# INLINE getFieldArray #-} getFieldArray = f where {-# NOINLINE f #-} f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off) off = #{offset VkPhysicalDeviceLimits, maxComputeWorkGroupSize} + sizeOf (undefined :: Word32) * fromInteger (natVal' (proxy## :: Proxy## idx)) -- ' closing tick for hsc2hs {-# INLINE readFieldArray #-} readFieldArray p = peekByteOff p (#{offset VkPhysicalDeviceLimits, maxComputeWorkGroupSize} + sizeOf (undefined :: Word32) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "maxComputeWorkGroupSize" idx VkPhysicalDeviceLimits) => CanWriteFieldArray "maxComputeWorkGroupSize" idx VkPhysicalDeviceLimits where {-# SPECIALISE instance CanWriteFieldArray "maxComputeWorkGroupSize" 0 VkPhysicalDeviceLimits #-} {-# SPECIALISE instance CanWriteFieldArray "maxComputeWorkGroupSize" 1 VkPhysicalDeviceLimits #-} {-# SPECIALISE instance CanWriteFieldArray "maxComputeWorkGroupSize" 2 VkPhysicalDeviceLimits #-} {-# INLINE writeFieldArray #-} writeFieldArray p = pokeByteOff p (#{offset VkPhysicalDeviceLimits, maxComputeWorkGroupSize} + sizeOf (undefined :: Word32) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "subPixelPrecisionBits" VkPhysicalDeviceLimits where type FieldType "subPixelPrecisionBits" VkPhysicalDeviceLimits = Word32 type FieldOptional "subPixelPrecisionBits" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "subPixelPrecisionBits" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, subPixelPrecisionBits} type FieldIsArray "subPixelPrecisionBits" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, subPixelPrecisionBits} instance {-# OVERLAPPING #-} CanReadField "subPixelPrecisionBits" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, subPixelPrecisionBits}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, subPixelPrecisionBits} instance {-# OVERLAPPING #-} CanWriteField "subPixelPrecisionBits" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, subPixelPrecisionBits} instance {-# OVERLAPPING #-} HasField "subTexelPrecisionBits" VkPhysicalDeviceLimits where type FieldType "subTexelPrecisionBits" VkPhysicalDeviceLimits = Word32 type FieldOptional "subTexelPrecisionBits" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "subTexelPrecisionBits" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, subTexelPrecisionBits} type FieldIsArray "subTexelPrecisionBits" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, subTexelPrecisionBits} instance {-# OVERLAPPING #-} CanReadField "subTexelPrecisionBits" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, subTexelPrecisionBits}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, subTexelPrecisionBits} instance {-# OVERLAPPING #-} CanWriteField "subTexelPrecisionBits" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, subTexelPrecisionBits} instance {-# OVERLAPPING #-} HasField "mipmapPrecisionBits" VkPhysicalDeviceLimits where type FieldType "mipmapPrecisionBits" VkPhysicalDeviceLimits = Word32 type FieldOptional "mipmapPrecisionBits" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "mipmapPrecisionBits" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, mipmapPrecisionBits} type FieldIsArray "mipmapPrecisionBits" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, mipmapPrecisionBits} instance {-# OVERLAPPING #-} CanReadField "mipmapPrecisionBits" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, mipmapPrecisionBits}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, mipmapPrecisionBits} instance {-# OVERLAPPING #-} CanWriteField "mipmapPrecisionBits" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, mipmapPrecisionBits} instance {-# OVERLAPPING #-} HasField "maxDrawIndexedIndexValue" VkPhysicalDeviceLimits where type FieldType "maxDrawIndexedIndexValue" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxDrawIndexedIndexValue" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxDrawIndexedIndexValue" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxDrawIndexedIndexValue} type FieldIsArray "maxDrawIndexedIndexValue" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxDrawIndexedIndexValue} instance {-# OVERLAPPING #-} CanReadField "maxDrawIndexedIndexValue" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxDrawIndexedIndexValue}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxDrawIndexedIndexValue} instance {-# OVERLAPPING #-} CanWriteField "maxDrawIndexedIndexValue" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxDrawIndexedIndexValue} instance {-# OVERLAPPING #-} HasField "maxDrawIndirectCount" VkPhysicalDeviceLimits where type FieldType "maxDrawIndirectCount" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxDrawIndirectCount" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxDrawIndirectCount" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxDrawIndirectCount} type FieldIsArray "maxDrawIndirectCount" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxDrawIndirectCount} instance {-# OVERLAPPING #-} CanReadField "maxDrawIndirectCount" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxDrawIndirectCount}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxDrawIndirectCount} instance {-# OVERLAPPING #-} CanWriteField "maxDrawIndirectCount" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxDrawIndirectCount} instance {-# OVERLAPPING #-} HasField "maxSamplerLodBias" VkPhysicalDeviceLimits where type FieldType "maxSamplerLodBias" VkPhysicalDeviceLimits = #{type float} type FieldOptional "maxSamplerLodBias" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxSamplerLodBias" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxSamplerLodBias} type FieldIsArray "maxSamplerLodBias" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxSamplerLodBias} instance {-# OVERLAPPING #-} CanReadField "maxSamplerLodBias" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxSamplerLodBias}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxSamplerLodBias} instance {-# OVERLAPPING #-} CanWriteField "maxSamplerLodBias" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxSamplerLodBias} instance {-# OVERLAPPING #-} HasField "maxSamplerAnisotropy" VkPhysicalDeviceLimits where type FieldType "maxSamplerAnisotropy" VkPhysicalDeviceLimits = #{type float} type FieldOptional "maxSamplerAnisotropy" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxSamplerAnisotropy" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxSamplerAnisotropy} type FieldIsArray "maxSamplerAnisotropy" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxSamplerAnisotropy} instance {-# OVERLAPPING #-} CanReadField "maxSamplerAnisotropy" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxSamplerAnisotropy}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxSamplerAnisotropy} instance {-# OVERLAPPING #-} CanWriteField "maxSamplerAnisotropy" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxSamplerAnisotropy} instance {-# OVERLAPPING #-} HasField "maxViewports" VkPhysicalDeviceLimits where type FieldType "maxViewports" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxViewports" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxViewports" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxViewports} type FieldIsArray "maxViewports" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxViewports} instance {-# OVERLAPPING #-} CanReadField "maxViewports" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxViewports}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxViewports} instance {-# OVERLAPPING #-} CanWriteField "maxViewports" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxViewports} instance {-# OVERLAPPING #-} HasField "maxViewportDimensions" VkPhysicalDeviceLimits where type FieldType "maxViewportDimensions" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxViewportDimensions" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxViewportDimensions" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxViewportDimensions} type FieldIsArray "maxViewportDimensions" VkPhysicalDeviceLimits = 'True -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxViewportDimensions} instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "maxViewportDimensions" idx VkPhysicalDeviceLimits) => CanReadFieldArray "maxViewportDimensions" idx VkPhysicalDeviceLimits where {-# SPECIALISE instance CanReadFieldArray "maxViewportDimensions" 0 VkPhysicalDeviceLimits #-} {-# SPECIALISE instance CanReadFieldArray "maxViewportDimensions" 1 VkPhysicalDeviceLimits #-} type FieldArrayLength "maxViewportDimensions" VkPhysicalDeviceLimits = 2 {-# INLINE fieldArrayLength #-} fieldArrayLength = 2 {-# INLINE getFieldArray #-} getFieldArray = f where {-# NOINLINE f #-} f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off) off = #{offset VkPhysicalDeviceLimits, maxViewportDimensions} + sizeOf (undefined :: Word32) * fromInteger (natVal' (proxy## :: Proxy## idx)) -- ' closing tick for hsc2hs {-# INLINE readFieldArray #-} readFieldArray p = peekByteOff p (#{offset VkPhysicalDeviceLimits, maxViewportDimensions} + sizeOf (undefined :: Word32) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "maxViewportDimensions" idx VkPhysicalDeviceLimits) => CanWriteFieldArray "maxViewportDimensions" idx VkPhysicalDeviceLimits where {-# SPECIALISE instance CanWriteFieldArray "maxViewportDimensions" 0 VkPhysicalDeviceLimits #-} {-# SPECIALISE instance CanWriteFieldArray "maxViewportDimensions" 1 VkPhysicalDeviceLimits #-} {-# INLINE writeFieldArray #-} writeFieldArray p = pokeByteOff p (#{offset VkPhysicalDeviceLimits, maxViewportDimensions} + sizeOf (undefined :: Word32) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "viewportBoundsRange" VkPhysicalDeviceLimits where type FieldType "viewportBoundsRange" VkPhysicalDeviceLimits = #{type float} type FieldOptional "viewportBoundsRange" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "viewportBoundsRange" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, viewportBoundsRange} type FieldIsArray "viewportBoundsRange" VkPhysicalDeviceLimits = 'True -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, viewportBoundsRange} instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "viewportBoundsRange" idx VkPhysicalDeviceLimits) => CanReadFieldArray "viewportBoundsRange" idx VkPhysicalDeviceLimits where {-# SPECIALISE instance CanReadFieldArray "viewportBoundsRange" 0 VkPhysicalDeviceLimits #-} {-# SPECIALISE instance CanReadFieldArray "viewportBoundsRange" 1 VkPhysicalDeviceLimits #-} type FieldArrayLength "viewportBoundsRange" VkPhysicalDeviceLimits = 2 {-# INLINE fieldArrayLength #-} fieldArrayLength = 2 {-# INLINE getFieldArray #-} getFieldArray = f where {-# NOINLINE f #-} f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off) off = #{offset VkPhysicalDeviceLimits, viewportBoundsRange} + sizeOf (undefined :: #{type float}) * fromInteger (natVal' (proxy## :: Proxy## idx)) -- ' closing tick for hsc2hs {-# INLINE readFieldArray #-} readFieldArray p = peekByteOff p (#{offset VkPhysicalDeviceLimits, viewportBoundsRange} + sizeOf (undefined :: #{type float}) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "viewportBoundsRange" idx VkPhysicalDeviceLimits) => CanWriteFieldArray "viewportBoundsRange" idx VkPhysicalDeviceLimits where {-# SPECIALISE instance CanWriteFieldArray "viewportBoundsRange" 0 VkPhysicalDeviceLimits #-} {-# SPECIALISE instance CanWriteFieldArray "viewportBoundsRange" 1 VkPhysicalDeviceLimits #-} {-# INLINE writeFieldArray #-} writeFieldArray p = pokeByteOff p (#{offset VkPhysicalDeviceLimits, viewportBoundsRange} + sizeOf (undefined :: #{type float}) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "viewportSubPixelBits" VkPhysicalDeviceLimits where type FieldType "viewportSubPixelBits" VkPhysicalDeviceLimits = Word32 type FieldOptional "viewportSubPixelBits" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "viewportSubPixelBits" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, viewportSubPixelBits} type FieldIsArray "viewportSubPixelBits" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, viewportSubPixelBits} instance {-# OVERLAPPING #-} CanReadField "viewportSubPixelBits" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, viewportSubPixelBits}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, viewportSubPixelBits} instance {-# OVERLAPPING #-} CanWriteField "viewportSubPixelBits" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, viewportSubPixelBits} instance {-# OVERLAPPING #-} HasField "minMemoryMapAlignment" VkPhysicalDeviceLimits where type FieldType "minMemoryMapAlignment" VkPhysicalDeviceLimits = CSize type FieldOptional "minMemoryMapAlignment" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "minMemoryMapAlignment" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, minMemoryMapAlignment} type FieldIsArray "minMemoryMapAlignment" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, minMemoryMapAlignment} instance {-# OVERLAPPING #-} CanReadField "minMemoryMapAlignment" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, minMemoryMapAlignment}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, minMemoryMapAlignment} instance {-# OVERLAPPING #-} CanWriteField "minMemoryMapAlignment" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, minMemoryMapAlignment} instance {-# OVERLAPPING #-} HasField "minTexelBufferOffsetAlignment" VkPhysicalDeviceLimits where type FieldType "minTexelBufferOffsetAlignment" VkPhysicalDeviceLimits = VkDeviceSize type FieldOptional "minTexelBufferOffsetAlignment" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "minTexelBufferOffsetAlignment" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, minTexelBufferOffsetAlignment} type FieldIsArray "minTexelBufferOffsetAlignment" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, minTexelBufferOffsetAlignment} instance {-# OVERLAPPING #-} CanReadField "minTexelBufferOffsetAlignment" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, minTexelBufferOffsetAlignment}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, minTexelBufferOffsetAlignment} instance {-# OVERLAPPING #-} CanWriteField "minTexelBufferOffsetAlignment" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, minTexelBufferOffsetAlignment} instance {-# OVERLAPPING #-} HasField "minUniformBufferOffsetAlignment" VkPhysicalDeviceLimits where type FieldType "minUniformBufferOffsetAlignment" VkPhysicalDeviceLimits = VkDeviceSize type FieldOptional "minUniformBufferOffsetAlignment" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "minUniformBufferOffsetAlignment" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, minUniformBufferOffsetAlignment} type FieldIsArray "minUniformBufferOffsetAlignment" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, minUniformBufferOffsetAlignment} instance {-# OVERLAPPING #-} CanReadField "minUniformBufferOffsetAlignment" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, minUniformBufferOffsetAlignment}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, minUniformBufferOffsetAlignment} instance {-# OVERLAPPING #-} CanWriteField "minUniformBufferOffsetAlignment" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, minUniformBufferOffsetAlignment} instance {-# OVERLAPPING #-} HasField "minStorageBufferOffsetAlignment" VkPhysicalDeviceLimits where type FieldType "minStorageBufferOffsetAlignment" VkPhysicalDeviceLimits = VkDeviceSize type FieldOptional "minStorageBufferOffsetAlignment" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "minStorageBufferOffsetAlignment" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, minStorageBufferOffsetAlignment} type FieldIsArray "minStorageBufferOffsetAlignment" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, minStorageBufferOffsetAlignment} instance {-# OVERLAPPING #-} CanReadField "minStorageBufferOffsetAlignment" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, minStorageBufferOffsetAlignment}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, minStorageBufferOffsetAlignment} instance {-# OVERLAPPING #-} CanWriteField "minStorageBufferOffsetAlignment" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, minStorageBufferOffsetAlignment} instance {-# OVERLAPPING #-} HasField "minTexelOffset" VkPhysicalDeviceLimits where type FieldType "minTexelOffset" VkPhysicalDeviceLimits = Int32 type FieldOptional "minTexelOffset" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "minTexelOffset" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, minTexelOffset} type FieldIsArray "minTexelOffset" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, minTexelOffset} instance {-# OVERLAPPING #-} CanReadField "minTexelOffset" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, minTexelOffset}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, minTexelOffset} instance {-# OVERLAPPING #-} CanWriteField "minTexelOffset" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, minTexelOffset} instance {-# OVERLAPPING #-} HasField "maxTexelOffset" VkPhysicalDeviceLimits where type FieldType "maxTexelOffset" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxTexelOffset" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxTexelOffset" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxTexelOffset} type FieldIsArray "maxTexelOffset" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxTexelOffset} instance {-# OVERLAPPING #-} CanReadField "maxTexelOffset" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxTexelOffset}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxTexelOffset} instance {-# OVERLAPPING #-} CanWriteField "maxTexelOffset" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxTexelOffset} instance {-# OVERLAPPING #-} HasField "minTexelGatherOffset" VkPhysicalDeviceLimits where type FieldType "minTexelGatherOffset" VkPhysicalDeviceLimits = Int32 type FieldOptional "minTexelGatherOffset" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "minTexelGatherOffset" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, minTexelGatherOffset} type FieldIsArray "minTexelGatherOffset" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, minTexelGatherOffset} instance {-# OVERLAPPING #-} CanReadField "minTexelGatherOffset" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, minTexelGatherOffset}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, minTexelGatherOffset} instance {-# OVERLAPPING #-} CanWriteField "minTexelGatherOffset" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, minTexelGatherOffset} instance {-# OVERLAPPING #-} HasField "maxTexelGatherOffset" VkPhysicalDeviceLimits where type FieldType "maxTexelGatherOffset" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxTexelGatherOffset" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxTexelGatherOffset" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxTexelGatherOffset} type FieldIsArray "maxTexelGatherOffset" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxTexelGatherOffset} instance {-# OVERLAPPING #-} CanReadField "maxTexelGatherOffset" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxTexelGatherOffset}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxTexelGatherOffset} instance {-# OVERLAPPING #-} CanWriteField "maxTexelGatherOffset" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxTexelGatherOffset} instance {-# OVERLAPPING #-} HasField "minInterpolationOffset" VkPhysicalDeviceLimits where type FieldType "minInterpolationOffset" VkPhysicalDeviceLimits = #{type float} type FieldOptional "minInterpolationOffset" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "minInterpolationOffset" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, minInterpolationOffset} type FieldIsArray "minInterpolationOffset" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, minInterpolationOffset} instance {-# OVERLAPPING #-} CanReadField "minInterpolationOffset" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, minInterpolationOffset}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, minInterpolationOffset} instance {-# OVERLAPPING #-} CanWriteField "minInterpolationOffset" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, minInterpolationOffset} instance {-# OVERLAPPING #-} HasField "maxInterpolationOffset" VkPhysicalDeviceLimits where type FieldType "maxInterpolationOffset" VkPhysicalDeviceLimits = #{type float} type FieldOptional "maxInterpolationOffset" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxInterpolationOffset" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxInterpolationOffset} type FieldIsArray "maxInterpolationOffset" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxInterpolationOffset} instance {-# OVERLAPPING #-} CanReadField "maxInterpolationOffset" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxInterpolationOffset}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxInterpolationOffset} instance {-# OVERLAPPING #-} CanWriteField "maxInterpolationOffset" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxInterpolationOffset} instance {-# OVERLAPPING #-} HasField "subPixelInterpolationOffsetBits" VkPhysicalDeviceLimits where type FieldType "subPixelInterpolationOffsetBits" VkPhysicalDeviceLimits = Word32 type FieldOptional "subPixelInterpolationOffsetBits" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "subPixelInterpolationOffsetBits" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, subPixelInterpolationOffsetBits} type FieldIsArray "subPixelInterpolationOffsetBits" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, subPixelInterpolationOffsetBits} instance {-# OVERLAPPING #-} CanReadField "subPixelInterpolationOffsetBits" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, subPixelInterpolationOffsetBits}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, subPixelInterpolationOffsetBits} instance {-# OVERLAPPING #-} CanWriteField "subPixelInterpolationOffsetBits" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, subPixelInterpolationOffsetBits} instance {-# OVERLAPPING #-} HasField "maxFramebufferWidth" VkPhysicalDeviceLimits where type FieldType "maxFramebufferWidth" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxFramebufferWidth" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxFramebufferWidth" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxFramebufferWidth} type FieldIsArray "maxFramebufferWidth" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxFramebufferWidth} instance {-# OVERLAPPING #-} CanReadField "maxFramebufferWidth" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxFramebufferWidth}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxFramebufferWidth} instance {-# OVERLAPPING #-} CanWriteField "maxFramebufferWidth" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxFramebufferWidth} instance {-# OVERLAPPING #-} HasField "maxFramebufferHeight" VkPhysicalDeviceLimits where type FieldType "maxFramebufferHeight" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxFramebufferHeight" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxFramebufferHeight" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxFramebufferHeight} type FieldIsArray "maxFramebufferHeight" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxFramebufferHeight} instance {-# OVERLAPPING #-} CanReadField "maxFramebufferHeight" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxFramebufferHeight}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxFramebufferHeight} instance {-# OVERLAPPING #-} CanWriteField "maxFramebufferHeight" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxFramebufferHeight} instance {-# OVERLAPPING #-} HasField "maxFramebufferLayers" VkPhysicalDeviceLimits where type FieldType "maxFramebufferLayers" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxFramebufferLayers" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxFramebufferLayers" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxFramebufferLayers} type FieldIsArray "maxFramebufferLayers" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxFramebufferLayers} instance {-# OVERLAPPING #-} CanReadField "maxFramebufferLayers" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxFramebufferLayers}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxFramebufferLayers} instance {-# OVERLAPPING #-} CanWriteField "maxFramebufferLayers" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxFramebufferLayers} instance {-# OVERLAPPING #-} HasField "framebufferColorSampleCounts" VkPhysicalDeviceLimits where type FieldType "framebufferColorSampleCounts" VkPhysicalDeviceLimits = VkSampleCountFlags type FieldOptional "framebufferColorSampleCounts" VkPhysicalDeviceLimits = 'True -- ' closing tick for hsc2hs type FieldOffset "framebufferColorSampleCounts" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, framebufferColorSampleCounts} type FieldIsArray "framebufferColorSampleCounts" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = True {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, framebufferColorSampleCounts} instance {-# OVERLAPPING #-} CanReadField "framebufferColorSampleCounts" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, framebufferColorSampleCounts}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, framebufferColorSampleCounts} instance {-# OVERLAPPING #-} CanWriteField "framebufferColorSampleCounts" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, framebufferColorSampleCounts} instance {-# OVERLAPPING #-} HasField "framebufferDepthSampleCounts" VkPhysicalDeviceLimits where type FieldType "framebufferDepthSampleCounts" VkPhysicalDeviceLimits = VkSampleCountFlags type FieldOptional "framebufferDepthSampleCounts" VkPhysicalDeviceLimits = 'True -- ' closing tick for hsc2hs type FieldOffset "framebufferDepthSampleCounts" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, framebufferDepthSampleCounts} type FieldIsArray "framebufferDepthSampleCounts" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = True {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, framebufferDepthSampleCounts} instance {-# OVERLAPPING #-} CanReadField "framebufferDepthSampleCounts" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, framebufferDepthSampleCounts}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, framebufferDepthSampleCounts} instance {-# OVERLAPPING #-} CanWriteField "framebufferDepthSampleCounts" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, framebufferDepthSampleCounts} instance {-# OVERLAPPING #-} HasField "framebufferStencilSampleCounts" VkPhysicalDeviceLimits where type FieldType "framebufferStencilSampleCounts" VkPhysicalDeviceLimits = VkSampleCountFlags type FieldOptional "framebufferStencilSampleCounts" VkPhysicalDeviceLimits = 'True -- ' closing tick for hsc2hs type FieldOffset "framebufferStencilSampleCounts" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, framebufferStencilSampleCounts} type FieldIsArray "framebufferStencilSampleCounts" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = True {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, framebufferStencilSampleCounts} instance {-# OVERLAPPING #-} CanReadField "framebufferStencilSampleCounts" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, framebufferStencilSampleCounts}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, framebufferStencilSampleCounts} instance {-# OVERLAPPING #-} CanWriteField "framebufferStencilSampleCounts" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, framebufferStencilSampleCounts} instance {-# OVERLAPPING #-} HasField "framebufferNoAttachmentsSampleCounts" VkPhysicalDeviceLimits where type FieldType "framebufferNoAttachmentsSampleCounts" VkPhysicalDeviceLimits = VkSampleCountFlags type FieldOptional "framebufferNoAttachmentsSampleCounts" VkPhysicalDeviceLimits = 'True -- ' closing tick for hsc2hs type FieldOffset "framebufferNoAttachmentsSampleCounts" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, framebufferNoAttachmentsSampleCounts} type FieldIsArray "framebufferNoAttachmentsSampleCounts" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = True {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, framebufferNoAttachmentsSampleCounts} instance {-# OVERLAPPING #-} CanReadField "framebufferNoAttachmentsSampleCounts" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, framebufferNoAttachmentsSampleCounts}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, framebufferNoAttachmentsSampleCounts} instance {-# OVERLAPPING #-} CanWriteField "framebufferNoAttachmentsSampleCounts" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, framebufferNoAttachmentsSampleCounts} instance {-# OVERLAPPING #-} HasField "maxColorAttachments" VkPhysicalDeviceLimits where type FieldType "maxColorAttachments" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxColorAttachments" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxColorAttachments" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxColorAttachments} type FieldIsArray "maxColorAttachments" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxColorAttachments} instance {-# OVERLAPPING #-} CanReadField "maxColorAttachments" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxColorAttachments}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxColorAttachments} instance {-# OVERLAPPING #-} CanWriteField "maxColorAttachments" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxColorAttachments} instance {-# OVERLAPPING #-} HasField "sampledImageColorSampleCounts" VkPhysicalDeviceLimits where type FieldType "sampledImageColorSampleCounts" VkPhysicalDeviceLimits = VkSampleCountFlags type FieldOptional "sampledImageColorSampleCounts" VkPhysicalDeviceLimits = 'True -- ' closing tick for hsc2hs type FieldOffset "sampledImageColorSampleCounts" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, sampledImageColorSampleCounts} type FieldIsArray "sampledImageColorSampleCounts" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = True {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, sampledImageColorSampleCounts} instance {-# OVERLAPPING #-} CanReadField "sampledImageColorSampleCounts" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, sampledImageColorSampleCounts}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, sampledImageColorSampleCounts} instance {-# OVERLAPPING #-} CanWriteField "sampledImageColorSampleCounts" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, sampledImageColorSampleCounts} instance {-# OVERLAPPING #-} HasField "sampledImageIntegerSampleCounts" VkPhysicalDeviceLimits where type FieldType "sampledImageIntegerSampleCounts" VkPhysicalDeviceLimits = VkSampleCountFlags type FieldOptional "sampledImageIntegerSampleCounts" VkPhysicalDeviceLimits = 'True -- ' closing tick for hsc2hs type FieldOffset "sampledImageIntegerSampleCounts" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, sampledImageIntegerSampleCounts} type FieldIsArray "sampledImageIntegerSampleCounts" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = True {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, sampledImageIntegerSampleCounts} instance {-# OVERLAPPING #-} CanReadField "sampledImageIntegerSampleCounts" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, sampledImageIntegerSampleCounts}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, sampledImageIntegerSampleCounts} instance {-# OVERLAPPING #-} CanWriteField "sampledImageIntegerSampleCounts" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, sampledImageIntegerSampleCounts} instance {-# OVERLAPPING #-} HasField "sampledImageDepthSampleCounts" VkPhysicalDeviceLimits where type FieldType "sampledImageDepthSampleCounts" VkPhysicalDeviceLimits = VkSampleCountFlags type FieldOptional "sampledImageDepthSampleCounts" VkPhysicalDeviceLimits = 'True -- ' closing tick for hsc2hs type FieldOffset "sampledImageDepthSampleCounts" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, sampledImageDepthSampleCounts} type FieldIsArray "sampledImageDepthSampleCounts" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = True {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, sampledImageDepthSampleCounts} instance {-# OVERLAPPING #-} CanReadField "sampledImageDepthSampleCounts" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, sampledImageDepthSampleCounts}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, sampledImageDepthSampleCounts} instance {-# OVERLAPPING #-} CanWriteField "sampledImageDepthSampleCounts" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, sampledImageDepthSampleCounts} instance {-# OVERLAPPING #-} HasField "sampledImageStencilSampleCounts" VkPhysicalDeviceLimits where type FieldType "sampledImageStencilSampleCounts" VkPhysicalDeviceLimits = VkSampleCountFlags type FieldOptional "sampledImageStencilSampleCounts" VkPhysicalDeviceLimits = 'True -- ' closing tick for hsc2hs type FieldOffset "sampledImageStencilSampleCounts" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, sampledImageStencilSampleCounts} type FieldIsArray "sampledImageStencilSampleCounts" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = True {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, sampledImageStencilSampleCounts} instance {-# OVERLAPPING #-} CanReadField "sampledImageStencilSampleCounts" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, sampledImageStencilSampleCounts}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, sampledImageStencilSampleCounts} instance {-# OVERLAPPING #-} CanWriteField "sampledImageStencilSampleCounts" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, sampledImageStencilSampleCounts} instance {-# OVERLAPPING #-} HasField "storageImageSampleCounts" VkPhysicalDeviceLimits where type FieldType "storageImageSampleCounts" VkPhysicalDeviceLimits = VkSampleCountFlags type FieldOptional "storageImageSampleCounts" VkPhysicalDeviceLimits = 'True -- ' closing tick for hsc2hs type FieldOffset "storageImageSampleCounts" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, storageImageSampleCounts} type FieldIsArray "storageImageSampleCounts" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = True {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, storageImageSampleCounts} instance {-# OVERLAPPING #-} CanReadField "storageImageSampleCounts" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, storageImageSampleCounts}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, storageImageSampleCounts} instance {-# OVERLAPPING #-} CanWriteField "storageImageSampleCounts" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, storageImageSampleCounts} instance {-# OVERLAPPING #-} HasField "maxSampleMaskWords" VkPhysicalDeviceLimits where type FieldType "maxSampleMaskWords" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxSampleMaskWords" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxSampleMaskWords" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxSampleMaskWords} type FieldIsArray "maxSampleMaskWords" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxSampleMaskWords} instance {-# OVERLAPPING #-} CanReadField "maxSampleMaskWords" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxSampleMaskWords}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxSampleMaskWords} instance {-# OVERLAPPING #-} CanWriteField "maxSampleMaskWords" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxSampleMaskWords} instance {-# OVERLAPPING #-} HasField "timestampComputeAndGraphics" VkPhysicalDeviceLimits where type FieldType "timestampComputeAndGraphics" VkPhysicalDeviceLimits = VkBool32 type FieldOptional "timestampComputeAndGraphics" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "timestampComputeAndGraphics" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, timestampComputeAndGraphics} type FieldIsArray "timestampComputeAndGraphics" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, timestampComputeAndGraphics} instance {-# OVERLAPPING #-} CanReadField "timestampComputeAndGraphics" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, timestampComputeAndGraphics}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, timestampComputeAndGraphics} instance {-# OVERLAPPING #-} CanWriteField "timestampComputeAndGraphics" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, timestampComputeAndGraphics} instance {-# OVERLAPPING #-} HasField "timestampPeriod" VkPhysicalDeviceLimits where type FieldType "timestampPeriod" VkPhysicalDeviceLimits = #{type float} type FieldOptional "timestampPeriod" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "timestampPeriod" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, timestampPeriod} type FieldIsArray "timestampPeriod" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, timestampPeriod} instance {-# OVERLAPPING #-} CanReadField "timestampPeriod" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, timestampPeriod}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, timestampPeriod} instance {-# OVERLAPPING #-} CanWriteField "timestampPeriod" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, timestampPeriod} instance {-# OVERLAPPING #-} HasField "maxClipDistances" VkPhysicalDeviceLimits where type FieldType "maxClipDistances" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxClipDistances" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxClipDistances" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxClipDistances} type FieldIsArray "maxClipDistances" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxClipDistances} instance {-# OVERLAPPING #-} CanReadField "maxClipDistances" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxClipDistances}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxClipDistances} instance {-# OVERLAPPING #-} CanWriteField "maxClipDistances" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxClipDistances} instance {-# OVERLAPPING #-} HasField "maxCullDistances" VkPhysicalDeviceLimits where type FieldType "maxCullDistances" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxCullDistances" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxCullDistances" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxCullDistances} type FieldIsArray "maxCullDistances" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxCullDistances} instance {-# OVERLAPPING #-} CanReadField "maxCullDistances" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxCullDistances}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxCullDistances} instance {-# OVERLAPPING #-} CanWriteField "maxCullDistances" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxCullDistances} instance {-# OVERLAPPING #-} HasField "maxCombinedClipAndCullDistances" VkPhysicalDeviceLimits where type FieldType "maxCombinedClipAndCullDistances" VkPhysicalDeviceLimits = Word32 type FieldOptional "maxCombinedClipAndCullDistances" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "maxCombinedClipAndCullDistances" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, maxCombinedClipAndCullDistances} type FieldIsArray "maxCombinedClipAndCullDistances" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, maxCombinedClipAndCullDistances} instance {-# OVERLAPPING #-} CanReadField "maxCombinedClipAndCullDistances" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, maxCombinedClipAndCullDistances}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, maxCombinedClipAndCullDistances} instance {-# OVERLAPPING #-} CanWriteField "maxCombinedClipAndCullDistances" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, maxCombinedClipAndCullDistances} instance {-# OVERLAPPING #-} HasField "discreteQueuePriorities" VkPhysicalDeviceLimits where type FieldType "discreteQueuePriorities" VkPhysicalDeviceLimits = Word32 type FieldOptional "discreteQueuePriorities" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "discreteQueuePriorities" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, discreteQueuePriorities} type FieldIsArray "discreteQueuePriorities" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, discreteQueuePriorities} instance {-# OVERLAPPING #-} CanReadField "discreteQueuePriorities" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, discreteQueuePriorities}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, discreteQueuePriorities} instance {-# OVERLAPPING #-} CanWriteField "discreteQueuePriorities" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, discreteQueuePriorities} instance {-# OVERLAPPING #-} HasField "pointSizeRange" VkPhysicalDeviceLimits where type FieldType "pointSizeRange" VkPhysicalDeviceLimits = #{type float} type FieldOptional "pointSizeRange" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "pointSizeRange" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, pointSizeRange} type FieldIsArray "pointSizeRange" VkPhysicalDeviceLimits = 'True -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, pointSizeRange} instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "pointSizeRange" idx VkPhysicalDeviceLimits) => CanReadFieldArray "pointSizeRange" idx VkPhysicalDeviceLimits where {-# SPECIALISE instance CanReadFieldArray "pointSizeRange" 0 VkPhysicalDeviceLimits #-} {-# SPECIALISE instance CanReadFieldArray "pointSizeRange" 1 VkPhysicalDeviceLimits #-} type FieldArrayLength "pointSizeRange" VkPhysicalDeviceLimits = 2 {-# INLINE fieldArrayLength #-} fieldArrayLength = 2 {-# INLINE getFieldArray #-} getFieldArray = f where {-# NOINLINE f #-} f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off) off = #{offset VkPhysicalDeviceLimits, pointSizeRange} + sizeOf (undefined :: #{type float}) * fromInteger (natVal' (proxy## :: Proxy## idx)) -- ' closing tick for hsc2hs {-# INLINE readFieldArray #-} readFieldArray p = peekByteOff p (#{offset VkPhysicalDeviceLimits, pointSizeRange} + sizeOf (undefined :: #{type float}) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "pointSizeRange" idx VkPhysicalDeviceLimits) => CanWriteFieldArray "pointSizeRange" idx VkPhysicalDeviceLimits where {-# SPECIALISE instance CanWriteFieldArray "pointSizeRange" 0 VkPhysicalDeviceLimits #-} {-# SPECIALISE instance CanWriteFieldArray "pointSizeRange" 1 VkPhysicalDeviceLimits #-} {-# INLINE writeFieldArray #-} writeFieldArray p = pokeByteOff p (#{offset VkPhysicalDeviceLimits, pointSizeRange} + sizeOf (undefined :: #{type float}) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "lineWidthRange" VkPhysicalDeviceLimits where type FieldType "lineWidthRange" VkPhysicalDeviceLimits = #{type float} type FieldOptional "lineWidthRange" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "lineWidthRange" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, lineWidthRange} type FieldIsArray "lineWidthRange" VkPhysicalDeviceLimits = 'True -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, lineWidthRange} instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "lineWidthRange" idx VkPhysicalDeviceLimits) => CanReadFieldArray "lineWidthRange" idx VkPhysicalDeviceLimits where {-# SPECIALISE instance CanReadFieldArray "lineWidthRange" 0 VkPhysicalDeviceLimits #-} {-# SPECIALISE instance CanReadFieldArray "lineWidthRange" 1 VkPhysicalDeviceLimits #-} type FieldArrayLength "lineWidthRange" VkPhysicalDeviceLimits = 2 {-# INLINE fieldArrayLength #-} fieldArrayLength = 2 {-# INLINE getFieldArray #-} getFieldArray = f where {-# NOINLINE f #-} f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off) off = #{offset VkPhysicalDeviceLimits, lineWidthRange} + sizeOf (undefined :: #{type float}) * fromInteger (natVal' (proxy## :: Proxy## idx)) -- ' closing tick for hsc2hs {-# INLINE readFieldArray #-} readFieldArray p = peekByteOff p (#{offset VkPhysicalDeviceLimits, lineWidthRange} + sizeOf (undefined :: #{type float}) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "lineWidthRange" idx VkPhysicalDeviceLimits) => CanWriteFieldArray "lineWidthRange" idx VkPhysicalDeviceLimits where {-# SPECIALISE instance CanWriteFieldArray "lineWidthRange" 0 VkPhysicalDeviceLimits #-} {-# SPECIALISE instance CanWriteFieldArray "lineWidthRange" 1 VkPhysicalDeviceLimits #-} {-# INLINE writeFieldArray #-} writeFieldArray p = pokeByteOff p (#{offset VkPhysicalDeviceLimits, lineWidthRange} + sizeOf (undefined :: #{type float}) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "pointSizeGranularity" VkPhysicalDeviceLimits where type FieldType "pointSizeGranularity" VkPhysicalDeviceLimits = #{type float} type FieldOptional "pointSizeGranularity" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "pointSizeGranularity" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, pointSizeGranularity} type FieldIsArray "pointSizeGranularity" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, pointSizeGranularity} instance {-# OVERLAPPING #-} CanReadField "pointSizeGranularity" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, pointSizeGranularity}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, pointSizeGranularity} instance {-# OVERLAPPING #-} CanWriteField "pointSizeGranularity" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, pointSizeGranularity} instance {-# OVERLAPPING #-} HasField "lineWidthGranularity" VkPhysicalDeviceLimits where type FieldType "lineWidthGranularity" VkPhysicalDeviceLimits = #{type float} type FieldOptional "lineWidthGranularity" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "lineWidthGranularity" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, lineWidthGranularity} type FieldIsArray "lineWidthGranularity" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, lineWidthGranularity} instance {-# OVERLAPPING #-} CanReadField "lineWidthGranularity" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, lineWidthGranularity}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, lineWidthGranularity} instance {-# OVERLAPPING #-} CanWriteField "lineWidthGranularity" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, lineWidthGranularity} instance {-# OVERLAPPING #-} HasField "strictLines" VkPhysicalDeviceLimits where type FieldType "strictLines" VkPhysicalDeviceLimits = VkBool32 type FieldOptional "strictLines" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "strictLines" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, strictLines} type FieldIsArray "strictLines" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, strictLines} instance {-# OVERLAPPING #-} CanReadField "strictLines" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, strictLines}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, strictLines} instance {-# OVERLAPPING #-} CanWriteField "strictLines" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, strictLines} instance {-# OVERLAPPING #-} HasField "standardSampleLocations" VkPhysicalDeviceLimits where type FieldType "standardSampleLocations" VkPhysicalDeviceLimits = VkBool32 type FieldOptional "standardSampleLocations" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "standardSampleLocations" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, standardSampleLocations} type FieldIsArray "standardSampleLocations" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, standardSampleLocations} instance {-# OVERLAPPING #-} CanReadField "standardSampleLocations" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, standardSampleLocations}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, standardSampleLocations} instance {-# OVERLAPPING #-} CanWriteField "standardSampleLocations" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, standardSampleLocations} instance {-# OVERLAPPING #-} HasField "optimalBufferCopyOffsetAlignment" VkPhysicalDeviceLimits where type FieldType "optimalBufferCopyOffsetAlignment" VkPhysicalDeviceLimits = VkDeviceSize type FieldOptional "optimalBufferCopyOffsetAlignment" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "optimalBufferCopyOffsetAlignment" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, optimalBufferCopyOffsetAlignment} type FieldIsArray "optimalBufferCopyOffsetAlignment" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, optimalBufferCopyOffsetAlignment} instance {-# OVERLAPPING #-} CanReadField "optimalBufferCopyOffsetAlignment" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, optimalBufferCopyOffsetAlignment}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, optimalBufferCopyOffsetAlignment} instance {-# OVERLAPPING #-} CanWriteField "optimalBufferCopyOffsetAlignment" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, optimalBufferCopyOffsetAlignment} instance {-# OVERLAPPING #-} HasField "optimalBufferCopyRowPitchAlignment" VkPhysicalDeviceLimits where type FieldType "optimalBufferCopyRowPitchAlignment" VkPhysicalDeviceLimits = VkDeviceSize type FieldOptional "optimalBufferCopyRowPitchAlignment" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "optimalBufferCopyRowPitchAlignment" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, optimalBufferCopyRowPitchAlignment} type FieldIsArray "optimalBufferCopyRowPitchAlignment" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, optimalBufferCopyRowPitchAlignment} instance {-# OVERLAPPING #-} CanReadField "optimalBufferCopyRowPitchAlignment" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, optimalBufferCopyRowPitchAlignment}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, optimalBufferCopyRowPitchAlignment} instance {-# OVERLAPPING #-} CanWriteField "optimalBufferCopyRowPitchAlignment" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, optimalBufferCopyRowPitchAlignment} instance {-# OVERLAPPING #-} HasField "nonCoherentAtomSize" VkPhysicalDeviceLimits where type FieldType "nonCoherentAtomSize" VkPhysicalDeviceLimits = VkDeviceSize type FieldOptional "nonCoherentAtomSize" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs type FieldOffset "nonCoherentAtomSize" VkPhysicalDeviceLimits = #{offset VkPhysicalDeviceLimits, nonCoherentAtomSize} type FieldIsArray "nonCoherentAtomSize" VkPhysicalDeviceLimits = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceLimits, nonCoherentAtomSize} instance {-# OVERLAPPING #-} CanReadField "nonCoherentAtomSize" VkPhysicalDeviceLimits where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceLimits, nonCoherentAtomSize}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceLimits, nonCoherentAtomSize} instance {-# OVERLAPPING #-} CanWriteField "nonCoherentAtomSize" VkPhysicalDeviceLimits where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceLimits, nonCoherentAtomSize} instance Show VkPhysicalDeviceLimits where showsPrec d x = showString "VkPhysicalDeviceLimits {" . showString "maxImageDimension1D = " . showsPrec d (getField @"maxImageDimension1D" x) . showString ", " . showString "maxImageDimension2D = " . showsPrec d (getField @"maxImageDimension2D" x) . showString ", " . showString "maxImageDimension3D = " . showsPrec d (getField @"maxImageDimension3D" x) . showString ", " . showString "maxImageDimensionCube = " . showsPrec d (getField @"maxImageDimensionCube" x) . showString ", " . showString "maxImageArrayLayers = " . showsPrec d (getField @"maxImageArrayLayers" x) . showString ", " . showString "maxTexelBufferElements = " . showsPrec d (getField @"maxTexelBufferElements" x) . showString ", " . showString "maxUniformBufferRange = " . showsPrec d (getField @"maxUniformBufferRange" x) . showString ", " . showString "maxStorageBufferRange = " . showsPrec d (getField @"maxStorageBufferRange" x) . showString ", " . showString "maxPushConstantsSize = " . showsPrec d (getField @"maxPushConstantsSize" x) . showString ", " . showString "maxMemoryAllocationCount = " . showsPrec d (getField @"maxMemoryAllocationCount" x) . showString ", " . showString "maxSamplerAllocationCount = " . showsPrec d (getField @"maxSamplerAllocationCount" x) . showString ", " . showString "bufferImageGranularity = " . showsPrec d (getField @"bufferImageGranularity" x) . showString ", " . showString "sparseAddressSpaceSize = " . showsPrec d (getField @"sparseAddressSpaceSize" x) . showString ", " . showString "maxBoundDescriptorSets = " . showsPrec d (getField @"maxBoundDescriptorSets" x) . showString ", " . showString "maxPerStageDescriptorSamplers = " . showsPrec d (getField @"maxPerStageDescriptorSamplers" x) . showString ", " . showString "maxPerStageDescriptorUniformBuffers = " . showsPrec d (getField @"maxPerStageDescriptorUniformBuffers" x) . showString ", " . showString "maxPerStageDescriptorStorageBuffers = " . showsPrec d (getField @"maxPerStageDescriptorStorageBuffers" x) . showString ", " . showString "maxPerStageDescriptorSampledImages = " . showsPrec d (getField @"maxPerStageDescriptorSampledImages" x) . showString ", " . showString "maxPerStageDescriptorStorageImages = " . showsPrec d (getField @"maxPerStageDescriptorStorageImages" x) . showString ", " . showString "maxPerStageDescriptorInputAttachments = " . showsPrec d (getField @"maxPerStageDescriptorInputAttachments" x) . showString ", " . showString "maxPerStageResources = " . showsPrec d (getField @"maxPerStageResources" x) . showString ", " . showString "maxDescriptorSetSamplers = " . showsPrec d (getField @"maxDescriptorSetSamplers" x) . showString ", " . showString "maxDescriptorSetUniformBuffers = " . showsPrec d (getField @"maxDescriptorSetUniformBuffers" x) . showString ", " . showString "maxDescriptorSetUniformBuffersDynamic = " . showsPrec d (getField @"maxDescriptorSetUniformBuffersDynamic" x) . showString ", " . showString "maxDescriptorSetStorageBuffers = " . showsPrec d (getField @"maxDescriptorSetStorageBuffers" x) . showString ", " . showString "maxDescriptorSetStorageBuffersDynamic = " . showsPrec d (getField @"maxDescriptorSetStorageBuffersDynamic" x) . showString ", " . showString "maxDescriptorSetSampledImages = " . showsPrec d (getField @"maxDescriptorSetSampledImages" x) . showString ", " . showString "maxDescriptorSetStorageImages = " . showsPrec d (getField @"maxDescriptorSetStorageImages" x) . showString ", " . showString "maxDescriptorSetInputAttachments = " . showsPrec d (getField @"maxDescriptorSetInputAttachments" x) . showString ", " . showString "maxVertexInputAttributes = " . showsPrec d (getField @"maxVertexInputAttributes" x) . showString ", " . showString "maxVertexInputBindings = " . showsPrec d (getField @"maxVertexInputBindings" x) . showString ", " . showString "maxVertexInputAttributeOffset = " . showsPrec d (getField @"maxVertexInputAttributeOffset" x) . showString ", " . showString "maxVertexInputBindingStride = " . showsPrec d (getField @"maxVertexInputBindingStride" x) . showString ", " . showString "maxVertexOutputComponents = " . showsPrec d (getField @"maxVertexOutputComponents" x) . showString ", " . showString "maxTessellationGenerationLevel = " . showsPrec d (getField @"maxTessellationGenerationLevel" x) . showString ", " . showString "maxTessellationPatchSize = " . showsPrec d (getField @"maxTessellationPatchSize" x) . showString ", " . showString "maxTessellationControlPerVertexInputComponents = " . showsPrec d (getField @"maxTessellationControlPerVertexInputComponents" x) . showString ", " . showString "maxTessellationControlPerVertexOutputComponents = " . showsPrec d (getField @"maxTessellationControlPerVertexOutputComponents" x) . showString ", " . showString "maxTessellationControlPerPatchOutputComponents = " . showsPrec d (getField @"maxTessellationControlPerPatchOutputComponents" x) . showString ", " . showString "maxTessellationControlTotalOutputComponents = " . showsPrec d (getField @"maxTessellationControlTotalOutputComponents" x) . showString ", " . showString "maxTessellationEvaluationInputComponents = " . showsPrec d (getField @"maxTessellationEvaluationInputComponents" x) . showString ", " . showString "maxTessellationEvaluationOutputComponents = " . showsPrec d (getField @"maxTessellationEvaluationOutputComponents" x) . showString ", " . showString "maxGeometryShaderInvocations = " . showsPrec d (getField @"maxGeometryShaderInvocations" x) . showString ", " . showString "maxGeometryInputComponents = " . showsPrec d (getField @"maxGeometryInputComponents" x) . showString ", " . showString "maxGeometryOutputComponents = " . showsPrec d (getField @"maxGeometryOutputComponents" x) . showString ", " . showString "maxGeometryOutputVertices = " . showsPrec d (getField @"maxGeometryOutputVertices" x) . showString ", " . showString "maxGeometryTotalOutputComponents = " . showsPrec d (getField @"maxGeometryTotalOutputComponents" x) . showString ", " . showString "maxFragmentInputComponents = " . showsPrec d (getField @"maxFragmentInputComponents" x) . showString ", " . showString "maxFragmentOutputAttachments = " . showsPrec d (getField @"maxFragmentOutputAttachments" x) . showString ", " . showString "maxFragmentDualSrcAttachments = " . showsPrec d (getField @"maxFragmentDualSrcAttachments" x) . showString ", " . showString "maxFragmentCombinedOutputResources = " . showsPrec d (getField @"maxFragmentCombinedOutputResources" x) . showString ", " . showString "maxComputeSharedMemorySize = " . showsPrec d (getField @"maxComputeSharedMemorySize" x) . showString ", " . (showString "maxComputeWorkGroupCount = [" . showsPrec d (let s = sizeOf (undefined :: FieldType "maxComputeWorkGroupCount" VkPhysicalDeviceLimits) o = fieldOffset @"maxComputeWorkGroupCount" @VkPhysicalDeviceLimits f i = peekByteOff (unsafePtr x) i :: IO (FieldType "maxComputeWorkGroupCount" VkPhysicalDeviceLimits) in unsafeDupablePerformIO . mapM f $ map (\ i -> o + i * s) [0 .. 3 - 1]) . showChar ']') . showString ", " . showString "maxComputeWorkGroupInvocations = " . showsPrec d (getField @"maxComputeWorkGroupInvocations" x) . showString ", " . (showString "maxComputeWorkGroupSize = [" . showsPrec d (let s = sizeOf (undefined :: FieldType "maxComputeWorkGroupSize" VkPhysicalDeviceLimits) o = fieldOffset @"maxComputeWorkGroupSize" @VkPhysicalDeviceLimits f i = peekByteOff (unsafePtr x) i :: IO (FieldType "maxComputeWorkGroupSize" VkPhysicalDeviceLimits) in unsafeDupablePerformIO . mapM f $ map (\ i -> o + i * s) [0 .. 3 - 1]) . showChar ']') . showString ", " . showString "subPixelPrecisionBits = " . showsPrec d (getField @"subPixelPrecisionBits" x) . showString ", " . showString "subTexelPrecisionBits = " . showsPrec d (getField @"subTexelPrecisionBits" x) . showString ", " . showString "mipmapPrecisionBits = " . showsPrec d (getField @"mipmapPrecisionBits" x) . showString ", " . showString "maxDrawIndexedIndexValue = " . showsPrec d (getField @"maxDrawIndexedIndexValue" x) . showString ", " . showString "maxDrawIndirectCount = " . showsPrec d (getField @"maxDrawIndirectCount" x) . showString ", " . showString "maxSamplerLodBias = " . showsPrec d (getField @"maxSamplerLodBias" x) . showString ", " . showString "maxSamplerAnisotropy = " . showsPrec d (getField @"maxSamplerAnisotropy" x) . showString ", " . showString "maxViewports = " . showsPrec d (getField @"maxViewports" x) . showString ", " . (showString "maxViewportDimensions = [" . showsPrec d (let s = sizeOf (undefined :: FieldType "maxViewportDimensions" VkPhysicalDeviceLimits) o = fieldOffset @"maxViewportDimensions" @VkPhysicalDeviceLimits f i = peekByteOff (unsafePtr x) i :: IO (FieldType "maxViewportDimensions" VkPhysicalDeviceLimits) in unsafeDupablePerformIO . mapM f $ map (\ i -> o + i * s) [0 .. 2 - 1]) . showChar ']') . showString ", " . (showString "viewportBoundsRange = [" . showsPrec d (let s = sizeOf (undefined :: FieldType "viewportBoundsRange" VkPhysicalDeviceLimits) o = fieldOffset @"viewportBoundsRange" @VkPhysicalDeviceLimits f i = peekByteOff (unsafePtr x) i :: IO (FieldType "viewportBoundsRange" VkPhysicalDeviceLimits) in unsafeDupablePerformIO . mapM f $ map (\ i -> o + i * s) [0 .. 2 - 1]) . showChar ']') . showString ", " . showString "viewportSubPixelBits = " . showsPrec d (getField @"viewportSubPixelBits" x) . showString ", " . showString "minMemoryMapAlignment = " . showsPrec d (getField @"minMemoryMapAlignment" x) . showString ", " . showString "minTexelBufferOffsetAlignment = " . showsPrec d (getField @"minTexelBufferOffsetAlignment" x) . showString ", " . showString "minUniformBufferOffsetAlignment = " . showsPrec d (getField @"minUniformBufferOffsetAlignment" x) . showString ", " . showString "minStorageBufferOffsetAlignment = " . showsPrec d (getField @"minStorageBufferOffsetAlignment" x) . showString ", " . showString "minTexelOffset = " . showsPrec d (getField @"minTexelOffset" x) . showString ", " . showString "maxTexelOffset = " . showsPrec d (getField @"maxTexelOffset" x) . showString ", " . showString "minTexelGatherOffset = " . showsPrec d (getField @"minTexelGatherOffset" x) . showString ", " . showString "maxTexelGatherOffset = " . showsPrec d (getField @"maxTexelGatherOffset" x) . showString ", " . showString "minInterpolationOffset = " . showsPrec d (getField @"minInterpolationOffset" x) . showString ", " . showString "maxInterpolationOffset = " . showsPrec d (getField @"maxInterpolationOffset" x) . showString ", " . showString "subPixelInterpolationOffsetBits = " . showsPrec d (getField @"subPixelInterpolationOffsetBits" x) . showString ", " . showString "maxFramebufferWidth = " . showsPrec d (getField @"maxFramebufferWidth" x) . showString ", " . showString "maxFramebufferHeight = " . showsPrec d (getField @"maxFramebufferHeight" x) . showString ", " . showString "maxFramebufferLayers = " . showsPrec d (getField @"maxFramebufferLayers" x) . showString ", " . showString "framebufferColorSampleCounts = " . showsPrec d (getField @"framebufferColorSampleCounts" x) . showString ", " . showString "framebufferDepthSampleCounts = " . showsPrec d (getField @"framebufferDepthSampleCounts" x) . showString ", " . showString "framebufferStencilSampleCounts = " . showsPrec d (getField @"framebufferStencilSampleCounts" x) . showString ", " . showString "framebufferNoAttachmentsSampleCounts = " . showsPrec d (getField @"framebufferNoAttachmentsSampleCounts" x) . showString ", " . showString "maxColorAttachments = " . showsPrec d (getField @"maxColorAttachments" x) . showString ", " . showString "sampledImageColorSampleCounts = " . showsPrec d (getField @"sampledImageColorSampleCounts" x) . showString ", " . showString "sampledImageIntegerSampleCounts = " . showsPrec d (getField @"sampledImageIntegerSampleCounts" x) . showString ", " . showString "sampledImageDepthSampleCounts = " . showsPrec d (getField @"sampledImageDepthSampleCounts" x) . showString ", " . showString "sampledImageStencilSampleCounts = " . showsPrec d (getField @"sampledImageStencilSampleCounts" x) . showString ", " . showString "storageImageSampleCounts = " . showsPrec d (getField @"storageImageSampleCounts" x) . showString ", " . showString "maxSampleMaskWords = " . showsPrec d (getField @"maxSampleMaskWords" x) . showString ", " . showString "timestampComputeAndGraphics = " . showsPrec d (getField @"timestampComputeAndGraphics" x) . showString ", " . showString "timestampPeriod = " . showsPrec d (getField @"timestampPeriod" x) . showString ", " . showString "maxClipDistances = " . showsPrec d (getField @"maxClipDistances" x) . showString ", " . showString "maxCullDistances = " . showsPrec d (getField @"maxCullDistances" x) . showString ", " . showString "maxCombinedClipAndCullDistances = " . showsPrec d (getField @"maxCombinedClipAndCullDistances" x) . showString ", " . showString "discreteQueuePriorities = " . showsPrec d (getField @"discreteQueuePriorities" x) . showString ", " . (showString "pointSizeRange = [" . showsPrec d (let s = sizeOf (undefined :: FieldType "pointSizeRange" VkPhysicalDeviceLimits) o = fieldOffset @"pointSizeRange" @VkPhysicalDeviceLimits f i = peekByteOff (unsafePtr x) i :: IO (FieldType "pointSizeRange" VkPhysicalDeviceLimits) in unsafeDupablePerformIO . mapM f $ map (\ i -> o + i * s) [0 .. 2 - 1]) . showChar ']') . showString ", " . (showString "lineWidthRange = [" . showsPrec d (let s = sizeOf (undefined :: FieldType "lineWidthRange" VkPhysicalDeviceLimits) o = fieldOffset @"lineWidthRange" @VkPhysicalDeviceLimits f i = peekByteOff (unsafePtr x) i :: IO (FieldType "lineWidthRange" VkPhysicalDeviceLimits) in unsafeDupablePerformIO . mapM f $ map (\ i -> o + i * s) [0 .. 2 - 1]) . showChar ']') . showString ", " . showString "pointSizeGranularity = " . showsPrec d (getField @"pointSizeGranularity" x) . showString ", " . showString "lineWidthGranularity = " . showsPrec d (getField @"lineWidthGranularity" x) . showString ", " . showString "strictLines = " . showsPrec d (getField @"strictLines" x) . showString ", " . showString "standardSampleLocations = " . showsPrec d (getField @"standardSampleLocations" x) . showString ", " . showString "optimalBufferCopyOffsetAlignment = " . showsPrec d (getField @"optimalBufferCopyOffsetAlignment" x) . showString ", " . showString "optimalBufferCopyRowPitchAlignment = " . showsPrec d (getField @"optimalBufferCopyRowPitchAlignment" x) . showString ", " . showString "nonCoherentAtomSize = " . showsPrec d (getField @"nonCoherentAtomSize" x) . showChar '}' -- | > typedef struct VkPhysicalDeviceMaintenance3Properties { -- > VkStructureType sType; -- > void* pNext; -- > uint32_t maxPerSetDescriptors; -- > VkDeviceSize maxMemoryAllocationSize; -- > } VkPhysicalDeviceMaintenance3Properties; -- -- data VkPhysicalDeviceMaintenance3Properties = VkPhysicalDeviceMaintenance3Properties## Addr## ByteArray## instance Eq VkPhysicalDeviceMaintenance3Properties where (VkPhysicalDeviceMaintenance3Properties## a _) == x@(VkPhysicalDeviceMaintenance3Properties## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceMaintenance3Properties where (VkPhysicalDeviceMaintenance3Properties## a _) `compare` x@(VkPhysicalDeviceMaintenance3Properties## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceMaintenance3Properties where sizeOf ~_ = #{size VkPhysicalDeviceMaintenance3Properties} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceMaintenance3Properties} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceMaintenance3Properties where unsafeAddr (VkPhysicalDeviceMaintenance3Properties## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceMaintenance3Properties## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceMaintenance3Properties## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceMaintenance3Properties where type StructFields VkPhysicalDeviceMaintenance3Properties = '["sType", "pNext", "maxPerSetDescriptors", -- ' closing tick for hsc2hs "maxMemoryAllocationSize"] type CUnionType VkPhysicalDeviceMaintenance3Properties = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceMaintenance3Properties = 'True -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceMaintenance3Properties = '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceMaintenance3Properties where type FieldType "sType" VkPhysicalDeviceMaintenance3Properties = VkStructureType type FieldOptional "sType" VkPhysicalDeviceMaintenance3Properties = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceMaintenance3Properties = #{offset VkPhysicalDeviceMaintenance3Properties, sType} type FieldIsArray "sType" VkPhysicalDeviceMaintenance3Properties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceMaintenance3Properties, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceMaintenance3Properties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceMaintenance3Properties, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceMaintenance3Properties, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceMaintenance3Properties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceMaintenance3Properties, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceMaintenance3Properties where type FieldType "pNext" VkPhysicalDeviceMaintenance3Properties = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceMaintenance3Properties = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceMaintenance3Properties = #{offset VkPhysicalDeviceMaintenance3Properties, pNext} type FieldIsArray "pNext" VkPhysicalDeviceMaintenance3Properties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceMaintenance3Properties, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceMaintenance3Properties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceMaintenance3Properties, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceMaintenance3Properties, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceMaintenance3Properties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceMaintenance3Properties, pNext} instance {-# OVERLAPPING #-} HasField "maxPerSetDescriptors" VkPhysicalDeviceMaintenance3Properties where type FieldType "maxPerSetDescriptors" VkPhysicalDeviceMaintenance3Properties = Word32 type FieldOptional "maxPerSetDescriptors" VkPhysicalDeviceMaintenance3Properties = 'False -- ' closing tick for hsc2hs type FieldOffset "maxPerSetDescriptors" VkPhysicalDeviceMaintenance3Properties = #{offset VkPhysicalDeviceMaintenance3Properties, maxPerSetDescriptors} type FieldIsArray "maxPerSetDescriptors" VkPhysicalDeviceMaintenance3Properties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceMaintenance3Properties, maxPerSetDescriptors} instance {-# OVERLAPPING #-} CanReadField "maxPerSetDescriptors" VkPhysicalDeviceMaintenance3Properties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceMaintenance3Properties, maxPerSetDescriptors}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceMaintenance3Properties, maxPerSetDescriptors} instance {-# OVERLAPPING #-} CanWriteField "maxPerSetDescriptors" VkPhysicalDeviceMaintenance3Properties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceMaintenance3Properties, maxPerSetDescriptors} instance {-# OVERLAPPING #-} HasField "maxMemoryAllocationSize" VkPhysicalDeviceMaintenance3Properties where type FieldType "maxMemoryAllocationSize" VkPhysicalDeviceMaintenance3Properties = VkDeviceSize type FieldOptional "maxMemoryAllocationSize" VkPhysicalDeviceMaintenance3Properties = 'False -- ' closing tick for hsc2hs type FieldOffset "maxMemoryAllocationSize" VkPhysicalDeviceMaintenance3Properties = #{offset VkPhysicalDeviceMaintenance3Properties, maxMemoryAllocationSize} type FieldIsArray "maxMemoryAllocationSize" VkPhysicalDeviceMaintenance3Properties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceMaintenance3Properties, maxMemoryAllocationSize} instance {-# OVERLAPPING #-} CanReadField "maxMemoryAllocationSize" VkPhysicalDeviceMaintenance3Properties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceMaintenance3Properties, maxMemoryAllocationSize}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceMaintenance3Properties, maxMemoryAllocationSize} instance {-# OVERLAPPING #-} CanWriteField "maxMemoryAllocationSize" VkPhysicalDeviceMaintenance3Properties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceMaintenance3Properties, maxMemoryAllocationSize} instance Show VkPhysicalDeviceMaintenance3Properties where showsPrec d x = showString "VkPhysicalDeviceMaintenance3Properties {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "maxPerSetDescriptors = " . showsPrec d (getField @"maxPerSetDescriptors" x) . showString ", " . showString "maxMemoryAllocationSize = " . showsPrec d (getField @"maxMemoryAllocationSize" x) . showChar '}' -- | Alias for `VkPhysicalDeviceMaintenance3Properties` type VkPhysicalDeviceMaintenance3PropertiesKHR = VkPhysicalDeviceMaintenance3Properties -- | > typedef struct VkPhysicalDeviceMemoryProperties { -- > uint32_t memoryTypeCount; -- > VkMemoryType memoryTypes[VK_MAX_MEMORY_TYPES]; -- > uint32_t memoryHeapCount; -- > VkMemoryHeap memoryHeaps[VK_MAX_MEMORY_HEAPS]; -- > } VkPhysicalDeviceMemoryProperties; -- -- data VkPhysicalDeviceMemoryProperties = VkPhysicalDeviceMemoryProperties## Addr## ByteArray## instance Eq VkPhysicalDeviceMemoryProperties where (VkPhysicalDeviceMemoryProperties## a _) == x@(VkPhysicalDeviceMemoryProperties## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceMemoryProperties where (VkPhysicalDeviceMemoryProperties## a _) `compare` x@(VkPhysicalDeviceMemoryProperties## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceMemoryProperties where sizeOf ~_ = #{size VkPhysicalDeviceMemoryProperties} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceMemoryProperties} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceMemoryProperties where unsafeAddr (VkPhysicalDeviceMemoryProperties## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceMemoryProperties## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceMemoryProperties## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceMemoryProperties where type StructFields VkPhysicalDeviceMemoryProperties = '["memoryTypeCount", "memoryTypes", "memoryHeapCount", -- ' closing tick for hsc2hs "memoryHeaps"] type CUnionType VkPhysicalDeviceMemoryProperties = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceMemoryProperties = 'True -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceMemoryProperties = '[] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "memoryTypeCount" VkPhysicalDeviceMemoryProperties where type FieldType "memoryTypeCount" VkPhysicalDeviceMemoryProperties = Word32 type FieldOptional "memoryTypeCount" VkPhysicalDeviceMemoryProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "memoryTypeCount" VkPhysicalDeviceMemoryProperties = #{offset VkPhysicalDeviceMemoryProperties, memoryTypeCount} type FieldIsArray "memoryTypeCount" VkPhysicalDeviceMemoryProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceMemoryProperties, memoryTypeCount} instance {-# OVERLAPPING #-} CanReadField "memoryTypeCount" VkPhysicalDeviceMemoryProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceMemoryProperties, memoryTypeCount}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceMemoryProperties, memoryTypeCount} instance {-# OVERLAPPING #-} CanWriteField "memoryTypeCount" VkPhysicalDeviceMemoryProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceMemoryProperties, memoryTypeCount} instance {-# OVERLAPPING #-} HasField "memoryTypes" VkPhysicalDeviceMemoryProperties where type FieldType "memoryTypes" VkPhysicalDeviceMemoryProperties = VkMemoryType type FieldOptional "memoryTypes" VkPhysicalDeviceMemoryProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "memoryTypes" VkPhysicalDeviceMemoryProperties = #{offset VkPhysicalDeviceMemoryProperties, memoryTypes} type FieldIsArray "memoryTypes" VkPhysicalDeviceMemoryProperties = 'True -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceMemoryProperties, memoryTypes} instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "memoryTypes" idx VkPhysicalDeviceMemoryProperties) => CanReadFieldArray "memoryTypes" idx VkPhysicalDeviceMemoryProperties where {-# SPECIALISE instance CanReadFieldArray "memoryTypes" 0 VkPhysicalDeviceMemoryProperties #-} {-# SPECIALISE instance CanReadFieldArray "memoryTypes" 1 VkPhysicalDeviceMemoryProperties #-} {-# SPECIALISE instance CanReadFieldArray "memoryTypes" 2 VkPhysicalDeviceMemoryProperties #-} {-# SPECIALISE instance CanReadFieldArray "memoryTypes" 3 VkPhysicalDeviceMemoryProperties #-} type FieldArrayLength "memoryTypes" VkPhysicalDeviceMemoryProperties = VK_MAX_MEMORY_TYPES {-# INLINE fieldArrayLength #-} fieldArrayLength = VK_MAX_MEMORY_TYPES {-# INLINE getFieldArray #-} getFieldArray = f where {-# NOINLINE f #-} f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off) off = #{offset VkPhysicalDeviceMemoryProperties, memoryTypes} + sizeOf (undefined :: VkMemoryType) * fromInteger (natVal' (proxy## :: Proxy## idx)) -- ' closing tick for hsc2hs {-# INLINE readFieldArray #-} readFieldArray p = peekByteOff p (#{offset VkPhysicalDeviceMemoryProperties, memoryTypes} + sizeOf (undefined :: VkMemoryType) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "memoryTypes" idx VkPhysicalDeviceMemoryProperties) => CanWriteFieldArray "memoryTypes" idx VkPhysicalDeviceMemoryProperties where {-# SPECIALISE instance CanWriteFieldArray "memoryTypes" 0 VkPhysicalDeviceMemoryProperties #-} {-# SPECIALISE instance CanWriteFieldArray "memoryTypes" 1 VkPhysicalDeviceMemoryProperties #-} {-# SPECIALISE instance CanWriteFieldArray "memoryTypes" 2 VkPhysicalDeviceMemoryProperties #-} {-# SPECIALISE instance CanWriteFieldArray "memoryTypes" 3 VkPhysicalDeviceMemoryProperties #-} {-# INLINE writeFieldArray #-} writeFieldArray p = pokeByteOff p (#{offset VkPhysicalDeviceMemoryProperties, memoryTypes} + sizeOf (undefined :: VkMemoryType) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "memoryHeapCount" VkPhysicalDeviceMemoryProperties where type FieldType "memoryHeapCount" VkPhysicalDeviceMemoryProperties = Word32 type FieldOptional "memoryHeapCount" VkPhysicalDeviceMemoryProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "memoryHeapCount" VkPhysicalDeviceMemoryProperties = #{offset VkPhysicalDeviceMemoryProperties, memoryHeapCount} type FieldIsArray "memoryHeapCount" VkPhysicalDeviceMemoryProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceMemoryProperties, memoryHeapCount} instance {-# OVERLAPPING #-} CanReadField "memoryHeapCount" VkPhysicalDeviceMemoryProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceMemoryProperties, memoryHeapCount}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceMemoryProperties, memoryHeapCount} instance {-# OVERLAPPING #-} CanWriteField "memoryHeapCount" VkPhysicalDeviceMemoryProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceMemoryProperties, memoryHeapCount} instance {-# OVERLAPPING #-} HasField "memoryHeaps" VkPhysicalDeviceMemoryProperties where type FieldType "memoryHeaps" VkPhysicalDeviceMemoryProperties = VkMemoryHeap type FieldOptional "memoryHeaps" VkPhysicalDeviceMemoryProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "memoryHeaps" VkPhysicalDeviceMemoryProperties = #{offset VkPhysicalDeviceMemoryProperties, memoryHeaps} type FieldIsArray "memoryHeaps" VkPhysicalDeviceMemoryProperties = 'True -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceMemoryProperties, memoryHeaps} instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "memoryHeaps" idx VkPhysicalDeviceMemoryProperties) => CanReadFieldArray "memoryHeaps" idx VkPhysicalDeviceMemoryProperties where {-# SPECIALISE instance CanReadFieldArray "memoryHeaps" 0 VkPhysicalDeviceMemoryProperties #-} {-# SPECIALISE instance CanReadFieldArray "memoryHeaps" 1 VkPhysicalDeviceMemoryProperties #-} {-# SPECIALISE instance CanReadFieldArray "memoryHeaps" 2 VkPhysicalDeviceMemoryProperties #-} {-# SPECIALISE instance CanReadFieldArray "memoryHeaps" 3 VkPhysicalDeviceMemoryProperties #-} type FieldArrayLength "memoryHeaps" VkPhysicalDeviceMemoryProperties = VK_MAX_MEMORY_HEAPS {-# INLINE fieldArrayLength #-} fieldArrayLength = VK_MAX_MEMORY_HEAPS {-# INLINE getFieldArray #-} getFieldArray = f where {-# NOINLINE f #-} f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off) off = #{offset VkPhysicalDeviceMemoryProperties, memoryHeaps} + sizeOf (undefined :: VkMemoryHeap) * fromInteger (natVal' (proxy## :: Proxy## idx)) -- ' closing tick for hsc2hs {-# INLINE readFieldArray #-} readFieldArray p = peekByteOff p (#{offset VkPhysicalDeviceMemoryProperties, memoryHeaps} + sizeOf (undefined :: VkMemoryHeap) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "memoryHeaps" idx VkPhysicalDeviceMemoryProperties) => CanWriteFieldArray "memoryHeaps" idx VkPhysicalDeviceMemoryProperties where {-# SPECIALISE instance CanWriteFieldArray "memoryHeaps" 0 VkPhysicalDeviceMemoryProperties #-} {-# SPECIALISE instance CanWriteFieldArray "memoryHeaps" 1 VkPhysicalDeviceMemoryProperties #-} {-# SPECIALISE instance CanWriteFieldArray "memoryHeaps" 2 VkPhysicalDeviceMemoryProperties #-} {-# SPECIALISE instance CanWriteFieldArray "memoryHeaps" 3 VkPhysicalDeviceMemoryProperties #-} {-# INLINE writeFieldArray #-} writeFieldArray p = pokeByteOff p (#{offset VkPhysicalDeviceMemoryProperties, memoryHeaps} + sizeOf (undefined :: VkMemoryHeap) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance Show VkPhysicalDeviceMemoryProperties where showsPrec d x = showString "VkPhysicalDeviceMemoryProperties {" . showString "memoryTypeCount = " . showsPrec d (getField @"memoryTypeCount" x) . showString ", " . (showString "memoryTypes = [" . showsPrec d (let s = sizeOf (undefined :: FieldType "memoryTypes" VkPhysicalDeviceMemoryProperties) o = fieldOffset @"memoryTypes" @VkPhysicalDeviceMemoryProperties f i = peekByteOff (unsafePtr x) i :: IO (FieldType "memoryTypes" VkPhysicalDeviceMemoryProperties) in unsafeDupablePerformIO . mapM f $ map (\ i -> o + i * s) [0 .. VK_MAX_MEMORY_TYPES - 1]) . showChar ']') . showString ", " . showString "memoryHeapCount = " . showsPrec d (getField @"memoryHeapCount" x) . showString ", " . (showString "memoryHeaps = [" . showsPrec d (let s = sizeOf (undefined :: FieldType "memoryHeaps" VkPhysicalDeviceMemoryProperties) o = fieldOffset @"memoryHeaps" @VkPhysicalDeviceMemoryProperties f i = peekByteOff (unsafePtr x) i :: IO (FieldType "memoryHeaps" VkPhysicalDeviceMemoryProperties) in unsafeDupablePerformIO . mapM f $ map (\ i -> o + i * s) [0 .. VK_MAX_MEMORY_HEAPS - 1]) . showChar ']') . showChar '}' -- | > typedef struct VkPhysicalDeviceMemoryProperties2 { -- > VkStructureType sType; -- > void* pNext; -- > VkPhysicalDeviceMemoryProperties memoryProperties; -- > } VkPhysicalDeviceMemoryProperties2; -- -- data VkPhysicalDeviceMemoryProperties2 = VkPhysicalDeviceMemoryProperties2## Addr## ByteArray## instance Eq VkPhysicalDeviceMemoryProperties2 where (VkPhysicalDeviceMemoryProperties2## a _) == x@(VkPhysicalDeviceMemoryProperties2## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceMemoryProperties2 where (VkPhysicalDeviceMemoryProperties2## a _) `compare` x@(VkPhysicalDeviceMemoryProperties2## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceMemoryProperties2 where sizeOf ~_ = #{size VkPhysicalDeviceMemoryProperties2} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceMemoryProperties2} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceMemoryProperties2 where unsafeAddr (VkPhysicalDeviceMemoryProperties2## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceMemoryProperties2## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceMemoryProperties2## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceMemoryProperties2 where type StructFields VkPhysicalDeviceMemoryProperties2 = '["sType", "pNext", "memoryProperties"] -- ' closing tick for hsc2hs type CUnionType VkPhysicalDeviceMemoryProperties2 = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceMemoryProperties2 = 'True -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceMemoryProperties2 = '[] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceMemoryProperties2 where type FieldType "sType" VkPhysicalDeviceMemoryProperties2 = VkStructureType type FieldOptional "sType" VkPhysicalDeviceMemoryProperties2 = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceMemoryProperties2 = #{offset VkPhysicalDeviceMemoryProperties2, sType} type FieldIsArray "sType" VkPhysicalDeviceMemoryProperties2 = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceMemoryProperties2, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceMemoryProperties2 where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceMemoryProperties2, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceMemoryProperties2, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceMemoryProperties2 where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceMemoryProperties2, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceMemoryProperties2 where type FieldType "pNext" VkPhysicalDeviceMemoryProperties2 = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceMemoryProperties2 = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceMemoryProperties2 = #{offset VkPhysicalDeviceMemoryProperties2, pNext} type FieldIsArray "pNext" VkPhysicalDeviceMemoryProperties2 = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceMemoryProperties2, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceMemoryProperties2 where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceMemoryProperties2, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceMemoryProperties2, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceMemoryProperties2 where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceMemoryProperties2, pNext} instance {-# OVERLAPPING #-} HasField "memoryProperties" VkPhysicalDeviceMemoryProperties2 where type FieldType "memoryProperties" VkPhysicalDeviceMemoryProperties2 = VkPhysicalDeviceMemoryProperties type FieldOptional "memoryProperties" VkPhysicalDeviceMemoryProperties2 = 'False -- ' closing tick for hsc2hs type FieldOffset "memoryProperties" VkPhysicalDeviceMemoryProperties2 = #{offset VkPhysicalDeviceMemoryProperties2, memoryProperties} type FieldIsArray "memoryProperties" VkPhysicalDeviceMemoryProperties2 = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceMemoryProperties2, memoryProperties} instance {-# OVERLAPPING #-} CanReadField "memoryProperties" VkPhysicalDeviceMemoryProperties2 where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceMemoryProperties2, memoryProperties}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceMemoryProperties2, memoryProperties} instance {-# OVERLAPPING #-} CanWriteField "memoryProperties" VkPhysicalDeviceMemoryProperties2 where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceMemoryProperties2, memoryProperties} instance Show VkPhysicalDeviceMemoryProperties2 where showsPrec d x = showString "VkPhysicalDeviceMemoryProperties2 {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "memoryProperties = " . showsPrec d (getField @"memoryProperties" x) . showChar '}' -- | Alias for `VkPhysicalDeviceMemoryProperties2` type VkPhysicalDeviceMemoryProperties2KHR = VkPhysicalDeviceMemoryProperties2 -- | > typedef struct VkPhysicalDeviceMultiviewFeatures { -- > VkStructureType sType; -- > void* pNext; -- > VkBool32 multiview; -- > VkBool32 multiviewGeometryShader; -- > VkBool32 multiviewTessellationShader; -- > } VkPhysicalDeviceMultiviewFeatures; -- -- data VkPhysicalDeviceMultiviewFeatures = VkPhysicalDeviceMultiviewFeatures## Addr## ByteArray## instance Eq VkPhysicalDeviceMultiviewFeatures where (VkPhysicalDeviceMultiviewFeatures## a _) == x@(VkPhysicalDeviceMultiviewFeatures## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceMultiviewFeatures where (VkPhysicalDeviceMultiviewFeatures## a _) `compare` x@(VkPhysicalDeviceMultiviewFeatures## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceMultiviewFeatures where sizeOf ~_ = #{size VkPhysicalDeviceMultiviewFeatures} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceMultiviewFeatures} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceMultiviewFeatures where unsafeAddr (VkPhysicalDeviceMultiviewFeatures## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceMultiviewFeatures## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceMultiviewFeatures## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceMultiviewFeatures where type StructFields VkPhysicalDeviceMultiviewFeatures = '["sType", "pNext", "multiview", "multiviewGeometryShader", -- ' closing tick for hsc2hs "multiviewTessellationShader"] type CUnionType VkPhysicalDeviceMultiviewFeatures = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceMultiviewFeatures = 'False -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceMultiviewFeatures = '[VkPhysicalDeviceFeatures2, VkDeviceCreateInfo] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceMultiviewFeatures where type FieldType "sType" VkPhysicalDeviceMultiviewFeatures = VkStructureType type FieldOptional "sType" VkPhysicalDeviceMultiviewFeatures = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceMultiviewFeatures = #{offset VkPhysicalDeviceMultiviewFeatures, sType} type FieldIsArray "sType" VkPhysicalDeviceMultiviewFeatures = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceMultiviewFeatures, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceMultiviewFeatures where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceMultiviewFeatures, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceMultiviewFeatures, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceMultiviewFeatures where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceMultiviewFeatures, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceMultiviewFeatures where type FieldType "pNext" VkPhysicalDeviceMultiviewFeatures = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceMultiviewFeatures = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceMultiviewFeatures = #{offset VkPhysicalDeviceMultiviewFeatures, pNext} type FieldIsArray "pNext" VkPhysicalDeviceMultiviewFeatures = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceMultiviewFeatures, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceMultiviewFeatures where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceMultiviewFeatures, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceMultiviewFeatures, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceMultiviewFeatures where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceMultiviewFeatures, pNext} instance {-# OVERLAPPING #-} HasField "multiview" VkPhysicalDeviceMultiviewFeatures where type FieldType "multiview" VkPhysicalDeviceMultiviewFeatures = VkBool32 type FieldOptional "multiview" VkPhysicalDeviceMultiviewFeatures = 'False -- ' closing tick for hsc2hs type FieldOffset "multiview" VkPhysicalDeviceMultiviewFeatures = #{offset VkPhysicalDeviceMultiviewFeatures, multiview} type FieldIsArray "multiview" VkPhysicalDeviceMultiviewFeatures = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceMultiviewFeatures, multiview} instance {-# OVERLAPPING #-} CanReadField "multiview" VkPhysicalDeviceMultiviewFeatures where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceMultiviewFeatures, multiview}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceMultiviewFeatures, multiview} instance {-# OVERLAPPING #-} CanWriteField "multiview" VkPhysicalDeviceMultiviewFeatures where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceMultiviewFeatures, multiview} instance {-# OVERLAPPING #-} HasField "multiviewGeometryShader" VkPhysicalDeviceMultiviewFeatures where type FieldType "multiviewGeometryShader" VkPhysicalDeviceMultiviewFeatures = VkBool32 type FieldOptional "multiviewGeometryShader" VkPhysicalDeviceMultiviewFeatures = 'False -- ' closing tick for hsc2hs type FieldOffset "multiviewGeometryShader" VkPhysicalDeviceMultiviewFeatures = #{offset VkPhysicalDeviceMultiviewFeatures, multiviewGeometryShader} type FieldIsArray "multiviewGeometryShader" VkPhysicalDeviceMultiviewFeatures = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceMultiviewFeatures, multiviewGeometryShader} instance {-# OVERLAPPING #-} CanReadField "multiviewGeometryShader" VkPhysicalDeviceMultiviewFeatures where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceMultiviewFeatures, multiviewGeometryShader}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceMultiviewFeatures, multiviewGeometryShader} instance {-# OVERLAPPING #-} CanWriteField "multiviewGeometryShader" VkPhysicalDeviceMultiviewFeatures where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceMultiviewFeatures, multiviewGeometryShader} instance {-# OVERLAPPING #-} HasField "multiviewTessellationShader" VkPhysicalDeviceMultiviewFeatures where type FieldType "multiviewTessellationShader" VkPhysicalDeviceMultiviewFeatures = VkBool32 type FieldOptional "multiviewTessellationShader" VkPhysicalDeviceMultiviewFeatures = 'False -- ' closing tick for hsc2hs type FieldOffset "multiviewTessellationShader" VkPhysicalDeviceMultiviewFeatures = #{offset VkPhysicalDeviceMultiviewFeatures, multiviewTessellationShader} type FieldIsArray "multiviewTessellationShader" VkPhysicalDeviceMultiviewFeatures = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceMultiviewFeatures, multiviewTessellationShader} instance {-# OVERLAPPING #-} CanReadField "multiviewTessellationShader" VkPhysicalDeviceMultiviewFeatures where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceMultiviewFeatures, multiviewTessellationShader}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceMultiviewFeatures, multiviewTessellationShader} instance {-# OVERLAPPING #-} CanWriteField "multiviewTessellationShader" VkPhysicalDeviceMultiviewFeatures where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceMultiviewFeatures, multiviewTessellationShader} instance Show VkPhysicalDeviceMultiviewFeatures where showsPrec d x = showString "VkPhysicalDeviceMultiviewFeatures {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "multiview = " . showsPrec d (getField @"multiview" x) . showString ", " . showString "multiviewGeometryShader = " . showsPrec d (getField @"multiviewGeometryShader" x) . showString ", " . showString "multiviewTessellationShader = " . showsPrec d (getField @"multiviewTessellationShader" x) . showChar '}' -- | Alias for `VkPhysicalDeviceMultiviewFeatures` type VkPhysicalDeviceMultiviewFeaturesKHR = VkPhysicalDeviceMultiviewFeatures -- | > typedef struct VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX { -- > VkStructureType sType; -- > void* pNext; -- > VkBool32 perViewPositionAllComponents; -- > } VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX; -- -- data VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX = VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX## Addr## ByteArray## instance Eq VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX where (VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX## a _) == x@(VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX where (VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX## a _) `compare` x@(VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX where sizeOf ~_ = #{size VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX where unsafeAddr (VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX where type StructFields VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX = '["sType", "pNext", "perViewPositionAllComponents"] -- ' closing tick for hsc2hs type CUnionType VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX = 'True -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX = '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX where type FieldType "sType" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX = VkStructureType type FieldOptional "sType" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX = #{offset VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX, sType} type FieldIsArray "sType" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX where type FieldType "pNext" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX = #{offset VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX, pNext} type FieldIsArray "pNext" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX, pNext} instance {-# OVERLAPPING #-} HasField "perViewPositionAllComponents" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX where type FieldType "perViewPositionAllComponents" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX = VkBool32 type FieldOptional "perViewPositionAllComponents" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX = 'False -- ' closing tick for hsc2hs type FieldOffset "perViewPositionAllComponents" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX = #{offset VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX, perViewPositionAllComponents} type FieldIsArray "perViewPositionAllComponents" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX, perViewPositionAllComponents} instance {-# OVERLAPPING #-} CanReadField "perViewPositionAllComponents" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX, perViewPositionAllComponents}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX, perViewPositionAllComponents} instance {-# OVERLAPPING #-} CanWriteField "perViewPositionAllComponents" VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX, perViewPositionAllComponents} instance Show VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX where showsPrec d x = showString "VkPhysicalDeviceMultiviewPerViewAttributesPropertiesNVX {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "perViewPositionAllComponents = " . showsPrec d (getField @"perViewPositionAllComponents" x) . showChar '}' -- | > typedef struct VkPhysicalDeviceMultiviewProperties { -- > VkStructureType sType; -- > void* pNext; -- > uint32_t maxMultiviewViewCount; -- > uint32_t maxMultiviewInstanceIndex; -- > } VkPhysicalDeviceMultiviewProperties; -- -- data VkPhysicalDeviceMultiviewProperties = VkPhysicalDeviceMultiviewProperties## Addr## ByteArray## instance Eq VkPhysicalDeviceMultiviewProperties where (VkPhysicalDeviceMultiviewProperties## a _) == x@(VkPhysicalDeviceMultiviewProperties## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceMultiviewProperties where (VkPhysicalDeviceMultiviewProperties## a _) `compare` x@(VkPhysicalDeviceMultiviewProperties## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceMultiviewProperties where sizeOf ~_ = #{size VkPhysicalDeviceMultiviewProperties} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceMultiviewProperties} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceMultiviewProperties where unsafeAddr (VkPhysicalDeviceMultiviewProperties## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceMultiviewProperties## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceMultiviewProperties## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceMultiviewProperties where type StructFields VkPhysicalDeviceMultiviewProperties = '["sType", "pNext", "maxMultiviewViewCount", -- ' closing tick for hsc2hs "maxMultiviewInstanceIndex"] type CUnionType VkPhysicalDeviceMultiviewProperties = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceMultiviewProperties = 'True -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceMultiviewProperties = '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceMultiviewProperties where type FieldType "sType" VkPhysicalDeviceMultiviewProperties = VkStructureType type FieldOptional "sType" VkPhysicalDeviceMultiviewProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceMultiviewProperties = #{offset VkPhysicalDeviceMultiviewProperties, sType} type FieldIsArray "sType" VkPhysicalDeviceMultiviewProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceMultiviewProperties, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceMultiviewProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceMultiviewProperties, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceMultiviewProperties, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceMultiviewProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceMultiviewProperties, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceMultiviewProperties where type FieldType "pNext" VkPhysicalDeviceMultiviewProperties = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceMultiviewProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceMultiviewProperties = #{offset VkPhysicalDeviceMultiviewProperties, pNext} type FieldIsArray "pNext" VkPhysicalDeviceMultiviewProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceMultiviewProperties, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceMultiviewProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceMultiviewProperties, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceMultiviewProperties, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceMultiviewProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceMultiviewProperties, pNext} instance {-# OVERLAPPING #-} HasField "maxMultiviewViewCount" VkPhysicalDeviceMultiviewProperties where type FieldType "maxMultiviewViewCount" VkPhysicalDeviceMultiviewProperties = Word32 type FieldOptional "maxMultiviewViewCount" VkPhysicalDeviceMultiviewProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "maxMultiviewViewCount" VkPhysicalDeviceMultiviewProperties = #{offset VkPhysicalDeviceMultiviewProperties, maxMultiviewViewCount} type FieldIsArray "maxMultiviewViewCount" VkPhysicalDeviceMultiviewProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceMultiviewProperties, maxMultiviewViewCount} instance {-# OVERLAPPING #-} CanReadField "maxMultiviewViewCount" VkPhysicalDeviceMultiviewProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceMultiviewProperties, maxMultiviewViewCount}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceMultiviewProperties, maxMultiviewViewCount} instance {-# OVERLAPPING #-} CanWriteField "maxMultiviewViewCount" VkPhysicalDeviceMultiviewProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceMultiviewProperties, maxMultiviewViewCount} instance {-# OVERLAPPING #-} HasField "maxMultiviewInstanceIndex" VkPhysicalDeviceMultiviewProperties where type FieldType "maxMultiviewInstanceIndex" VkPhysicalDeviceMultiviewProperties = Word32 type FieldOptional "maxMultiviewInstanceIndex" VkPhysicalDeviceMultiviewProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "maxMultiviewInstanceIndex" VkPhysicalDeviceMultiviewProperties = #{offset VkPhysicalDeviceMultiviewProperties, maxMultiviewInstanceIndex} type FieldIsArray "maxMultiviewInstanceIndex" VkPhysicalDeviceMultiviewProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceMultiviewProperties, maxMultiviewInstanceIndex} instance {-# OVERLAPPING #-} CanReadField "maxMultiviewInstanceIndex" VkPhysicalDeviceMultiviewProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceMultiviewProperties, maxMultiviewInstanceIndex}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceMultiviewProperties, maxMultiviewInstanceIndex} instance {-# OVERLAPPING #-} CanWriteField "maxMultiviewInstanceIndex" VkPhysicalDeviceMultiviewProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceMultiviewProperties, maxMultiviewInstanceIndex} instance Show VkPhysicalDeviceMultiviewProperties where showsPrec d x = showString "VkPhysicalDeviceMultiviewProperties {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "maxMultiviewViewCount = " . showsPrec d (getField @"maxMultiviewViewCount" x) . showString ", " . showString "maxMultiviewInstanceIndex = " . showsPrec d (getField @"maxMultiviewInstanceIndex" x) . showChar '}' -- | Alias for `VkPhysicalDeviceMultiviewProperties` type VkPhysicalDeviceMultiviewPropertiesKHR = VkPhysicalDeviceMultiviewProperties -- | > typedef struct VkPhysicalDevicePointClippingProperties { -- > VkStructureType sType; -- > void* pNext; -- > VkPointClippingBehavior pointClippingBehavior; -- > } VkPhysicalDevicePointClippingProperties; -- -- data VkPhysicalDevicePointClippingProperties = VkPhysicalDevicePointClippingProperties## Addr## ByteArray## instance Eq VkPhysicalDevicePointClippingProperties where (VkPhysicalDevicePointClippingProperties## a _) == x@(VkPhysicalDevicePointClippingProperties## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDevicePointClippingProperties where (VkPhysicalDevicePointClippingProperties## a _) `compare` x@(VkPhysicalDevicePointClippingProperties## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDevicePointClippingProperties where sizeOf ~_ = #{size VkPhysicalDevicePointClippingProperties} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDevicePointClippingProperties} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDevicePointClippingProperties where unsafeAddr (VkPhysicalDevicePointClippingProperties## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDevicePointClippingProperties## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDevicePointClippingProperties## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDevicePointClippingProperties where type StructFields VkPhysicalDevicePointClippingProperties = '["sType", "pNext", "pointClippingBehavior"] -- ' closing tick for hsc2hs type CUnionType VkPhysicalDevicePointClippingProperties = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDevicePointClippingProperties = 'True -- ' closing tick for hsc2hs type StructExtends VkPhysicalDevicePointClippingProperties = '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDevicePointClippingProperties where type FieldType "sType" VkPhysicalDevicePointClippingProperties = VkStructureType type FieldOptional "sType" VkPhysicalDevicePointClippingProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDevicePointClippingProperties = #{offset VkPhysicalDevicePointClippingProperties, sType} type FieldIsArray "sType" VkPhysicalDevicePointClippingProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDevicePointClippingProperties, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDevicePointClippingProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDevicePointClippingProperties, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDevicePointClippingProperties, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDevicePointClippingProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDevicePointClippingProperties, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDevicePointClippingProperties where type FieldType "pNext" VkPhysicalDevicePointClippingProperties = Ptr Void type FieldOptional "pNext" VkPhysicalDevicePointClippingProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDevicePointClippingProperties = #{offset VkPhysicalDevicePointClippingProperties, pNext} type FieldIsArray "pNext" VkPhysicalDevicePointClippingProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDevicePointClippingProperties, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDevicePointClippingProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDevicePointClippingProperties, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDevicePointClippingProperties, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDevicePointClippingProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDevicePointClippingProperties, pNext} instance {-# OVERLAPPING #-} HasField "pointClippingBehavior" VkPhysicalDevicePointClippingProperties where type FieldType "pointClippingBehavior" VkPhysicalDevicePointClippingProperties = VkPointClippingBehavior type FieldOptional "pointClippingBehavior" VkPhysicalDevicePointClippingProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "pointClippingBehavior" VkPhysicalDevicePointClippingProperties = #{offset VkPhysicalDevicePointClippingProperties, pointClippingBehavior} type FieldIsArray "pointClippingBehavior" VkPhysicalDevicePointClippingProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDevicePointClippingProperties, pointClippingBehavior} instance {-# OVERLAPPING #-} CanReadField "pointClippingBehavior" VkPhysicalDevicePointClippingProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDevicePointClippingProperties, pointClippingBehavior}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDevicePointClippingProperties, pointClippingBehavior} instance {-# OVERLAPPING #-} CanWriteField "pointClippingBehavior" VkPhysicalDevicePointClippingProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDevicePointClippingProperties, pointClippingBehavior} instance Show VkPhysicalDevicePointClippingProperties where showsPrec d x = showString "VkPhysicalDevicePointClippingProperties {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "pointClippingBehavior = " . showsPrec d (getField @"pointClippingBehavior" x) . showChar '}' -- | Alias for `VkPhysicalDevicePointClippingProperties` type VkPhysicalDevicePointClippingPropertiesKHR = VkPhysicalDevicePointClippingProperties -- | > typedef struct VkPhysicalDeviceProperties { -- > uint32_t apiVersion; -- > uint32_t driverVersion; -- > uint32_t vendorID; -- > uint32_t deviceID; -- > VkPhysicalDeviceType deviceType; -- > char deviceName[VK_MAX_PHYSICAL_DEVICE_NAME_SIZE]; -- > uint8_t pipelineCacheUUID[VK_UUID_SIZE]; -- > VkPhysicalDeviceLimits limits; -- > VkPhysicalDeviceSparseProperties sparseProperties; -- > } VkPhysicalDeviceProperties; -- -- data VkPhysicalDeviceProperties = VkPhysicalDeviceProperties## Addr## ByteArray## instance Eq VkPhysicalDeviceProperties where (VkPhysicalDeviceProperties## a _) == x@(VkPhysicalDeviceProperties## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceProperties where (VkPhysicalDeviceProperties## a _) `compare` x@(VkPhysicalDeviceProperties## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceProperties where sizeOf ~_ = #{size VkPhysicalDeviceProperties} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceProperties} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceProperties where unsafeAddr (VkPhysicalDeviceProperties## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceProperties## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceProperties## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceProperties where type StructFields VkPhysicalDeviceProperties = '["apiVersion", "driverVersion", "vendorID", "deviceID", -- ' closing tick for hsc2hs "deviceType", "deviceName", "pipelineCacheUUID", "limits", "sparseProperties"] type CUnionType VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceProperties = 'True -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceProperties = '[] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "apiVersion" VkPhysicalDeviceProperties where type FieldType "apiVersion" VkPhysicalDeviceProperties = Word32 type FieldOptional "apiVersion" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "apiVersion" VkPhysicalDeviceProperties = #{offset VkPhysicalDeviceProperties, apiVersion} type FieldIsArray "apiVersion" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceProperties, apiVersion} instance {-# OVERLAPPING #-} CanReadField "apiVersion" VkPhysicalDeviceProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceProperties, apiVersion}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceProperties, apiVersion} instance {-# OVERLAPPING #-} CanWriteField "apiVersion" VkPhysicalDeviceProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceProperties, apiVersion} instance {-# OVERLAPPING #-} HasField "driverVersion" VkPhysicalDeviceProperties where type FieldType "driverVersion" VkPhysicalDeviceProperties = Word32 type FieldOptional "driverVersion" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "driverVersion" VkPhysicalDeviceProperties = #{offset VkPhysicalDeviceProperties, driverVersion} type FieldIsArray "driverVersion" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceProperties, driverVersion} instance {-# OVERLAPPING #-} CanReadField "driverVersion" VkPhysicalDeviceProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceProperties, driverVersion}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceProperties, driverVersion} instance {-# OVERLAPPING #-} CanWriteField "driverVersion" VkPhysicalDeviceProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceProperties, driverVersion} instance {-# OVERLAPPING #-} HasField "vendorID" VkPhysicalDeviceProperties where type FieldType "vendorID" VkPhysicalDeviceProperties = Word32 type FieldOptional "vendorID" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "vendorID" VkPhysicalDeviceProperties = #{offset VkPhysicalDeviceProperties, vendorID} type FieldIsArray "vendorID" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceProperties, vendorID} instance {-# OVERLAPPING #-} CanReadField "vendorID" VkPhysicalDeviceProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceProperties, vendorID}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceProperties, vendorID} instance {-# OVERLAPPING #-} CanWriteField "vendorID" VkPhysicalDeviceProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceProperties, vendorID} instance {-# OVERLAPPING #-} HasField "deviceID" VkPhysicalDeviceProperties where type FieldType "deviceID" VkPhysicalDeviceProperties = Word32 type FieldOptional "deviceID" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "deviceID" VkPhysicalDeviceProperties = #{offset VkPhysicalDeviceProperties, deviceID} type FieldIsArray "deviceID" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceProperties, deviceID} instance {-# OVERLAPPING #-} CanReadField "deviceID" VkPhysicalDeviceProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceProperties, deviceID}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceProperties, deviceID} instance {-# OVERLAPPING #-} CanWriteField "deviceID" VkPhysicalDeviceProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceProperties, deviceID} instance {-# OVERLAPPING #-} HasField "deviceType" VkPhysicalDeviceProperties where type FieldType "deviceType" VkPhysicalDeviceProperties = VkPhysicalDeviceType type FieldOptional "deviceType" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "deviceType" VkPhysicalDeviceProperties = #{offset VkPhysicalDeviceProperties, deviceType} type FieldIsArray "deviceType" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceProperties, deviceType} instance {-# OVERLAPPING #-} CanReadField "deviceType" VkPhysicalDeviceProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceProperties, deviceType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceProperties, deviceType} instance {-# OVERLAPPING #-} CanWriteField "deviceType" VkPhysicalDeviceProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceProperties, deviceType} instance {-# OVERLAPPING #-} HasField "deviceName" VkPhysicalDeviceProperties where type FieldType "deviceName" VkPhysicalDeviceProperties = CChar type FieldOptional "deviceName" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "deviceName" VkPhysicalDeviceProperties = #{offset VkPhysicalDeviceProperties, deviceName} type FieldIsArray "deviceName" VkPhysicalDeviceProperties = 'True -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceProperties, deviceName} instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "deviceName" idx VkPhysicalDeviceProperties) => CanReadFieldArray "deviceName" idx VkPhysicalDeviceProperties where {-# SPECIALISE instance CanReadFieldArray "deviceName" 0 VkPhysicalDeviceProperties #-} {-# SPECIALISE instance CanReadFieldArray "deviceName" 1 VkPhysicalDeviceProperties #-} {-# SPECIALISE instance CanReadFieldArray "deviceName" 2 VkPhysicalDeviceProperties #-} {-# SPECIALISE instance CanReadFieldArray "deviceName" 3 VkPhysicalDeviceProperties #-} type FieldArrayLength "deviceName" VkPhysicalDeviceProperties = VK_MAX_PHYSICAL_DEVICE_NAME_SIZE {-# INLINE fieldArrayLength #-} fieldArrayLength = VK_MAX_PHYSICAL_DEVICE_NAME_SIZE {-# INLINE getFieldArray #-} getFieldArray = f where {-# NOINLINE f #-} f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off) off = #{offset VkPhysicalDeviceProperties, deviceName} + sizeOf (undefined :: CChar) * fromInteger (natVal' (proxy## :: Proxy## idx)) -- ' closing tick for hsc2hs {-# INLINE readFieldArray #-} readFieldArray p = peekByteOff p (#{offset VkPhysicalDeviceProperties, deviceName} + sizeOf (undefined :: CChar) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "deviceName" idx VkPhysicalDeviceProperties) => CanWriteFieldArray "deviceName" idx VkPhysicalDeviceProperties where {-# SPECIALISE instance CanWriteFieldArray "deviceName" 0 VkPhysicalDeviceProperties #-} {-# SPECIALISE instance CanWriteFieldArray "deviceName" 1 VkPhysicalDeviceProperties #-} {-# SPECIALISE instance CanWriteFieldArray "deviceName" 2 VkPhysicalDeviceProperties #-} {-# SPECIALISE instance CanWriteFieldArray "deviceName" 3 VkPhysicalDeviceProperties #-} {-# INLINE writeFieldArray #-} writeFieldArray p = pokeByteOff p (#{offset VkPhysicalDeviceProperties, deviceName} + sizeOf (undefined :: CChar) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "pipelineCacheUUID" VkPhysicalDeviceProperties where type FieldType "pipelineCacheUUID" VkPhysicalDeviceProperties = Word8 type FieldOptional "pipelineCacheUUID" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "pipelineCacheUUID" VkPhysicalDeviceProperties = #{offset VkPhysicalDeviceProperties, pipelineCacheUUID} type FieldIsArray "pipelineCacheUUID" VkPhysicalDeviceProperties = 'True -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceProperties, pipelineCacheUUID} instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "pipelineCacheUUID" idx VkPhysicalDeviceProperties) => CanReadFieldArray "pipelineCacheUUID" idx VkPhysicalDeviceProperties where {-# SPECIALISE instance CanReadFieldArray "pipelineCacheUUID" 0 VkPhysicalDeviceProperties #-} {-# SPECIALISE instance CanReadFieldArray "pipelineCacheUUID" 1 VkPhysicalDeviceProperties #-} {-# SPECIALISE instance CanReadFieldArray "pipelineCacheUUID" 2 VkPhysicalDeviceProperties #-} {-# SPECIALISE instance CanReadFieldArray "pipelineCacheUUID" 3 VkPhysicalDeviceProperties #-} type FieldArrayLength "pipelineCacheUUID" VkPhysicalDeviceProperties = VK_UUID_SIZE {-# INLINE fieldArrayLength #-} fieldArrayLength = VK_UUID_SIZE {-# INLINE getFieldArray #-} getFieldArray = f where {-# NOINLINE f #-} f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off) off = #{offset VkPhysicalDeviceProperties, pipelineCacheUUID} + sizeOf (undefined :: Word8) * fromInteger (natVal' (proxy## :: Proxy## idx)) -- ' closing tick for hsc2hs {-# INLINE readFieldArray #-} readFieldArray p = peekByteOff p (#{offset VkPhysicalDeviceProperties, pipelineCacheUUID} + sizeOf (undefined :: Word8) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "pipelineCacheUUID" idx VkPhysicalDeviceProperties) => CanWriteFieldArray "pipelineCacheUUID" idx VkPhysicalDeviceProperties where {-# SPECIALISE instance CanWriteFieldArray "pipelineCacheUUID" 0 VkPhysicalDeviceProperties #-} {-# SPECIALISE instance CanWriteFieldArray "pipelineCacheUUID" 1 VkPhysicalDeviceProperties #-} {-# SPECIALISE instance CanWriteFieldArray "pipelineCacheUUID" 2 VkPhysicalDeviceProperties #-} {-# SPECIALISE instance CanWriteFieldArray "pipelineCacheUUID" 3 VkPhysicalDeviceProperties #-} {-# INLINE writeFieldArray #-} writeFieldArray p = pokeByteOff p (#{offset VkPhysicalDeviceProperties, pipelineCacheUUID} + sizeOf (undefined :: Word8) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "limits" VkPhysicalDeviceProperties where type FieldType "limits" VkPhysicalDeviceProperties = VkPhysicalDeviceLimits type FieldOptional "limits" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "limits" VkPhysicalDeviceProperties = #{offset VkPhysicalDeviceProperties, limits} type FieldIsArray "limits" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceProperties, limits} instance {-# OVERLAPPING #-} CanReadField "limits" VkPhysicalDeviceProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceProperties, limits}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceProperties, limits} instance {-# OVERLAPPING #-} CanWriteField "limits" VkPhysicalDeviceProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceProperties, limits} instance {-# OVERLAPPING #-} HasField "sparseProperties" VkPhysicalDeviceProperties where type FieldType "sparseProperties" VkPhysicalDeviceProperties = VkPhysicalDeviceSparseProperties type FieldOptional "sparseProperties" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "sparseProperties" VkPhysicalDeviceProperties = #{offset VkPhysicalDeviceProperties, sparseProperties} type FieldIsArray "sparseProperties" VkPhysicalDeviceProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceProperties, sparseProperties} instance {-# OVERLAPPING #-} CanReadField "sparseProperties" VkPhysicalDeviceProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceProperties, sparseProperties}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceProperties, sparseProperties} instance {-# OVERLAPPING #-} CanWriteField "sparseProperties" VkPhysicalDeviceProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceProperties, sparseProperties} instance Show VkPhysicalDeviceProperties where showsPrec d x = showString "VkPhysicalDeviceProperties {" . showString "apiVersion = " . showsPrec d (getField @"apiVersion" x) . showString ", " . showString "driverVersion = " . showsPrec d (getField @"driverVersion" x) . showString ", " . showString "vendorID = " . showsPrec d (getField @"vendorID" x) . showString ", " . showString "deviceID = " . showsPrec d (getField @"deviceID" x) . showString ", " . showString "deviceType = " . showsPrec d (getField @"deviceType" x) . showString ", " . (showString "deviceName = [" . showsPrec d (let s = sizeOf (undefined :: FieldType "deviceName" VkPhysicalDeviceProperties) o = fieldOffset @"deviceName" @VkPhysicalDeviceProperties f i = peekByteOff (unsafePtr x) i :: IO (FieldType "deviceName" VkPhysicalDeviceProperties) in unsafeDupablePerformIO . mapM f $ map (\ i -> o + i * s) [0 .. VK_MAX_PHYSICAL_DEVICE_NAME_SIZE - 1]) . showChar ']') . showString ", " . (showString "pipelineCacheUUID = [" . showsPrec d (let s = sizeOf (undefined :: FieldType "pipelineCacheUUID" VkPhysicalDeviceProperties) o = fieldOffset @"pipelineCacheUUID" @VkPhysicalDeviceProperties f i = peekByteOff (unsafePtr x) i :: IO (FieldType "pipelineCacheUUID" VkPhysicalDeviceProperties) in unsafeDupablePerformIO . mapM f $ map (\ i -> o + i * s) [0 .. VK_UUID_SIZE - 1]) . showChar ']') . showString ", " . showString "limits = " . showsPrec d (getField @"limits" x) . showString ", " . showString "sparseProperties = " . showsPrec d (getField @"sparseProperties" x) . showChar '}' -- | > typedef struct VkPhysicalDeviceProperties2 { -- > VkStructureType sType; -- > void* pNext; -- > VkPhysicalDeviceProperties properties; -- > } VkPhysicalDeviceProperties2; -- -- data VkPhysicalDeviceProperties2 = VkPhysicalDeviceProperties2## Addr## ByteArray## instance Eq VkPhysicalDeviceProperties2 where (VkPhysicalDeviceProperties2## a _) == x@(VkPhysicalDeviceProperties2## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceProperties2 where (VkPhysicalDeviceProperties2## a _) `compare` x@(VkPhysicalDeviceProperties2## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceProperties2 where sizeOf ~_ = #{size VkPhysicalDeviceProperties2} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceProperties2} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceProperties2 where unsafeAddr (VkPhysicalDeviceProperties2## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceProperties2## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceProperties2## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceProperties2 where type StructFields VkPhysicalDeviceProperties2 = '["sType", "pNext", "properties"] -- ' closing tick for hsc2hs type CUnionType VkPhysicalDeviceProperties2 = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceProperties2 = 'True -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceProperties2 = '[] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceProperties2 where type FieldType "sType" VkPhysicalDeviceProperties2 = VkStructureType type FieldOptional "sType" VkPhysicalDeviceProperties2 = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceProperties2 = #{offset VkPhysicalDeviceProperties2, sType} type FieldIsArray "sType" VkPhysicalDeviceProperties2 = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceProperties2, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceProperties2 where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceProperties2, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceProperties2, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceProperties2 where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceProperties2, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceProperties2 where type FieldType "pNext" VkPhysicalDeviceProperties2 = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceProperties2 = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceProperties2 = #{offset VkPhysicalDeviceProperties2, pNext} type FieldIsArray "pNext" VkPhysicalDeviceProperties2 = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceProperties2, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceProperties2 where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceProperties2, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceProperties2, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceProperties2 where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceProperties2, pNext} instance {-# OVERLAPPING #-} HasField "properties" VkPhysicalDeviceProperties2 where type FieldType "properties" VkPhysicalDeviceProperties2 = VkPhysicalDeviceProperties type FieldOptional "properties" VkPhysicalDeviceProperties2 = 'False -- ' closing tick for hsc2hs type FieldOffset "properties" VkPhysicalDeviceProperties2 = #{offset VkPhysicalDeviceProperties2, properties} type FieldIsArray "properties" VkPhysicalDeviceProperties2 = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceProperties2, properties} instance {-# OVERLAPPING #-} CanReadField "properties" VkPhysicalDeviceProperties2 where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceProperties2, properties}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceProperties2, properties} instance {-# OVERLAPPING #-} CanWriteField "properties" VkPhysicalDeviceProperties2 where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceProperties2, properties} instance Show VkPhysicalDeviceProperties2 where showsPrec d x = showString "VkPhysicalDeviceProperties2 {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "properties = " . showsPrec d (getField @"properties" x) . showChar '}' -- | Alias for `VkPhysicalDeviceProperties2` type VkPhysicalDeviceProperties2KHR = VkPhysicalDeviceProperties2 -- | > typedef struct VkPhysicalDeviceProtectedMemoryFeatures { -- > VkStructureType sType; -- > void* pNext; -- > VkBool32 protectedMemory; -- > } VkPhysicalDeviceProtectedMemoryFeatures; -- -- data VkPhysicalDeviceProtectedMemoryFeatures = VkPhysicalDeviceProtectedMemoryFeatures## Addr## ByteArray## instance Eq VkPhysicalDeviceProtectedMemoryFeatures where (VkPhysicalDeviceProtectedMemoryFeatures## a _) == x@(VkPhysicalDeviceProtectedMemoryFeatures## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceProtectedMemoryFeatures where (VkPhysicalDeviceProtectedMemoryFeatures## a _) `compare` x@(VkPhysicalDeviceProtectedMemoryFeatures## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceProtectedMemoryFeatures where sizeOf ~_ = #{size VkPhysicalDeviceProtectedMemoryFeatures} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceProtectedMemoryFeatures} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceProtectedMemoryFeatures where unsafeAddr (VkPhysicalDeviceProtectedMemoryFeatures## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceProtectedMemoryFeatures## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceProtectedMemoryFeatures## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceProtectedMemoryFeatures where type StructFields VkPhysicalDeviceProtectedMemoryFeatures = '["sType", "pNext", "protectedMemory"] -- ' closing tick for hsc2hs type CUnionType VkPhysicalDeviceProtectedMemoryFeatures = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceProtectedMemoryFeatures = 'False -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceProtectedMemoryFeatures = '[VkPhysicalDeviceFeatures2, VkDeviceCreateInfo] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceProtectedMemoryFeatures where type FieldType "sType" VkPhysicalDeviceProtectedMemoryFeatures = VkStructureType type FieldOptional "sType" VkPhysicalDeviceProtectedMemoryFeatures = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceProtectedMemoryFeatures = #{offset VkPhysicalDeviceProtectedMemoryFeatures, sType} type FieldIsArray "sType" VkPhysicalDeviceProtectedMemoryFeatures = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceProtectedMemoryFeatures, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceProtectedMemoryFeatures where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceProtectedMemoryFeatures, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceProtectedMemoryFeatures, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceProtectedMemoryFeatures where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceProtectedMemoryFeatures, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceProtectedMemoryFeatures where type FieldType "pNext" VkPhysicalDeviceProtectedMemoryFeatures = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceProtectedMemoryFeatures = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceProtectedMemoryFeatures = #{offset VkPhysicalDeviceProtectedMemoryFeatures, pNext} type FieldIsArray "pNext" VkPhysicalDeviceProtectedMemoryFeatures = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceProtectedMemoryFeatures, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceProtectedMemoryFeatures where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceProtectedMemoryFeatures, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceProtectedMemoryFeatures, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceProtectedMemoryFeatures where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceProtectedMemoryFeatures, pNext} instance {-# OVERLAPPING #-} HasField "protectedMemory" VkPhysicalDeviceProtectedMemoryFeatures where type FieldType "protectedMemory" VkPhysicalDeviceProtectedMemoryFeatures = VkBool32 type FieldOptional "protectedMemory" VkPhysicalDeviceProtectedMemoryFeatures = 'False -- ' closing tick for hsc2hs type FieldOffset "protectedMemory" VkPhysicalDeviceProtectedMemoryFeatures = #{offset VkPhysicalDeviceProtectedMemoryFeatures, protectedMemory} type FieldIsArray "protectedMemory" VkPhysicalDeviceProtectedMemoryFeatures = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceProtectedMemoryFeatures, protectedMemory} instance {-# OVERLAPPING #-} CanReadField "protectedMemory" VkPhysicalDeviceProtectedMemoryFeatures where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceProtectedMemoryFeatures, protectedMemory}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceProtectedMemoryFeatures, protectedMemory} instance {-# OVERLAPPING #-} CanWriteField "protectedMemory" VkPhysicalDeviceProtectedMemoryFeatures where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceProtectedMemoryFeatures, protectedMemory} instance Show VkPhysicalDeviceProtectedMemoryFeatures where showsPrec d x = showString "VkPhysicalDeviceProtectedMemoryFeatures {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "protectedMemory = " . showsPrec d (getField @"protectedMemory" x) . showChar '}' -- | > typedef struct VkPhysicalDeviceProtectedMemoryProperties { -- > VkStructureType sType; -- > void* pNext; -- > VkBool32 protectedNoFault; -- > } VkPhysicalDeviceProtectedMemoryProperties; -- -- data VkPhysicalDeviceProtectedMemoryProperties = VkPhysicalDeviceProtectedMemoryProperties## Addr## ByteArray## instance Eq VkPhysicalDeviceProtectedMemoryProperties where (VkPhysicalDeviceProtectedMemoryProperties## a _) == x@(VkPhysicalDeviceProtectedMemoryProperties## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceProtectedMemoryProperties where (VkPhysicalDeviceProtectedMemoryProperties## a _) `compare` x@(VkPhysicalDeviceProtectedMemoryProperties## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceProtectedMemoryProperties where sizeOf ~_ = #{size VkPhysicalDeviceProtectedMemoryProperties} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceProtectedMemoryProperties} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceProtectedMemoryProperties where unsafeAddr (VkPhysicalDeviceProtectedMemoryProperties## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceProtectedMemoryProperties## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceProtectedMemoryProperties## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceProtectedMemoryProperties where type StructFields VkPhysicalDeviceProtectedMemoryProperties = '["sType", "pNext", "protectedNoFault"] -- ' closing tick for hsc2hs type CUnionType VkPhysicalDeviceProtectedMemoryProperties = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceProtectedMemoryProperties = 'False -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceProtectedMemoryProperties = '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceProtectedMemoryProperties where type FieldType "sType" VkPhysicalDeviceProtectedMemoryProperties = VkStructureType type FieldOptional "sType" VkPhysicalDeviceProtectedMemoryProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceProtectedMemoryProperties = #{offset VkPhysicalDeviceProtectedMemoryProperties, sType} type FieldIsArray "sType" VkPhysicalDeviceProtectedMemoryProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceProtectedMemoryProperties, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceProtectedMemoryProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceProtectedMemoryProperties, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceProtectedMemoryProperties, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceProtectedMemoryProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceProtectedMemoryProperties, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceProtectedMemoryProperties where type FieldType "pNext" VkPhysicalDeviceProtectedMemoryProperties = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceProtectedMemoryProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceProtectedMemoryProperties = #{offset VkPhysicalDeviceProtectedMemoryProperties, pNext} type FieldIsArray "pNext" VkPhysicalDeviceProtectedMemoryProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceProtectedMemoryProperties, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceProtectedMemoryProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceProtectedMemoryProperties, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceProtectedMemoryProperties, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceProtectedMemoryProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceProtectedMemoryProperties, pNext} instance {-# OVERLAPPING #-} HasField "protectedNoFault" VkPhysicalDeviceProtectedMemoryProperties where type FieldType "protectedNoFault" VkPhysicalDeviceProtectedMemoryProperties = VkBool32 type FieldOptional "protectedNoFault" VkPhysicalDeviceProtectedMemoryProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "protectedNoFault" VkPhysicalDeviceProtectedMemoryProperties = #{offset VkPhysicalDeviceProtectedMemoryProperties, protectedNoFault} type FieldIsArray "protectedNoFault" VkPhysicalDeviceProtectedMemoryProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceProtectedMemoryProperties, protectedNoFault} instance {-# OVERLAPPING #-} CanReadField "protectedNoFault" VkPhysicalDeviceProtectedMemoryProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceProtectedMemoryProperties, protectedNoFault}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceProtectedMemoryProperties, protectedNoFault} instance {-# OVERLAPPING #-} CanWriteField "protectedNoFault" VkPhysicalDeviceProtectedMemoryProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceProtectedMemoryProperties, protectedNoFault} instance Show VkPhysicalDeviceProtectedMemoryProperties where showsPrec d x = showString "VkPhysicalDeviceProtectedMemoryProperties {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "protectedNoFault = " . showsPrec d (getField @"protectedNoFault" x) . showChar '}' -- | > typedef struct VkPhysicalDevicePushDescriptorPropertiesKHR { -- > VkStructureType sType; -- > void* pNext; -- > uint32_t maxPushDescriptors; -- > } VkPhysicalDevicePushDescriptorPropertiesKHR; -- -- data VkPhysicalDevicePushDescriptorPropertiesKHR = VkPhysicalDevicePushDescriptorPropertiesKHR## Addr## ByteArray## instance Eq VkPhysicalDevicePushDescriptorPropertiesKHR where (VkPhysicalDevicePushDescriptorPropertiesKHR## a _) == x@(VkPhysicalDevicePushDescriptorPropertiesKHR## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDevicePushDescriptorPropertiesKHR where (VkPhysicalDevicePushDescriptorPropertiesKHR## a _) `compare` x@(VkPhysicalDevicePushDescriptorPropertiesKHR## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDevicePushDescriptorPropertiesKHR where sizeOf ~_ = #{size VkPhysicalDevicePushDescriptorPropertiesKHR} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDevicePushDescriptorPropertiesKHR} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDevicePushDescriptorPropertiesKHR where unsafeAddr (VkPhysicalDevicePushDescriptorPropertiesKHR## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDevicePushDescriptorPropertiesKHR## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDevicePushDescriptorPropertiesKHR## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDevicePushDescriptorPropertiesKHR where type StructFields VkPhysicalDevicePushDescriptorPropertiesKHR = '["sType", "pNext", "maxPushDescriptors"] -- ' closing tick for hsc2hs type CUnionType VkPhysicalDevicePushDescriptorPropertiesKHR = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDevicePushDescriptorPropertiesKHR = 'False -- ' closing tick for hsc2hs type StructExtends VkPhysicalDevicePushDescriptorPropertiesKHR = '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDevicePushDescriptorPropertiesKHR where type FieldType "sType" VkPhysicalDevicePushDescriptorPropertiesKHR = VkStructureType type FieldOptional "sType" VkPhysicalDevicePushDescriptorPropertiesKHR = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDevicePushDescriptorPropertiesKHR = #{offset VkPhysicalDevicePushDescriptorPropertiesKHR, sType} type FieldIsArray "sType" VkPhysicalDevicePushDescriptorPropertiesKHR = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDevicePushDescriptorPropertiesKHR, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDevicePushDescriptorPropertiesKHR where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDevicePushDescriptorPropertiesKHR, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDevicePushDescriptorPropertiesKHR, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDevicePushDescriptorPropertiesKHR where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDevicePushDescriptorPropertiesKHR, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDevicePushDescriptorPropertiesKHR where type FieldType "pNext" VkPhysicalDevicePushDescriptorPropertiesKHR = Ptr Void type FieldOptional "pNext" VkPhysicalDevicePushDescriptorPropertiesKHR = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDevicePushDescriptorPropertiesKHR = #{offset VkPhysicalDevicePushDescriptorPropertiesKHR, pNext} type FieldIsArray "pNext" VkPhysicalDevicePushDescriptorPropertiesKHR = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDevicePushDescriptorPropertiesKHR, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDevicePushDescriptorPropertiesKHR where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDevicePushDescriptorPropertiesKHR, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDevicePushDescriptorPropertiesKHR, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDevicePushDescriptorPropertiesKHR where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDevicePushDescriptorPropertiesKHR, pNext} instance {-# OVERLAPPING #-} HasField "maxPushDescriptors" VkPhysicalDevicePushDescriptorPropertiesKHR where type FieldType "maxPushDescriptors" VkPhysicalDevicePushDescriptorPropertiesKHR = Word32 type FieldOptional "maxPushDescriptors" VkPhysicalDevicePushDescriptorPropertiesKHR = 'False -- ' closing tick for hsc2hs type FieldOffset "maxPushDescriptors" VkPhysicalDevicePushDescriptorPropertiesKHR = #{offset VkPhysicalDevicePushDescriptorPropertiesKHR, maxPushDescriptors} type FieldIsArray "maxPushDescriptors" VkPhysicalDevicePushDescriptorPropertiesKHR = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDevicePushDescriptorPropertiesKHR, maxPushDescriptors} instance {-# OVERLAPPING #-} CanReadField "maxPushDescriptors" VkPhysicalDevicePushDescriptorPropertiesKHR where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDevicePushDescriptorPropertiesKHR, maxPushDescriptors}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDevicePushDescriptorPropertiesKHR, maxPushDescriptors} instance {-# OVERLAPPING #-} CanWriteField "maxPushDescriptors" VkPhysicalDevicePushDescriptorPropertiesKHR where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDevicePushDescriptorPropertiesKHR, maxPushDescriptors} instance Show VkPhysicalDevicePushDescriptorPropertiesKHR where showsPrec d x = showString "VkPhysicalDevicePushDescriptorPropertiesKHR {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "maxPushDescriptors = " . showsPrec d (getField @"maxPushDescriptors" x) . showChar '}' -- | > typedef struct VkPhysicalDeviceSampleLocationsPropertiesEXT { -- > VkStructureType sType; -- > void* pNext; -- > VkSampleCountFlags sampleLocationSampleCounts; -- > VkExtent2D maxSampleLocationGridSize; -- > float sampleLocationCoordinateRange[2]; -- > uint32_t sampleLocationSubPixelBits; -- > VkBool32 variableSampleLocations; -- > } VkPhysicalDeviceSampleLocationsPropertiesEXT; -- -- data VkPhysicalDeviceSampleLocationsPropertiesEXT = VkPhysicalDeviceSampleLocationsPropertiesEXT## Addr## ByteArray## instance Eq VkPhysicalDeviceSampleLocationsPropertiesEXT where (VkPhysicalDeviceSampleLocationsPropertiesEXT## a _) == x@(VkPhysicalDeviceSampleLocationsPropertiesEXT## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceSampleLocationsPropertiesEXT where (VkPhysicalDeviceSampleLocationsPropertiesEXT## a _) `compare` x@(VkPhysicalDeviceSampleLocationsPropertiesEXT## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceSampleLocationsPropertiesEXT where sizeOf ~_ = #{size VkPhysicalDeviceSampleLocationsPropertiesEXT} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceSampleLocationsPropertiesEXT} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceSampleLocationsPropertiesEXT where unsafeAddr (VkPhysicalDeviceSampleLocationsPropertiesEXT## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceSampleLocationsPropertiesEXT## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceSampleLocationsPropertiesEXT## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceSampleLocationsPropertiesEXT where type StructFields VkPhysicalDeviceSampleLocationsPropertiesEXT = '["sType", "pNext", "sampleLocationSampleCounts", -- ' closing tick for hsc2hs "maxSampleLocationGridSize", "sampleLocationCoordinateRange", "sampleLocationSubPixelBits", "variableSampleLocations"] type CUnionType VkPhysicalDeviceSampleLocationsPropertiesEXT = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceSampleLocationsPropertiesEXT = 'True -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceSampleLocationsPropertiesEXT = '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceSampleLocationsPropertiesEXT where type FieldType "sType" VkPhysicalDeviceSampleLocationsPropertiesEXT = VkStructureType type FieldOptional "sType" VkPhysicalDeviceSampleLocationsPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceSampleLocationsPropertiesEXT = #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, sType} type FieldIsArray "sType" VkPhysicalDeviceSampleLocationsPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceSampleLocationsPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceSampleLocationsPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceSampleLocationsPropertiesEXT where type FieldType "pNext" VkPhysicalDeviceSampleLocationsPropertiesEXT = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceSampleLocationsPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceSampleLocationsPropertiesEXT = #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, pNext} type FieldIsArray "pNext" VkPhysicalDeviceSampleLocationsPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceSampleLocationsPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceSampleLocationsPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, pNext} instance {-# OVERLAPPING #-} HasField "sampleLocationSampleCounts" VkPhysicalDeviceSampleLocationsPropertiesEXT where type FieldType "sampleLocationSampleCounts" VkPhysicalDeviceSampleLocationsPropertiesEXT = VkSampleCountFlags type FieldOptional "sampleLocationSampleCounts" VkPhysicalDeviceSampleLocationsPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "sampleLocationSampleCounts" VkPhysicalDeviceSampleLocationsPropertiesEXT = #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, sampleLocationSampleCounts} type FieldIsArray "sampleLocationSampleCounts" VkPhysicalDeviceSampleLocationsPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, sampleLocationSampleCounts} instance {-# OVERLAPPING #-} CanReadField "sampleLocationSampleCounts" VkPhysicalDeviceSampleLocationsPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, sampleLocationSampleCounts}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, sampleLocationSampleCounts} instance {-# OVERLAPPING #-} CanWriteField "sampleLocationSampleCounts" VkPhysicalDeviceSampleLocationsPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, sampleLocationSampleCounts} instance {-# OVERLAPPING #-} HasField "maxSampleLocationGridSize" VkPhysicalDeviceSampleLocationsPropertiesEXT where type FieldType "maxSampleLocationGridSize" VkPhysicalDeviceSampleLocationsPropertiesEXT = VkExtent2D type FieldOptional "maxSampleLocationGridSize" VkPhysicalDeviceSampleLocationsPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "maxSampleLocationGridSize" VkPhysicalDeviceSampleLocationsPropertiesEXT = #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, maxSampleLocationGridSize} type FieldIsArray "maxSampleLocationGridSize" VkPhysicalDeviceSampleLocationsPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, maxSampleLocationGridSize} instance {-# OVERLAPPING #-} CanReadField "maxSampleLocationGridSize" VkPhysicalDeviceSampleLocationsPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, maxSampleLocationGridSize}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, maxSampleLocationGridSize} instance {-# OVERLAPPING #-} CanWriteField "maxSampleLocationGridSize" VkPhysicalDeviceSampleLocationsPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, maxSampleLocationGridSize} instance {-# OVERLAPPING #-} HasField "sampleLocationCoordinateRange" VkPhysicalDeviceSampleLocationsPropertiesEXT where type FieldType "sampleLocationCoordinateRange" VkPhysicalDeviceSampleLocationsPropertiesEXT = #{type float} type FieldOptional "sampleLocationCoordinateRange" VkPhysicalDeviceSampleLocationsPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "sampleLocationCoordinateRange" VkPhysicalDeviceSampleLocationsPropertiesEXT = #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, sampleLocationCoordinateRange} type FieldIsArray "sampleLocationCoordinateRange" VkPhysicalDeviceSampleLocationsPropertiesEXT = 'True -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, sampleLocationCoordinateRange} instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "sampleLocationCoordinateRange" idx VkPhysicalDeviceSampleLocationsPropertiesEXT) => CanReadFieldArray "sampleLocationCoordinateRange" idx VkPhysicalDeviceSampleLocationsPropertiesEXT where {-# SPECIALISE instance CanReadFieldArray "sampleLocationCoordinateRange" 0 VkPhysicalDeviceSampleLocationsPropertiesEXT #-} {-# SPECIALISE instance CanReadFieldArray "sampleLocationCoordinateRange" 1 VkPhysicalDeviceSampleLocationsPropertiesEXT #-} type FieldArrayLength "sampleLocationCoordinateRange" VkPhysicalDeviceSampleLocationsPropertiesEXT = 2 {-# INLINE fieldArrayLength #-} fieldArrayLength = 2 {-# INLINE getFieldArray #-} getFieldArray = f where {-# NOINLINE f #-} f x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) off) off = #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, sampleLocationCoordinateRange} + sizeOf (undefined :: #{type float}) * fromInteger (natVal' (proxy## :: Proxy## idx)) -- ' closing tick for hsc2hs {-# INLINE readFieldArray #-} readFieldArray p = peekByteOff p (#{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, sampleLocationCoordinateRange} + sizeOf (undefined :: #{type float}) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} (KnownNat idx, IndexInBounds "sampleLocationCoordinateRange" idx VkPhysicalDeviceSampleLocationsPropertiesEXT) => CanWriteFieldArray "sampleLocationCoordinateRange" idx VkPhysicalDeviceSampleLocationsPropertiesEXT where {-# SPECIALISE instance CanWriteFieldArray "sampleLocationCoordinateRange" 0 VkPhysicalDeviceSampleLocationsPropertiesEXT #-} {-# SPECIALISE instance CanWriteFieldArray "sampleLocationCoordinateRange" 1 VkPhysicalDeviceSampleLocationsPropertiesEXT #-} {-# INLINE writeFieldArray #-} writeFieldArray p = pokeByteOff p (#{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, sampleLocationCoordinateRange} + sizeOf (undefined :: #{type float}) * fromInteger (natVal' (proxy## :: Proxy## idx))) -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sampleLocationSubPixelBits" VkPhysicalDeviceSampleLocationsPropertiesEXT where type FieldType "sampleLocationSubPixelBits" VkPhysicalDeviceSampleLocationsPropertiesEXT = Word32 type FieldOptional "sampleLocationSubPixelBits" VkPhysicalDeviceSampleLocationsPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "sampleLocationSubPixelBits" VkPhysicalDeviceSampleLocationsPropertiesEXT = #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, sampleLocationSubPixelBits} type FieldIsArray "sampleLocationSubPixelBits" VkPhysicalDeviceSampleLocationsPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, sampleLocationSubPixelBits} instance {-# OVERLAPPING #-} CanReadField "sampleLocationSubPixelBits" VkPhysicalDeviceSampleLocationsPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, sampleLocationSubPixelBits}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, sampleLocationSubPixelBits} instance {-# OVERLAPPING #-} CanWriteField "sampleLocationSubPixelBits" VkPhysicalDeviceSampleLocationsPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, sampleLocationSubPixelBits} instance {-# OVERLAPPING #-} HasField "variableSampleLocations" VkPhysicalDeviceSampleLocationsPropertiesEXT where type FieldType "variableSampleLocations" VkPhysicalDeviceSampleLocationsPropertiesEXT = VkBool32 type FieldOptional "variableSampleLocations" VkPhysicalDeviceSampleLocationsPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "variableSampleLocations" VkPhysicalDeviceSampleLocationsPropertiesEXT = #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, variableSampleLocations} type FieldIsArray "variableSampleLocations" VkPhysicalDeviceSampleLocationsPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, variableSampleLocations} instance {-# OVERLAPPING #-} CanReadField "variableSampleLocations" VkPhysicalDeviceSampleLocationsPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, variableSampleLocations}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, variableSampleLocations} instance {-# OVERLAPPING #-} CanWriteField "variableSampleLocations" VkPhysicalDeviceSampleLocationsPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSampleLocationsPropertiesEXT, variableSampleLocations} instance Show VkPhysicalDeviceSampleLocationsPropertiesEXT where showsPrec d x = showString "VkPhysicalDeviceSampleLocationsPropertiesEXT {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "sampleLocationSampleCounts = " . showsPrec d (getField @"sampleLocationSampleCounts" x) . showString ", " . showString "maxSampleLocationGridSize = " . showsPrec d (getField @"maxSampleLocationGridSize" x) . showString ", " . (showString "sampleLocationCoordinateRange = [" . showsPrec d (let s = sizeOf (undefined :: FieldType "sampleLocationCoordinateRange" VkPhysicalDeviceSampleLocationsPropertiesEXT) o = fieldOffset @"sampleLocationCoordinateRange" @VkPhysicalDeviceSampleLocationsPropertiesEXT f i = peekByteOff (unsafePtr x) i :: IO (FieldType "sampleLocationCoordinateRange" VkPhysicalDeviceSampleLocationsPropertiesEXT) in unsafeDupablePerformIO . mapM f $ map (\ i -> o + i * s) [0 .. 2 - 1]) . showChar ']') . showString ", " . showString "sampleLocationSubPixelBits = " . showsPrec d (getField @"sampleLocationSubPixelBits" x) . showString ", " . showString "variableSampleLocations = " . showsPrec d (getField @"variableSampleLocations" x) . showChar '}' -- | > typedef struct VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT { -- > VkStructureType sType; -- > void* pNext; -- > VkBool32 filterMinmaxSingleComponentFormats; -- > VkBool32 filterMinmaxImageComponentMapping; -- > } VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT; -- -- data VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT = VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT## Addr## ByteArray## instance Eq VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT where (VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT## a _) == x@(VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT where (VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT## a _) `compare` x@(VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT where sizeOf ~_ = #{size VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT where unsafeAddr (VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT where type StructFields VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT = '["sType", "pNext", "filterMinmaxSingleComponentFormats", -- ' closing tick for hsc2hs "filterMinmaxImageComponentMapping"] type CUnionType VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT = 'True -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT = '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT where type FieldType "sType" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT = VkStructureType type FieldOptional "sType" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT = #{offset VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT, sType} type FieldIsArray "sType" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT where type FieldType "pNext" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT = #{offset VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT, pNext} type FieldIsArray "pNext" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT, pNext} instance {-# OVERLAPPING #-} HasField "filterMinmaxSingleComponentFormats" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT where type FieldType "filterMinmaxSingleComponentFormats" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT = VkBool32 type FieldOptional "filterMinmaxSingleComponentFormats" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "filterMinmaxSingleComponentFormats" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT = #{offset VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT, filterMinmaxSingleComponentFormats} type FieldIsArray "filterMinmaxSingleComponentFormats" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT, filterMinmaxSingleComponentFormats} instance {-# OVERLAPPING #-} CanReadField "filterMinmaxSingleComponentFormats" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT, filterMinmaxSingleComponentFormats}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT, filterMinmaxSingleComponentFormats} instance {-# OVERLAPPING #-} CanWriteField "filterMinmaxSingleComponentFormats" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT, filterMinmaxSingleComponentFormats} instance {-# OVERLAPPING #-} HasField "filterMinmaxImageComponentMapping" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT where type FieldType "filterMinmaxImageComponentMapping" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT = VkBool32 type FieldOptional "filterMinmaxImageComponentMapping" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "filterMinmaxImageComponentMapping" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT = #{offset VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT, filterMinmaxImageComponentMapping} type FieldIsArray "filterMinmaxImageComponentMapping" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT, filterMinmaxImageComponentMapping} instance {-# OVERLAPPING #-} CanReadField "filterMinmaxImageComponentMapping" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT, filterMinmaxImageComponentMapping}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT, filterMinmaxImageComponentMapping} instance {-# OVERLAPPING #-} CanWriteField "filterMinmaxImageComponentMapping" VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT, filterMinmaxImageComponentMapping} instance Show VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT where showsPrec d x = showString "VkPhysicalDeviceSamplerFilterMinmaxPropertiesEXT {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "filterMinmaxSingleComponentFormats = " . showsPrec d (getField @"filterMinmaxSingleComponentFormats" x) . showString ", " . showString "filterMinmaxImageComponentMapping = " . showsPrec d (getField @"filterMinmaxImageComponentMapping" x) . showChar '}' -- | > typedef struct VkPhysicalDeviceSamplerYcbcrConversionFeatures { -- > VkStructureType sType; -- > void* pNext; -- > VkBool32 samplerYcbcrConversion; -- > } VkPhysicalDeviceSamplerYcbcrConversionFeatures; -- -- data VkPhysicalDeviceSamplerYcbcrConversionFeatures = VkPhysicalDeviceSamplerYcbcrConversionFeatures## Addr## ByteArray## instance Eq VkPhysicalDeviceSamplerYcbcrConversionFeatures where (VkPhysicalDeviceSamplerYcbcrConversionFeatures## a _) == x@(VkPhysicalDeviceSamplerYcbcrConversionFeatures## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceSamplerYcbcrConversionFeatures where (VkPhysicalDeviceSamplerYcbcrConversionFeatures## a _) `compare` x@(VkPhysicalDeviceSamplerYcbcrConversionFeatures## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceSamplerYcbcrConversionFeatures where sizeOf ~_ = #{size VkPhysicalDeviceSamplerYcbcrConversionFeatures} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceSamplerYcbcrConversionFeatures} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceSamplerYcbcrConversionFeatures where unsafeAddr (VkPhysicalDeviceSamplerYcbcrConversionFeatures## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceSamplerYcbcrConversionFeatures## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceSamplerYcbcrConversionFeatures## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceSamplerYcbcrConversionFeatures where type StructFields VkPhysicalDeviceSamplerYcbcrConversionFeatures = '["sType", "pNext", "samplerYcbcrConversion"] -- ' closing tick for hsc2hs type CUnionType VkPhysicalDeviceSamplerYcbcrConversionFeatures = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceSamplerYcbcrConversionFeatures = 'False -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceSamplerYcbcrConversionFeatures = '[VkPhysicalDeviceFeatures2, VkDeviceCreateInfo] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceSamplerYcbcrConversionFeatures where type FieldType "sType" VkPhysicalDeviceSamplerYcbcrConversionFeatures = VkStructureType type FieldOptional "sType" VkPhysicalDeviceSamplerYcbcrConversionFeatures = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceSamplerYcbcrConversionFeatures = #{offset VkPhysicalDeviceSamplerYcbcrConversionFeatures, sType} type FieldIsArray "sType" VkPhysicalDeviceSamplerYcbcrConversionFeatures = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSamplerYcbcrConversionFeatures, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceSamplerYcbcrConversionFeatures where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSamplerYcbcrConversionFeatures, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSamplerYcbcrConversionFeatures, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceSamplerYcbcrConversionFeatures where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSamplerYcbcrConversionFeatures, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceSamplerYcbcrConversionFeatures where type FieldType "pNext" VkPhysicalDeviceSamplerYcbcrConversionFeatures = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceSamplerYcbcrConversionFeatures = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceSamplerYcbcrConversionFeatures = #{offset VkPhysicalDeviceSamplerYcbcrConversionFeatures, pNext} type FieldIsArray "pNext" VkPhysicalDeviceSamplerYcbcrConversionFeatures = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSamplerYcbcrConversionFeatures, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceSamplerYcbcrConversionFeatures where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSamplerYcbcrConversionFeatures, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSamplerYcbcrConversionFeatures, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceSamplerYcbcrConversionFeatures where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSamplerYcbcrConversionFeatures, pNext} instance {-# OVERLAPPING #-} HasField "samplerYcbcrConversion" VkPhysicalDeviceSamplerYcbcrConversionFeatures where type FieldType "samplerYcbcrConversion" VkPhysicalDeviceSamplerYcbcrConversionFeatures = VkBool32 type FieldOptional "samplerYcbcrConversion" VkPhysicalDeviceSamplerYcbcrConversionFeatures = 'False -- ' closing tick for hsc2hs type FieldOffset "samplerYcbcrConversion" VkPhysicalDeviceSamplerYcbcrConversionFeatures = #{offset VkPhysicalDeviceSamplerYcbcrConversionFeatures, samplerYcbcrConversion} type FieldIsArray "samplerYcbcrConversion" VkPhysicalDeviceSamplerYcbcrConversionFeatures = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSamplerYcbcrConversionFeatures, samplerYcbcrConversion} instance {-# OVERLAPPING #-} CanReadField "samplerYcbcrConversion" VkPhysicalDeviceSamplerYcbcrConversionFeatures where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSamplerYcbcrConversionFeatures, samplerYcbcrConversion}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSamplerYcbcrConversionFeatures, samplerYcbcrConversion} instance {-# OVERLAPPING #-} CanWriteField "samplerYcbcrConversion" VkPhysicalDeviceSamplerYcbcrConversionFeatures where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSamplerYcbcrConversionFeatures, samplerYcbcrConversion} instance Show VkPhysicalDeviceSamplerYcbcrConversionFeatures where showsPrec d x = showString "VkPhysicalDeviceSamplerYcbcrConversionFeatures {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "samplerYcbcrConversion = " . showsPrec d (getField @"samplerYcbcrConversion" x) . showChar '}' -- | Alias for `VkPhysicalDeviceSamplerYcbcrConversionFeatures` type VkPhysicalDeviceSamplerYcbcrConversionFeaturesKHR = VkPhysicalDeviceSamplerYcbcrConversionFeatures -- | > typedef struct VkPhysicalDeviceShaderCorePropertiesAMD { -- > VkStructureType sType; -- > void* pNext; -- > uint32_t shaderEngineCount; -- > uint32_t shaderArraysPerEngineCount; -- > uint32_t computeUnitsPerShaderArray; -- > uint32_t simdPerComputeUnit; -- > uint32_t wavefrontsPerSimd; -- > uint32_t wavefrontSize; -- > uint32_t sgprsPerSimd; -- > uint32_t minSgprAllocation; -- > uint32_t maxSgprAllocation; -- > uint32_t sgprAllocationGranularity; -- > uint32_t vgprsPerSimd; -- > uint32_t minVgprAllocation; -- > uint32_t maxVgprAllocation; -- > uint32_t vgprAllocationGranularity; -- > } VkPhysicalDeviceShaderCorePropertiesAMD; -- -- data VkPhysicalDeviceShaderCorePropertiesAMD = VkPhysicalDeviceShaderCorePropertiesAMD## Addr## ByteArray## instance Eq VkPhysicalDeviceShaderCorePropertiesAMD where (VkPhysicalDeviceShaderCorePropertiesAMD## a _) == x@(VkPhysicalDeviceShaderCorePropertiesAMD## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceShaderCorePropertiesAMD where (VkPhysicalDeviceShaderCorePropertiesAMD## a _) `compare` x@(VkPhysicalDeviceShaderCorePropertiesAMD## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceShaderCorePropertiesAMD where sizeOf ~_ = #{size VkPhysicalDeviceShaderCorePropertiesAMD} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceShaderCorePropertiesAMD} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceShaderCorePropertiesAMD where unsafeAddr (VkPhysicalDeviceShaderCorePropertiesAMD## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceShaderCorePropertiesAMD## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceShaderCorePropertiesAMD## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceShaderCorePropertiesAMD where type StructFields VkPhysicalDeviceShaderCorePropertiesAMD = '["sType", "pNext", "shaderEngineCount", -- ' closing tick for hsc2hs "shaderArraysPerEngineCount", "computeUnitsPerShaderArray", "simdPerComputeUnit", "wavefrontsPerSimd", "wavefrontSize", "sgprsPerSimd", "minSgprAllocation", "maxSgprAllocation", "sgprAllocationGranularity", "vgprsPerSimd", "minVgprAllocation", "maxVgprAllocation", "vgprAllocationGranularity"] type CUnionType VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceShaderCorePropertiesAMD = 'True -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceShaderCorePropertiesAMD = '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceShaderCorePropertiesAMD where type FieldType "sType" VkPhysicalDeviceShaderCorePropertiesAMD = VkStructureType type FieldOptional "sType" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceShaderCorePropertiesAMD = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, sType} type FieldIsArray "sType" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceShaderCorePropertiesAMD where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceShaderCorePropertiesAMD, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceShaderCorePropertiesAMD where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceShaderCorePropertiesAMD where type FieldType "pNext" VkPhysicalDeviceShaderCorePropertiesAMD = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceShaderCorePropertiesAMD = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, pNext} type FieldIsArray "pNext" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceShaderCorePropertiesAMD where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceShaderCorePropertiesAMD, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceShaderCorePropertiesAMD where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, pNext} instance {-# OVERLAPPING #-} HasField "shaderEngineCount" VkPhysicalDeviceShaderCorePropertiesAMD where type FieldType "shaderEngineCount" VkPhysicalDeviceShaderCorePropertiesAMD = Word32 type FieldOptional "shaderEngineCount" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs type FieldOffset "shaderEngineCount" VkPhysicalDeviceShaderCorePropertiesAMD = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, shaderEngineCount} type FieldIsArray "shaderEngineCount" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, shaderEngineCount} instance {-# OVERLAPPING #-} CanReadField "shaderEngineCount" VkPhysicalDeviceShaderCorePropertiesAMD where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceShaderCorePropertiesAMD, shaderEngineCount}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, shaderEngineCount} instance {-# OVERLAPPING #-} CanWriteField "shaderEngineCount" VkPhysicalDeviceShaderCorePropertiesAMD where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, shaderEngineCount} instance {-# OVERLAPPING #-} HasField "shaderArraysPerEngineCount" VkPhysicalDeviceShaderCorePropertiesAMD where type FieldType "shaderArraysPerEngineCount" VkPhysicalDeviceShaderCorePropertiesAMD = Word32 type FieldOptional "shaderArraysPerEngineCount" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs type FieldOffset "shaderArraysPerEngineCount" VkPhysicalDeviceShaderCorePropertiesAMD = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, shaderArraysPerEngineCount} type FieldIsArray "shaderArraysPerEngineCount" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, shaderArraysPerEngineCount} instance {-# OVERLAPPING #-} CanReadField "shaderArraysPerEngineCount" VkPhysicalDeviceShaderCorePropertiesAMD where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceShaderCorePropertiesAMD, shaderArraysPerEngineCount}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, shaderArraysPerEngineCount} instance {-# OVERLAPPING #-} CanWriteField "shaderArraysPerEngineCount" VkPhysicalDeviceShaderCorePropertiesAMD where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, shaderArraysPerEngineCount} instance {-# OVERLAPPING #-} HasField "computeUnitsPerShaderArray" VkPhysicalDeviceShaderCorePropertiesAMD where type FieldType "computeUnitsPerShaderArray" VkPhysicalDeviceShaderCorePropertiesAMD = Word32 type FieldOptional "computeUnitsPerShaderArray" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs type FieldOffset "computeUnitsPerShaderArray" VkPhysicalDeviceShaderCorePropertiesAMD = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, computeUnitsPerShaderArray} type FieldIsArray "computeUnitsPerShaderArray" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, computeUnitsPerShaderArray} instance {-# OVERLAPPING #-} CanReadField "computeUnitsPerShaderArray" VkPhysicalDeviceShaderCorePropertiesAMD where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceShaderCorePropertiesAMD, computeUnitsPerShaderArray}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, computeUnitsPerShaderArray} instance {-# OVERLAPPING #-} CanWriteField "computeUnitsPerShaderArray" VkPhysicalDeviceShaderCorePropertiesAMD where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, computeUnitsPerShaderArray} instance {-# OVERLAPPING #-} HasField "simdPerComputeUnit" VkPhysicalDeviceShaderCorePropertiesAMD where type FieldType "simdPerComputeUnit" VkPhysicalDeviceShaderCorePropertiesAMD = Word32 type FieldOptional "simdPerComputeUnit" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs type FieldOffset "simdPerComputeUnit" VkPhysicalDeviceShaderCorePropertiesAMD = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, simdPerComputeUnit} type FieldIsArray "simdPerComputeUnit" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, simdPerComputeUnit} instance {-# OVERLAPPING #-} CanReadField "simdPerComputeUnit" VkPhysicalDeviceShaderCorePropertiesAMD where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceShaderCorePropertiesAMD, simdPerComputeUnit}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, simdPerComputeUnit} instance {-# OVERLAPPING #-} CanWriteField "simdPerComputeUnit" VkPhysicalDeviceShaderCorePropertiesAMD where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, simdPerComputeUnit} instance {-# OVERLAPPING #-} HasField "wavefrontsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD where type FieldType "wavefrontsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD = Word32 type FieldOptional "wavefrontsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs type FieldOffset "wavefrontsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, wavefrontsPerSimd} type FieldIsArray "wavefrontsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, wavefrontsPerSimd} instance {-# OVERLAPPING #-} CanReadField "wavefrontsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceShaderCorePropertiesAMD, wavefrontsPerSimd}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, wavefrontsPerSimd} instance {-# OVERLAPPING #-} CanWriteField "wavefrontsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, wavefrontsPerSimd} instance {-# OVERLAPPING #-} HasField "wavefrontSize" VkPhysicalDeviceShaderCorePropertiesAMD where type FieldType "wavefrontSize" VkPhysicalDeviceShaderCorePropertiesAMD = Word32 type FieldOptional "wavefrontSize" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs type FieldOffset "wavefrontSize" VkPhysicalDeviceShaderCorePropertiesAMD = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, wavefrontSize} type FieldIsArray "wavefrontSize" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, wavefrontSize} instance {-# OVERLAPPING #-} CanReadField "wavefrontSize" VkPhysicalDeviceShaderCorePropertiesAMD where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceShaderCorePropertiesAMD, wavefrontSize}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, wavefrontSize} instance {-# OVERLAPPING #-} CanWriteField "wavefrontSize" VkPhysicalDeviceShaderCorePropertiesAMD where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, wavefrontSize} instance {-# OVERLAPPING #-} HasField "sgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD where type FieldType "sgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD = Word32 type FieldOptional "sgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs type FieldOffset "sgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, sgprsPerSimd} type FieldIsArray "sgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, sgprsPerSimd} instance {-# OVERLAPPING #-} CanReadField "sgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceShaderCorePropertiesAMD, sgprsPerSimd}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, sgprsPerSimd} instance {-# OVERLAPPING #-} CanWriteField "sgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, sgprsPerSimd} instance {-# OVERLAPPING #-} HasField "minSgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD where type FieldType "minSgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD = Word32 type FieldOptional "minSgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs type FieldOffset "minSgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, minSgprAllocation} type FieldIsArray "minSgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, minSgprAllocation} instance {-# OVERLAPPING #-} CanReadField "minSgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceShaderCorePropertiesAMD, minSgprAllocation}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, minSgprAllocation} instance {-# OVERLAPPING #-} CanWriteField "minSgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, minSgprAllocation} instance {-# OVERLAPPING #-} HasField "maxSgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD where type FieldType "maxSgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD = Word32 type FieldOptional "maxSgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs type FieldOffset "maxSgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, maxSgprAllocation} type FieldIsArray "maxSgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, maxSgprAllocation} instance {-# OVERLAPPING #-} CanReadField "maxSgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceShaderCorePropertiesAMD, maxSgprAllocation}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, maxSgprAllocation} instance {-# OVERLAPPING #-} CanWriteField "maxSgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, maxSgprAllocation} instance {-# OVERLAPPING #-} HasField "sgprAllocationGranularity" VkPhysicalDeviceShaderCorePropertiesAMD where type FieldType "sgprAllocationGranularity" VkPhysicalDeviceShaderCorePropertiesAMD = Word32 type FieldOptional "sgprAllocationGranularity" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs type FieldOffset "sgprAllocationGranularity" VkPhysicalDeviceShaderCorePropertiesAMD = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, sgprAllocationGranularity} type FieldIsArray "sgprAllocationGranularity" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, sgprAllocationGranularity} instance {-# OVERLAPPING #-} CanReadField "sgprAllocationGranularity" VkPhysicalDeviceShaderCorePropertiesAMD where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceShaderCorePropertiesAMD, sgprAllocationGranularity}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, sgprAllocationGranularity} instance {-# OVERLAPPING #-} CanWriteField "sgprAllocationGranularity" VkPhysicalDeviceShaderCorePropertiesAMD where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, sgprAllocationGranularity} instance {-# OVERLAPPING #-} HasField "vgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD where type FieldType "vgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD = Word32 type FieldOptional "vgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs type FieldOffset "vgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, vgprsPerSimd} type FieldIsArray "vgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, vgprsPerSimd} instance {-# OVERLAPPING #-} CanReadField "vgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceShaderCorePropertiesAMD, vgprsPerSimd}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, vgprsPerSimd} instance {-# OVERLAPPING #-} CanWriteField "vgprsPerSimd" VkPhysicalDeviceShaderCorePropertiesAMD where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, vgprsPerSimd} instance {-# OVERLAPPING #-} HasField "minVgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD where type FieldType "minVgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD = Word32 type FieldOptional "minVgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs type FieldOffset "minVgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, minVgprAllocation} type FieldIsArray "minVgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, minVgprAllocation} instance {-# OVERLAPPING #-} CanReadField "minVgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceShaderCorePropertiesAMD, minVgprAllocation}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, minVgprAllocation} instance {-# OVERLAPPING #-} CanWriteField "minVgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, minVgprAllocation} instance {-# OVERLAPPING #-} HasField "maxVgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD where type FieldType "maxVgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD = Word32 type FieldOptional "maxVgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs type FieldOffset "maxVgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, maxVgprAllocation} type FieldIsArray "maxVgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, maxVgprAllocation} instance {-# OVERLAPPING #-} CanReadField "maxVgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceShaderCorePropertiesAMD, maxVgprAllocation}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, maxVgprAllocation} instance {-# OVERLAPPING #-} CanWriteField "maxVgprAllocation" VkPhysicalDeviceShaderCorePropertiesAMD where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, maxVgprAllocation} instance {-# OVERLAPPING #-} HasField "vgprAllocationGranularity" VkPhysicalDeviceShaderCorePropertiesAMD where type FieldType "vgprAllocationGranularity" VkPhysicalDeviceShaderCorePropertiesAMD = Word32 type FieldOptional "vgprAllocationGranularity" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs type FieldOffset "vgprAllocationGranularity" VkPhysicalDeviceShaderCorePropertiesAMD = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, vgprAllocationGranularity} type FieldIsArray "vgprAllocationGranularity" VkPhysicalDeviceShaderCorePropertiesAMD = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceShaderCorePropertiesAMD, vgprAllocationGranularity} instance {-# OVERLAPPING #-} CanReadField "vgprAllocationGranularity" VkPhysicalDeviceShaderCorePropertiesAMD where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceShaderCorePropertiesAMD, vgprAllocationGranularity}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, vgprAllocationGranularity} instance {-# OVERLAPPING #-} CanWriteField "vgprAllocationGranularity" VkPhysicalDeviceShaderCorePropertiesAMD where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceShaderCorePropertiesAMD, vgprAllocationGranularity} instance Show VkPhysicalDeviceShaderCorePropertiesAMD where showsPrec d x = showString "VkPhysicalDeviceShaderCorePropertiesAMD {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "shaderEngineCount = " . showsPrec d (getField @"shaderEngineCount" x) . showString ", " . showString "shaderArraysPerEngineCount = " . showsPrec d (getField @"shaderArraysPerEngineCount" x) . showString ", " . showString "computeUnitsPerShaderArray = " . showsPrec d (getField @"computeUnitsPerShaderArray" x) . showString ", " . showString "simdPerComputeUnit = " . showsPrec d (getField @"simdPerComputeUnit" x) . showString ", " . showString "wavefrontsPerSimd = " . showsPrec d (getField @"wavefrontsPerSimd" x) . showString ", " . showString "wavefrontSize = " . showsPrec d (getField @"wavefrontSize" x) . showString ", " . showString "sgprsPerSimd = " . showsPrec d (getField @"sgprsPerSimd" x) . showString ", " . showString "minSgprAllocation = " . showsPrec d (getField @"minSgprAllocation" x) . showString ", " . showString "maxSgprAllocation = " . showsPrec d (getField @"maxSgprAllocation" x) . showString ", " . showString "sgprAllocationGranularity = " . showsPrec d (getField @"sgprAllocationGranularity" x) . showString ", " . showString "vgprsPerSimd = " . showsPrec d (getField @"vgprsPerSimd" x) . showString ", " . showString "minVgprAllocation = " . showsPrec d (getField @"minVgprAllocation" x) . showString ", " . showString "maxVgprAllocation = " . showsPrec d (getField @"maxVgprAllocation" x) . showString ", " . showString "vgprAllocationGranularity = " . showsPrec d (getField @"vgprAllocationGranularity" x) . showChar '}' -- | > typedef struct VkPhysicalDeviceShaderDrawParameterFeatures { -- > VkStructureType sType; -- > void* pNext; -- > VkBool32 shaderDrawParameters; -- > } VkPhysicalDeviceShaderDrawParameterFeatures; -- -- data VkPhysicalDeviceShaderDrawParameterFeatures = VkPhysicalDeviceShaderDrawParameterFeatures## Addr## ByteArray## instance Eq VkPhysicalDeviceShaderDrawParameterFeatures where (VkPhysicalDeviceShaderDrawParameterFeatures## a _) == x@(VkPhysicalDeviceShaderDrawParameterFeatures## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceShaderDrawParameterFeatures where (VkPhysicalDeviceShaderDrawParameterFeatures## a _) `compare` x@(VkPhysicalDeviceShaderDrawParameterFeatures## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceShaderDrawParameterFeatures where sizeOf ~_ = #{size VkPhysicalDeviceShaderDrawParameterFeatures} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceShaderDrawParameterFeatures} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceShaderDrawParameterFeatures where unsafeAddr (VkPhysicalDeviceShaderDrawParameterFeatures## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceShaderDrawParameterFeatures## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceShaderDrawParameterFeatures## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceShaderDrawParameterFeatures where type StructFields VkPhysicalDeviceShaderDrawParameterFeatures = '["sType", "pNext", "shaderDrawParameters"] -- ' closing tick for hsc2hs type CUnionType VkPhysicalDeviceShaderDrawParameterFeatures = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceShaderDrawParameterFeatures = 'False -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceShaderDrawParameterFeatures = '[VkPhysicalDeviceFeatures2] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceShaderDrawParameterFeatures where type FieldType "sType" VkPhysicalDeviceShaderDrawParameterFeatures = VkStructureType type FieldOptional "sType" VkPhysicalDeviceShaderDrawParameterFeatures = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceShaderDrawParameterFeatures = #{offset VkPhysicalDeviceShaderDrawParameterFeatures, sType} type FieldIsArray "sType" VkPhysicalDeviceShaderDrawParameterFeatures = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceShaderDrawParameterFeatures, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceShaderDrawParameterFeatures where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceShaderDrawParameterFeatures, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceShaderDrawParameterFeatures, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceShaderDrawParameterFeatures where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceShaderDrawParameterFeatures, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceShaderDrawParameterFeatures where type FieldType "pNext" VkPhysicalDeviceShaderDrawParameterFeatures = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceShaderDrawParameterFeatures = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceShaderDrawParameterFeatures = #{offset VkPhysicalDeviceShaderDrawParameterFeatures, pNext} type FieldIsArray "pNext" VkPhysicalDeviceShaderDrawParameterFeatures = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceShaderDrawParameterFeatures, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceShaderDrawParameterFeatures where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceShaderDrawParameterFeatures, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceShaderDrawParameterFeatures, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceShaderDrawParameterFeatures where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceShaderDrawParameterFeatures, pNext} instance {-# OVERLAPPING #-} HasField "shaderDrawParameters" VkPhysicalDeviceShaderDrawParameterFeatures where type FieldType "shaderDrawParameters" VkPhysicalDeviceShaderDrawParameterFeatures = VkBool32 type FieldOptional "shaderDrawParameters" VkPhysicalDeviceShaderDrawParameterFeatures = 'False -- ' closing tick for hsc2hs type FieldOffset "shaderDrawParameters" VkPhysicalDeviceShaderDrawParameterFeatures = #{offset VkPhysicalDeviceShaderDrawParameterFeatures, shaderDrawParameters} type FieldIsArray "shaderDrawParameters" VkPhysicalDeviceShaderDrawParameterFeatures = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceShaderDrawParameterFeatures, shaderDrawParameters} instance {-# OVERLAPPING #-} CanReadField "shaderDrawParameters" VkPhysicalDeviceShaderDrawParameterFeatures where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceShaderDrawParameterFeatures, shaderDrawParameters}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceShaderDrawParameterFeatures, shaderDrawParameters} instance {-# OVERLAPPING #-} CanWriteField "shaderDrawParameters" VkPhysicalDeviceShaderDrawParameterFeatures where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceShaderDrawParameterFeatures, shaderDrawParameters} instance Show VkPhysicalDeviceShaderDrawParameterFeatures where showsPrec d x = showString "VkPhysicalDeviceShaderDrawParameterFeatures {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "shaderDrawParameters = " . showsPrec d (getField @"shaderDrawParameters" x) . showChar '}' -- | > typedef struct VkPhysicalDeviceSparseImageFormatInfo2 { -- > VkStructureType sType; -- > const void* pNext; -- > VkFormat format; -- > VkImageType type; -- > VkSampleCountFlagBits samples; -- > VkImageUsageFlags usage; -- > VkImageTiling tiling; -- > } VkPhysicalDeviceSparseImageFormatInfo2; -- -- data VkPhysicalDeviceSparseImageFormatInfo2 = VkPhysicalDeviceSparseImageFormatInfo2## Addr## ByteArray## instance Eq VkPhysicalDeviceSparseImageFormatInfo2 where (VkPhysicalDeviceSparseImageFormatInfo2## a _) == x@(VkPhysicalDeviceSparseImageFormatInfo2## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceSparseImageFormatInfo2 where (VkPhysicalDeviceSparseImageFormatInfo2## a _) `compare` x@(VkPhysicalDeviceSparseImageFormatInfo2## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceSparseImageFormatInfo2 where sizeOf ~_ = #{size VkPhysicalDeviceSparseImageFormatInfo2} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceSparseImageFormatInfo2} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceSparseImageFormatInfo2 where unsafeAddr (VkPhysicalDeviceSparseImageFormatInfo2## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceSparseImageFormatInfo2## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceSparseImageFormatInfo2## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceSparseImageFormatInfo2 where type StructFields VkPhysicalDeviceSparseImageFormatInfo2 = '["sType", "pNext", "format", "type", "samples", "usage", "tiling"] -- ' closing tick for hsc2hs type CUnionType VkPhysicalDeviceSparseImageFormatInfo2 = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceSparseImageFormatInfo2 = 'False -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceSparseImageFormatInfo2 = '[] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceSparseImageFormatInfo2 where type FieldType "sType" VkPhysicalDeviceSparseImageFormatInfo2 = VkStructureType type FieldOptional "sType" VkPhysicalDeviceSparseImageFormatInfo2 = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceSparseImageFormatInfo2 = #{offset VkPhysicalDeviceSparseImageFormatInfo2, sType} type FieldIsArray "sType" VkPhysicalDeviceSparseImageFormatInfo2 = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSparseImageFormatInfo2, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceSparseImageFormatInfo2 where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSparseImageFormatInfo2, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSparseImageFormatInfo2, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceSparseImageFormatInfo2 where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSparseImageFormatInfo2, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceSparseImageFormatInfo2 where type FieldType "pNext" VkPhysicalDeviceSparseImageFormatInfo2 = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceSparseImageFormatInfo2 = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceSparseImageFormatInfo2 = #{offset VkPhysicalDeviceSparseImageFormatInfo2, pNext} type FieldIsArray "pNext" VkPhysicalDeviceSparseImageFormatInfo2 = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSparseImageFormatInfo2, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceSparseImageFormatInfo2 where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSparseImageFormatInfo2, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSparseImageFormatInfo2, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceSparseImageFormatInfo2 where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSparseImageFormatInfo2, pNext} instance {-# OVERLAPPING #-} HasField "format" VkPhysicalDeviceSparseImageFormatInfo2 where type FieldType "format" VkPhysicalDeviceSparseImageFormatInfo2 = VkFormat type FieldOptional "format" VkPhysicalDeviceSparseImageFormatInfo2 = 'False -- ' closing tick for hsc2hs type FieldOffset "format" VkPhysicalDeviceSparseImageFormatInfo2 = #{offset VkPhysicalDeviceSparseImageFormatInfo2, format} type FieldIsArray "format" VkPhysicalDeviceSparseImageFormatInfo2 = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSparseImageFormatInfo2, format} instance {-# OVERLAPPING #-} CanReadField "format" VkPhysicalDeviceSparseImageFormatInfo2 where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSparseImageFormatInfo2, format}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSparseImageFormatInfo2, format} instance {-# OVERLAPPING #-} CanWriteField "format" VkPhysicalDeviceSparseImageFormatInfo2 where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSparseImageFormatInfo2, format} instance {-# OVERLAPPING #-} HasField "type" VkPhysicalDeviceSparseImageFormatInfo2 where type FieldType "type" VkPhysicalDeviceSparseImageFormatInfo2 = VkImageType type FieldOptional "type" VkPhysicalDeviceSparseImageFormatInfo2 = 'False -- ' closing tick for hsc2hs type FieldOffset "type" VkPhysicalDeviceSparseImageFormatInfo2 = #{offset VkPhysicalDeviceSparseImageFormatInfo2, type} type FieldIsArray "type" VkPhysicalDeviceSparseImageFormatInfo2 = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSparseImageFormatInfo2, type} instance {-# OVERLAPPING #-} CanReadField "type" VkPhysicalDeviceSparseImageFormatInfo2 where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSparseImageFormatInfo2, type}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSparseImageFormatInfo2, type} instance {-# OVERLAPPING #-} CanWriteField "type" VkPhysicalDeviceSparseImageFormatInfo2 where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSparseImageFormatInfo2, type} instance {-# OVERLAPPING #-} HasField "samples" VkPhysicalDeviceSparseImageFormatInfo2 where type FieldType "samples" VkPhysicalDeviceSparseImageFormatInfo2 = VkSampleCountFlagBits type FieldOptional "samples" VkPhysicalDeviceSparseImageFormatInfo2 = 'False -- ' closing tick for hsc2hs type FieldOffset "samples" VkPhysicalDeviceSparseImageFormatInfo2 = #{offset VkPhysicalDeviceSparseImageFormatInfo2, samples} type FieldIsArray "samples" VkPhysicalDeviceSparseImageFormatInfo2 = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSparseImageFormatInfo2, samples} instance {-# OVERLAPPING #-} CanReadField "samples" VkPhysicalDeviceSparseImageFormatInfo2 where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSparseImageFormatInfo2, samples}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSparseImageFormatInfo2, samples} instance {-# OVERLAPPING #-} CanWriteField "samples" VkPhysicalDeviceSparseImageFormatInfo2 where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSparseImageFormatInfo2, samples} instance {-# OVERLAPPING #-} HasField "usage" VkPhysicalDeviceSparseImageFormatInfo2 where type FieldType "usage" VkPhysicalDeviceSparseImageFormatInfo2 = VkImageUsageFlags type FieldOptional "usage" VkPhysicalDeviceSparseImageFormatInfo2 = 'False -- ' closing tick for hsc2hs type FieldOffset "usage" VkPhysicalDeviceSparseImageFormatInfo2 = #{offset VkPhysicalDeviceSparseImageFormatInfo2, usage} type FieldIsArray "usage" VkPhysicalDeviceSparseImageFormatInfo2 = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSparseImageFormatInfo2, usage} instance {-# OVERLAPPING #-} CanReadField "usage" VkPhysicalDeviceSparseImageFormatInfo2 where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSparseImageFormatInfo2, usage}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSparseImageFormatInfo2, usage} instance {-# OVERLAPPING #-} CanWriteField "usage" VkPhysicalDeviceSparseImageFormatInfo2 where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSparseImageFormatInfo2, usage} instance {-# OVERLAPPING #-} HasField "tiling" VkPhysicalDeviceSparseImageFormatInfo2 where type FieldType "tiling" VkPhysicalDeviceSparseImageFormatInfo2 = VkImageTiling type FieldOptional "tiling" VkPhysicalDeviceSparseImageFormatInfo2 = 'False -- ' closing tick for hsc2hs type FieldOffset "tiling" VkPhysicalDeviceSparseImageFormatInfo2 = #{offset VkPhysicalDeviceSparseImageFormatInfo2, tiling} type FieldIsArray "tiling" VkPhysicalDeviceSparseImageFormatInfo2 = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSparseImageFormatInfo2, tiling} instance {-# OVERLAPPING #-} CanReadField "tiling" VkPhysicalDeviceSparseImageFormatInfo2 where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSparseImageFormatInfo2, tiling}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSparseImageFormatInfo2, tiling} instance {-# OVERLAPPING #-} CanWriteField "tiling" VkPhysicalDeviceSparseImageFormatInfo2 where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSparseImageFormatInfo2, tiling} instance Show VkPhysicalDeviceSparseImageFormatInfo2 where showsPrec d x = showString "VkPhysicalDeviceSparseImageFormatInfo2 {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "format = " . showsPrec d (getField @"format" x) . showString ", " . showString "type = " . showsPrec d (getField @"type" x) . showString ", " . showString "samples = " . showsPrec d (getField @"samples" x) . showString ", " . showString "usage = " . showsPrec d (getField @"usage" x) . showString ", " . showString "tiling = " . showsPrec d (getField @"tiling" x) . showChar '}' -- | Alias for `VkPhysicalDeviceSparseImageFormatInfo2` type VkPhysicalDeviceSparseImageFormatInfo2KHR = VkPhysicalDeviceSparseImageFormatInfo2 -- | > typedef struct VkPhysicalDeviceSparseProperties { -- > VkBool32 residencyStandard2DBlockShape; -- > VkBool32 residencyStandard2DMultisampleBlockShape; -- > VkBool32 residencyStandard3DBlockShape; -- > VkBool32 residencyAlignedMipSize; -- > VkBool32 residencyNonResidentStrict; -- > } VkPhysicalDeviceSparseProperties; -- -- data VkPhysicalDeviceSparseProperties = VkPhysicalDeviceSparseProperties## Addr## ByteArray## instance Eq VkPhysicalDeviceSparseProperties where (VkPhysicalDeviceSparseProperties## a _) == x@(VkPhysicalDeviceSparseProperties## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceSparseProperties where (VkPhysicalDeviceSparseProperties## a _) `compare` x@(VkPhysicalDeviceSparseProperties## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceSparseProperties where sizeOf ~_ = #{size VkPhysicalDeviceSparseProperties} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceSparseProperties} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceSparseProperties where unsafeAddr (VkPhysicalDeviceSparseProperties## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceSparseProperties## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceSparseProperties## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceSparseProperties where type StructFields VkPhysicalDeviceSparseProperties = '["residencyStandard2DBlockShape", -- ' closing tick for hsc2hs "residencyStandard2DMultisampleBlockShape", "residencyStandard3DBlockShape", "residencyAlignedMipSize", "residencyNonResidentStrict"] type CUnionType VkPhysicalDeviceSparseProperties = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceSparseProperties = 'True -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceSparseProperties = '[] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "residencyStandard2DBlockShape" VkPhysicalDeviceSparseProperties where type FieldType "residencyStandard2DBlockShape" VkPhysicalDeviceSparseProperties = VkBool32 type FieldOptional "residencyStandard2DBlockShape" VkPhysicalDeviceSparseProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "residencyStandard2DBlockShape" VkPhysicalDeviceSparseProperties = #{offset VkPhysicalDeviceSparseProperties, residencyStandard2DBlockShape} type FieldIsArray "residencyStandard2DBlockShape" VkPhysicalDeviceSparseProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSparseProperties, residencyStandard2DBlockShape} instance {-# OVERLAPPING #-} CanReadField "residencyStandard2DBlockShape" VkPhysicalDeviceSparseProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSparseProperties, residencyStandard2DBlockShape}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSparseProperties, residencyStandard2DBlockShape} instance {-# OVERLAPPING #-} CanWriteField "residencyStandard2DBlockShape" VkPhysicalDeviceSparseProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSparseProperties, residencyStandard2DBlockShape} instance {-# OVERLAPPING #-} HasField "residencyStandard2DMultisampleBlockShape" VkPhysicalDeviceSparseProperties where type FieldType "residencyStandard2DMultisampleBlockShape" VkPhysicalDeviceSparseProperties = VkBool32 type FieldOptional "residencyStandard2DMultisampleBlockShape" VkPhysicalDeviceSparseProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "residencyStandard2DMultisampleBlockShape" VkPhysicalDeviceSparseProperties = #{offset VkPhysicalDeviceSparseProperties, residencyStandard2DMultisampleBlockShape} type FieldIsArray "residencyStandard2DMultisampleBlockShape" VkPhysicalDeviceSparseProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSparseProperties, residencyStandard2DMultisampleBlockShape} instance {-# OVERLAPPING #-} CanReadField "residencyStandard2DMultisampleBlockShape" VkPhysicalDeviceSparseProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSparseProperties, residencyStandard2DMultisampleBlockShape}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSparseProperties, residencyStandard2DMultisampleBlockShape} instance {-# OVERLAPPING #-} CanWriteField "residencyStandard2DMultisampleBlockShape" VkPhysicalDeviceSparseProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSparseProperties, residencyStandard2DMultisampleBlockShape} instance {-# OVERLAPPING #-} HasField "residencyStandard3DBlockShape" VkPhysicalDeviceSparseProperties where type FieldType "residencyStandard3DBlockShape" VkPhysicalDeviceSparseProperties = VkBool32 type FieldOptional "residencyStandard3DBlockShape" VkPhysicalDeviceSparseProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "residencyStandard3DBlockShape" VkPhysicalDeviceSparseProperties = #{offset VkPhysicalDeviceSparseProperties, residencyStandard3DBlockShape} type FieldIsArray "residencyStandard3DBlockShape" VkPhysicalDeviceSparseProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSparseProperties, residencyStandard3DBlockShape} instance {-# OVERLAPPING #-} CanReadField "residencyStandard3DBlockShape" VkPhysicalDeviceSparseProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSparseProperties, residencyStandard3DBlockShape}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSparseProperties, residencyStandard3DBlockShape} instance {-# OVERLAPPING #-} CanWriteField "residencyStandard3DBlockShape" VkPhysicalDeviceSparseProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSparseProperties, residencyStandard3DBlockShape} instance {-# OVERLAPPING #-} HasField "residencyAlignedMipSize" VkPhysicalDeviceSparseProperties where type FieldType "residencyAlignedMipSize" VkPhysicalDeviceSparseProperties = VkBool32 type FieldOptional "residencyAlignedMipSize" VkPhysicalDeviceSparseProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "residencyAlignedMipSize" VkPhysicalDeviceSparseProperties = #{offset VkPhysicalDeviceSparseProperties, residencyAlignedMipSize} type FieldIsArray "residencyAlignedMipSize" VkPhysicalDeviceSparseProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSparseProperties, residencyAlignedMipSize} instance {-# OVERLAPPING #-} CanReadField "residencyAlignedMipSize" VkPhysicalDeviceSparseProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSparseProperties, residencyAlignedMipSize}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSparseProperties, residencyAlignedMipSize} instance {-# OVERLAPPING #-} CanWriteField "residencyAlignedMipSize" VkPhysicalDeviceSparseProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSparseProperties, residencyAlignedMipSize} instance {-# OVERLAPPING #-} HasField "residencyNonResidentStrict" VkPhysicalDeviceSparseProperties where type FieldType "residencyNonResidentStrict" VkPhysicalDeviceSparseProperties = VkBool32 type FieldOptional "residencyNonResidentStrict" VkPhysicalDeviceSparseProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "residencyNonResidentStrict" VkPhysicalDeviceSparseProperties = #{offset VkPhysicalDeviceSparseProperties, residencyNonResidentStrict} type FieldIsArray "residencyNonResidentStrict" VkPhysicalDeviceSparseProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSparseProperties, residencyNonResidentStrict} instance {-# OVERLAPPING #-} CanReadField "residencyNonResidentStrict" VkPhysicalDeviceSparseProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSparseProperties, residencyNonResidentStrict}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSparseProperties, residencyNonResidentStrict} instance {-# OVERLAPPING #-} CanWriteField "residencyNonResidentStrict" VkPhysicalDeviceSparseProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSparseProperties, residencyNonResidentStrict} instance Show VkPhysicalDeviceSparseProperties where showsPrec d x = showString "VkPhysicalDeviceSparseProperties {" . showString "residencyStandard2DBlockShape = " . showsPrec d (getField @"residencyStandard2DBlockShape" x) . showString ", " . showString "residencyStandard2DMultisampleBlockShape = " . showsPrec d (getField @"residencyStandard2DMultisampleBlockShape" x) . showString ", " . showString "residencyStandard3DBlockShape = " . showsPrec d (getField @"residencyStandard3DBlockShape" x) . showString ", " . showString "residencyAlignedMipSize = " . showsPrec d (getField @"residencyAlignedMipSize" x) . showString ", " . showString "residencyNonResidentStrict = " . showsPrec d (getField @"residencyNonResidentStrict" x) . showChar '}' -- | > typedef struct VkPhysicalDeviceSubgroupProperties { -- > VkStructureType sType; -- > void* pNext; -- > uint32_t subgroupSize; -- > VkShaderStageFlags supportedStages; -- > VkSubgroupFeatureFlags supportedOperations; -- > VkBool32 quadOperationsInAllStages; -- > } VkPhysicalDeviceSubgroupProperties; -- -- data VkPhysicalDeviceSubgroupProperties = VkPhysicalDeviceSubgroupProperties## Addr## ByteArray## instance Eq VkPhysicalDeviceSubgroupProperties where (VkPhysicalDeviceSubgroupProperties## a _) == x@(VkPhysicalDeviceSubgroupProperties## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceSubgroupProperties where (VkPhysicalDeviceSubgroupProperties## a _) `compare` x@(VkPhysicalDeviceSubgroupProperties## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceSubgroupProperties where sizeOf ~_ = #{size VkPhysicalDeviceSubgroupProperties} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceSubgroupProperties} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceSubgroupProperties where unsafeAddr (VkPhysicalDeviceSubgroupProperties## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceSubgroupProperties## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceSubgroupProperties## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceSubgroupProperties where type StructFields VkPhysicalDeviceSubgroupProperties = '["sType", "pNext", "subgroupSize", "supportedStages", -- ' closing tick for hsc2hs "supportedOperations", "quadOperationsInAllStages"] type CUnionType VkPhysicalDeviceSubgroupProperties = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceSubgroupProperties = 'True -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceSubgroupProperties = '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceSubgroupProperties where type FieldType "sType" VkPhysicalDeviceSubgroupProperties = VkStructureType type FieldOptional "sType" VkPhysicalDeviceSubgroupProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceSubgroupProperties = #{offset VkPhysicalDeviceSubgroupProperties, sType} type FieldIsArray "sType" VkPhysicalDeviceSubgroupProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSubgroupProperties, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceSubgroupProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSubgroupProperties, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSubgroupProperties, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceSubgroupProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSubgroupProperties, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceSubgroupProperties where type FieldType "pNext" VkPhysicalDeviceSubgroupProperties = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceSubgroupProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceSubgroupProperties = #{offset VkPhysicalDeviceSubgroupProperties, pNext} type FieldIsArray "pNext" VkPhysicalDeviceSubgroupProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSubgroupProperties, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceSubgroupProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSubgroupProperties, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSubgroupProperties, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceSubgroupProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSubgroupProperties, pNext} instance {-# OVERLAPPING #-} HasField "subgroupSize" VkPhysicalDeviceSubgroupProperties where type FieldType "subgroupSize" VkPhysicalDeviceSubgroupProperties = Word32 type FieldOptional "subgroupSize" VkPhysicalDeviceSubgroupProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "subgroupSize" VkPhysicalDeviceSubgroupProperties = #{offset VkPhysicalDeviceSubgroupProperties, subgroupSize} type FieldIsArray "subgroupSize" VkPhysicalDeviceSubgroupProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSubgroupProperties, subgroupSize} instance {-# OVERLAPPING #-} CanReadField "subgroupSize" VkPhysicalDeviceSubgroupProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSubgroupProperties, subgroupSize}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSubgroupProperties, subgroupSize} instance {-# OVERLAPPING #-} CanWriteField "subgroupSize" VkPhysicalDeviceSubgroupProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSubgroupProperties, subgroupSize} instance {-# OVERLAPPING #-} HasField "supportedStages" VkPhysicalDeviceSubgroupProperties where type FieldType "supportedStages" VkPhysicalDeviceSubgroupProperties = VkShaderStageFlags type FieldOptional "supportedStages" VkPhysicalDeviceSubgroupProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "supportedStages" VkPhysicalDeviceSubgroupProperties = #{offset VkPhysicalDeviceSubgroupProperties, supportedStages} type FieldIsArray "supportedStages" VkPhysicalDeviceSubgroupProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSubgroupProperties, supportedStages} instance {-# OVERLAPPING #-} CanReadField "supportedStages" VkPhysicalDeviceSubgroupProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSubgroupProperties, supportedStages}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSubgroupProperties, supportedStages} instance {-# OVERLAPPING #-} CanWriteField "supportedStages" VkPhysicalDeviceSubgroupProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSubgroupProperties, supportedStages} instance {-# OVERLAPPING #-} HasField "supportedOperations" VkPhysicalDeviceSubgroupProperties where type FieldType "supportedOperations" VkPhysicalDeviceSubgroupProperties = VkSubgroupFeatureFlags type FieldOptional "supportedOperations" VkPhysicalDeviceSubgroupProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "supportedOperations" VkPhysicalDeviceSubgroupProperties = #{offset VkPhysicalDeviceSubgroupProperties, supportedOperations} type FieldIsArray "supportedOperations" VkPhysicalDeviceSubgroupProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSubgroupProperties, supportedOperations} instance {-# OVERLAPPING #-} CanReadField "supportedOperations" VkPhysicalDeviceSubgroupProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSubgroupProperties, supportedOperations}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSubgroupProperties, supportedOperations} instance {-# OVERLAPPING #-} CanWriteField "supportedOperations" VkPhysicalDeviceSubgroupProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSubgroupProperties, supportedOperations} instance {-# OVERLAPPING #-} HasField "quadOperationsInAllStages" VkPhysicalDeviceSubgroupProperties where type FieldType "quadOperationsInAllStages" VkPhysicalDeviceSubgroupProperties = VkBool32 type FieldOptional "quadOperationsInAllStages" VkPhysicalDeviceSubgroupProperties = 'False -- ' closing tick for hsc2hs type FieldOffset "quadOperationsInAllStages" VkPhysicalDeviceSubgroupProperties = #{offset VkPhysicalDeviceSubgroupProperties, quadOperationsInAllStages} type FieldIsArray "quadOperationsInAllStages" VkPhysicalDeviceSubgroupProperties = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSubgroupProperties, quadOperationsInAllStages} instance {-# OVERLAPPING #-} CanReadField "quadOperationsInAllStages" VkPhysicalDeviceSubgroupProperties where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSubgroupProperties, quadOperationsInAllStages}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSubgroupProperties, quadOperationsInAllStages} instance {-# OVERLAPPING #-} CanWriteField "quadOperationsInAllStages" VkPhysicalDeviceSubgroupProperties where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSubgroupProperties, quadOperationsInAllStages} instance Show VkPhysicalDeviceSubgroupProperties where showsPrec d x = showString "VkPhysicalDeviceSubgroupProperties {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "subgroupSize = " . showsPrec d (getField @"subgroupSize" x) . showString ", " . showString "supportedStages = " . showsPrec d (getField @"supportedStages" x) . showString ", " . showString "supportedOperations = " . showsPrec d (getField @"supportedOperations" x) . showString ", " . showString "quadOperationsInAllStages = " . showsPrec d (getField @"quadOperationsInAllStages" x) . showChar '}' -- | > typedef struct VkPhysicalDeviceSurfaceInfo2KHR { -- > VkStructureType sType; -- > const void* pNext; -- > VkSurfaceKHR surface; -- > } VkPhysicalDeviceSurfaceInfo2KHR; -- -- data VkPhysicalDeviceSurfaceInfo2KHR = VkPhysicalDeviceSurfaceInfo2KHR## Addr## ByteArray## instance Eq VkPhysicalDeviceSurfaceInfo2KHR where (VkPhysicalDeviceSurfaceInfo2KHR## a _) == x@(VkPhysicalDeviceSurfaceInfo2KHR## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceSurfaceInfo2KHR where (VkPhysicalDeviceSurfaceInfo2KHR## a _) `compare` x@(VkPhysicalDeviceSurfaceInfo2KHR## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceSurfaceInfo2KHR where sizeOf ~_ = #{size VkPhysicalDeviceSurfaceInfo2KHR} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceSurfaceInfo2KHR} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceSurfaceInfo2KHR where unsafeAddr (VkPhysicalDeviceSurfaceInfo2KHR## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceSurfaceInfo2KHR## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceSurfaceInfo2KHR## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceSurfaceInfo2KHR where type StructFields VkPhysicalDeviceSurfaceInfo2KHR = '["sType", "pNext", "surface"] -- ' closing tick for hsc2hs type CUnionType VkPhysicalDeviceSurfaceInfo2KHR = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceSurfaceInfo2KHR = 'False -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceSurfaceInfo2KHR = '[] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceSurfaceInfo2KHR where type FieldType "sType" VkPhysicalDeviceSurfaceInfo2KHR = VkStructureType type FieldOptional "sType" VkPhysicalDeviceSurfaceInfo2KHR = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceSurfaceInfo2KHR = #{offset VkPhysicalDeviceSurfaceInfo2KHR, sType} type FieldIsArray "sType" VkPhysicalDeviceSurfaceInfo2KHR = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSurfaceInfo2KHR, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceSurfaceInfo2KHR where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSurfaceInfo2KHR, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSurfaceInfo2KHR, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceSurfaceInfo2KHR where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSurfaceInfo2KHR, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceSurfaceInfo2KHR where type FieldType "pNext" VkPhysicalDeviceSurfaceInfo2KHR = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceSurfaceInfo2KHR = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceSurfaceInfo2KHR = #{offset VkPhysicalDeviceSurfaceInfo2KHR, pNext} type FieldIsArray "pNext" VkPhysicalDeviceSurfaceInfo2KHR = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSurfaceInfo2KHR, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceSurfaceInfo2KHR where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSurfaceInfo2KHR, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSurfaceInfo2KHR, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceSurfaceInfo2KHR where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSurfaceInfo2KHR, pNext} instance {-# OVERLAPPING #-} HasField "surface" VkPhysicalDeviceSurfaceInfo2KHR where type FieldType "surface" VkPhysicalDeviceSurfaceInfo2KHR = VkSurfaceKHR type FieldOptional "surface" VkPhysicalDeviceSurfaceInfo2KHR = 'False -- ' closing tick for hsc2hs type FieldOffset "surface" VkPhysicalDeviceSurfaceInfo2KHR = #{offset VkPhysicalDeviceSurfaceInfo2KHR, surface} type FieldIsArray "surface" VkPhysicalDeviceSurfaceInfo2KHR = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceSurfaceInfo2KHR, surface} instance {-# OVERLAPPING #-} CanReadField "surface" VkPhysicalDeviceSurfaceInfo2KHR where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceSurfaceInfo2KHR, surface}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceSurfaceInfo2KHR, surface} instance {-# OVERLAPPING #-} CanWriteField "surface" VkPhysicalDeviceSurfaceInfo2KHR where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceSurfaceInfo2KHR, surface} instance Show VkPhysicalDeviceSurfaceInfo2KHR where showsPrec d x = showString "VkPhysicalDeviceSurfaceInfo2KHR {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "surface = " . showsPrec d (getField @"surface" x) . showChar '}' -- | > typedef struct VkPhysicalDeviceVariablePointerFeatures { -- > VkStructureType sType; -- > void* pNext; -- > VkBool32 variablePointersStorageBuffer; -- > VkBool32 variablePointers; -- > } VkPhysicalDeviceVariablePointerFeatures; -- -- data VkPhysicalDeviceVariablePointerFeatures = VkPhysicalDeviceVariablePointerFeatures## Addr## ByteArray## instance Eq VkPhysicalDeviceVariablePointerFeatures where (VkPhysicalDeviceVariablePointerFeatures## a _) == x@(VkPhysicalDeviceVariablePointerFeatures## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceVariablePointerFeatures where (VkPhysicalDeviceVariablePointerFeatures## a _) `compare` x@(VkPhysicalDeviceVariablePointerFeatures## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceVariablePointerFeatures where sizeOf ~_ = #{size VkPhysicalDeviceVariablePointerFeatures} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceVariablePointerFeatures} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceVariablePointerFeatures where unsafeAddr (VkPhysicalDeviceVariablePointerFeatures## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceVariablePointerFeatures## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceVariablePointerFeatures## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceVariablePointerFeatures where type StructFields VkPhysicalDeviceVariablePointerFeatures = '["sType", "pNext", "variablePointersStorageBuffer", -- ' closing tick for hsc2hs "variablePointers"] type CUnionType VkPhysicalDeviceVariablePointerFeatures = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceVariablePointerFeatures = 'False -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceVariablePointerFeatures = '[VkPhysicalDeviceFeatures2, VkDeviceCreateInfo] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceVariablePointerFeatures where type FieldType "sType" VkPhysicalDeviceVariablePointerFeatures = VkStructureType type FieldOptional "sType" VkPhysicalDeviceVariablePointerFeatures = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceVariablePointerFeatures = #{offset VkPhysicalDeviceVariablePointerFeatures, sType} type FieldIsArray "sType" VkPhysicalDeviceVariablePointerFeatures = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceVariablePointerFeatures, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceVariablePointerFeatures where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceVariablePointerFeatures, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceVariablePointerFeatures, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceVariablePointerFeatures where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceVariablePointerFeatures, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceVariablePointerFeatures where type FieldType "pNext" VkPhysicalDeviceVariablePointerFeatures = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceVariablePointerFeatures = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceVariablePointerFeatures = #{offset VkPhysicalDeviceVariablePointerFeatures, pNext} type FieldIsArray "pNext" VkPhysicalDeviceVariablePointerFeatures = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceVariablePointerFeatures, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceVariablePointerFeatures where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceVariablePointerFeatures, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceVariablePointerFeatures, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceVariablePointerFeatures where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceVariablePointerFeatures, pNext} instance {-# OVERLAPPING #-} HasField "variablePointersStorageBuffer" VkPhysicalDeviceVariablePointerFeatures where type FieldType "variablePointersStorageBuffer" VkPhysicalDeviceVariablePointerFeatures = VkBool32 type FieldOptional "variablePointersStorageBuffer" VkPhysicalDeviceVariablePointerFeatures = 'False -- ' closing tick for hsc2hs type FieldOffset "variablePointersStorageBuffer" VkPhysicalDeviceVariablePointerFeatures = #{offset VkPhysicalDeviceVariablePointerFeatures, variablePointersStorageBuffer} type FieldIsArray "variablePointersStorageBuffer" VkPhysicalDeviceVariablePointerFeatures = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceVariablePointerFeatures, variablePointersStorageBuffer} instance {-# OVERLAPPING #-} CanReadField "variablePointersStorageBuffer" VkPhysicalDeviceVariablePointerFeatures where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceVariablePointerFeatures, variablePointersStorageBuffer}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceVariablePointerFeatures, variablePointersStorageBuffer} instance {-# OVERLAPPING #-} CanWriteField "variablePointersStorageBuffer" VkPhysicalDeviceVariablePointerFeatures where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceVariablePointerFeatures, variablePointersStorageBuffer} instance {-# OVERLAPPING #-} HasField "variablePointers" VkPhysicalDeviceVariablePointerFeatures where type FieldType "variablePointers" VkPhysicalDeviceVariablePointerFeatures = VkBool32 type FieldOptional "variablePointers" VkPhysicalDeviceVariablePointerFeatures = 'False -- ' closing tick for hsc2hs type FieldOffset "variablePointers" VkPhysicalDeviceVariablePointerFeatures = #{offset VkPhysicalDeviceVariablePointerFeatures, variablePointers} type FieldIsArray "variablePointers" VkPhysicalDeviceVariablePointerFeatures = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceVariablePointerFeatures, variablePointers} instance {-# OVERLAPPING #-} CanReadField "variablePointers" VkPhysicalDeviceVariablePointerFeatures where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceVariablePointerFeatures, variablePointers}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceVariablePointerFeatures, variablePointers} instance {-# OVERLAPPING #-} CanWriteField "variablePointers" VkPhysicalDeviceVariablePointerFeatures where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceVariablePointerFeatures, variablePointers} instance Show VkPhysicalDeviceVariablePointerFeatures where showsPrec d x = showString "VkPhysicalDeviceVariablePointerFeatures {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "variablePointersStorageBuffer = " . showsPrec d (getField @"variablePointersStorageBuffer" x) . showString ", " . showString "variablePointers = " . showsPrec d (getField @"variablePointers" x) . showChar '}' -- | Alias for `VkPhysicalDeviceVariablePointerFeatures` type VkPhysicalDeviceVariablePointerFeaturesKHR = VkPhysicalDeviceVariablePointerFeatures -- | > typedef struct VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT { -- > VkStructureType sType; -- > void* pNext; -- > uint32_t maxVertexAttribDivisor; -- > } VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT; -- -- data VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT = VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT## Addr## ByteArray## instance Eq VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT where (VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT## a _) == x@(VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT## b _) = EQ == cmpBytes## (sizeOf x) a b {-# INLINE (==) #-} instance Ord VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT where (VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT## a _) `compare` x@(VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT## b _) = cmpBytes## (sizeOf x) a b {-# INLINE compare #-} instance Storable VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT where sizeOf ~_ = #{size VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT} {-# INLINE sizeOf #-} alignment ~_ = #{alignment VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT} {-# INLINE alignment #-} peek = peekVkData## {-# INLINE peek #-} poke = pokeVkData## {-# INLINE poke #-} instance VulkanMarshalPrim VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT where unsafeAddr (VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT## a _) = a {-# INLINE unsafeAddr #-} unsafeByteArray (VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT## _ b) = b {-# INLINE unsafeByteArray #-} unsafeFromByteArrayOffset off b = VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT## (plusAddr## (byteArrayContents## b) off) b {-# INLINE unsafeFromByteArrayOffset #-} instance VulkanMarshal VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT where type StructFields VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT = '["sType", "pNext", "maxVertexAttribDivisor"] -- ' closing tick for hsc2hs type CUnionType VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT = 'False -- ' closing tick for hsc2hs type ReturnedOnly VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT = 'False -- ' closing tick for hsc2hs type StructExtends VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT = '[VkPhysicalDeviceProperties2] -- ' closing tick for hsc2hs instance {-# OVERLAPPING #-} HasField "sType" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT where type FieldType "sType" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT = VkStructureType type FieldOptional "sType" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "sType" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT = #{offset VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT, sType} type FieldIsArray "sType" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT, sType} instance {-# OVERLAPPING #-} CanReadField "sType" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT, sType}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT, sType} instance {-# OVERLAPPING #-} CanWriteField "sType" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT, sType} instance {-# OVERLAPPING #-} HasField "pNext" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT where type FieldType "pNext" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT = Ptr Void type FieldOptional "pNext" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "pNext" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT = #{offset VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT, pNext} type FieldIsArray "pNext" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT, pNext} instance {-# OVERLAPPING #-} CanReadField "pNext" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT, pNext}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT, pNext} instance {-# OVERLAPPING #-} CanWriteField "pNext" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT, pNext} instance {-# OVERLAPPING #-} HasField "maxVertexAttribDivisor" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT where type FieldType "maxVertexAttribDivisor" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT = Word32 type FieldOptional "maxVertexAttribDivisor" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT = 'False -- ' closing tick for hsc2hs type FieldOffset "maxVertexAttribDivisor" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT = #{offset VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT, maxVertexAttribDivisor} type FieldIsArray "maxVertexAttribDivisor" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT = 'False -- ' closing tick for hsc2hs {-# INLINE fieldOptional #-} fieldOptional = False {-# INLINE fieldOffset #-} fieldOffset = #{offset VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT, maxVertexAttribDivisor} instance {-# OVERLAPPING #-} CanReadField "maxVertexAttribDivisor" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT where {-# NOINLINE getField #-} getField x = unsafeDupablePerformIO (peekByteOff (unsafePtr x) #{offset VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT, maxVertexAttribDivisor}) {-# INLINE readField #-} readField p = peekByteOff p #{offset VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT, maxVertexAttribDivisor} instance {-# OVERLAPPING #-} CanWriteField "maxVertexAttribDivisor" VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT where {-# INLINE writeField #-} writeField p = pokeByteOff p #{offset VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT, maxVertexAttribDivisor} instance Show VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT where showsPrec d x = showString "VkPhysicalDeviceVertexAttributeDivisorPropertiesEXT {" . showString "sType = " . showsPrec d (getField @"sType" x) . showString ", " . showString "pNext = " . showsPrec d (getField @"pNext" x) . showString ", " . showString "maxVertexAttribDivisor = " . showsPrec d (getField @"maxVertexAttribDivisor" x) . showChar '}'