{-# language CPP #-}
module Vulkan.Core10.DeviceInitialization ( createInstance
, withInstance
, destroyInstance
, enumeratePhysicalDevices
, getDeviceProcAddr
, getInstanceProcAddr
, getPhysicalDeviceProperties
, getPhysicalDeviceQueueFamilyProperties
, getPhysicalDeviceMemoryProperties
, getPhysicalDeviceFeatures
, getPhysicalDeviceFormatProperties
, getPhysicalDeviceImageFormatProperties
, PhysicalDeviceProperties(..)
, ApplicationInfo(..)
, InstanceCreateInfo(..)
, QueueFamilyProperties(..)
, PhysicalDeviceMemoryProperties(..)
, MemoryType(..)
, MemoryHeap(..)
, FormatProperties(..)
, ImageFormatProperties(..)
, PhysicalDeviceFeatures(..)
, PhysicalDeviceSparseProperties(..)
, PhysicalDeviceLimits(..)
, Instance(..)
, PhysicalDevice(..)
, AllocationCallbacks(..)
, ImageType(..)
, ImageTiling(..)
, InternalAllocationType(..)
, SystemAllocationScope(..)
, PhysicalDeviceType(..)
, Format(..)
, QueueFlagBits(..)
, QueueFlags
, MemoryPropertyFlagBits(..)
, MemoryPropertyFlags
, MemoryHeapFlagBits(..)
, MemoryHeapFlags
, ImageUsageFlagBits(..)
, ImageUsageFlags
, ImageCreateFlagBits(..)
, ImageCreateFlags
, FormatFeatureFlagBits(..)
, FormatFeatureFlags
, SampleCountFlagBits(..)
, SampleCountFlags
, InstanceCreateFlagBits(..)
, InstanceCreateFlags
, FN_vkInternalAllocationNotification
, PFN_vkInternalAllocationNotification
, FN_vkInternalFreeNotification
, PFN_vkInternalFreeNotification
, FN_vkReallocationFunction
, PFN_vkReallocationFunction
, FN_vkAllocationFunction
, PFN_vkAllocationFunction
, FN_vkFreeFunction
, PFN_vkFreeFunction
, FN_vkVoidFunction
, PFN_vkVoidFunction
) where
import Vulkan.CStruct.Utils (FixedArray)
import Vulkan.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import Foreign.Marshal.Utils (maybePeek)
import GHC.Base (when)
import GHC.IO (throwIO)
import Foreign.Ptr (castFunPtr)
import GHC.Ptr (castPtr)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Data.ByteString (packCString)
import Data.ByteString (useAsCString)
import Data.Coerce (coerce)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import Foreign.C.Types (CChar(..))
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.Type.Equality ((:~:)(Refl))
import Data.Typeable (Typeable)
import Foreign.C.Types (CChar)
import Foreign.C.Types (CFloat)
import Foreign.C.Types (CFloat(..))
import Foreign.C.Types (CFloat(CFloat))
import Foreign.C.Types (CSize)
import Foreign.C.Types (CSize(..))
import Foreign.C.Types (CSize(CSize))
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Data.Int (Int32)
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import GHC.Ptr (Ptr(Ptr))
import Data.Word (Word32)
import Data.Word (Word64)
import Data.Word (Word8)
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import Vulkan.CStruct.Utils (advancePtrBytes)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.CStruct.Extends (forgetExtensions)
import Vulkan.Dynamic (getInstanceProcAddr')
import Vulkan.Dynamic (initInstanceCmds)
import Vulkan.CStruct.Utils (lowerArrayPtr)
import Vulkan.CStruct.Utils (peekByteStringFromSizedVectorPtr)
import Vulkan.CStruct.Utils (pokeFixedLengthByteString)
import Vulkan.CStruct.Utils (pokeFixedLengthNullTerminatedByteString)
import Vulkan.NamedType ((:::))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.CStruct.Extends (Chain)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_debug_report (DebugReportCallbackCreateInfoEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_debug_utils (DebugUtilsMessengerCreateInfoEXT)
import Vulkan.Core10.Handles (Device)
import Vulkan.Core10.Handles (Device(..))
import Vulkan.Core10.Handles (Device(Device))
import Vulkan.Dynamic (DeviceCmds(pVkGetDeviceProcAddr))
import Vulkan.Core10.FundamentalTypes (DeviceSize)
import Vulkan.Core10.Handles (Device_T)
import {-# SOURCE #-} Vulkan.Extensions.VK_LUNARG_direct_driver_loading (DirectDriverLoadingListLUNARG)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_metal_objects (ExportMetalObjectCreateInfoEXT)
import Vulkan.CStruct.Extends (Extends)
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (Extensible(..))
import Vulkan.Core10.FundamentalTypes (Extent3D)
import Vulkan.Core10.Enums.Format (Format)
import Vulkan.Core10.Enums.Format (Format(..))
import Vulkan.Core10.Enums.FormatFeatureFlagBits (FormatFeatureFlags)
import Vulkan.Core10.Enums.ImageCreateFlagBits (ImageCreateFlagBits(..))
import Vulkan.Core10.Enums.ImageCreateFlagBits (ImageCreateFlags)
import Vulkan.Core10.Enums.ImageTiling (ImageTiling)
import Vulkan.Core10.Enums.ImageTiling (ImageTiling(..))
import Vulkan.Core10.Enums.ImageType (ImageType)
import Vulkan.Core10.Enums.ImageType (ImageType(..))
import Vulkan.Core10.Enums.ImageUsageFlagBits (ImageUsageFlagBits(..))
import Vulkan.Core10.Enums.ImageUsageFlagBits (ImageUsageFlags)
import Vulkan.Core10.Handles (Instance)
import Vulkan.Core10.Handles (Instance(..))
import Vulkan.Core10.Handles (Instance(Instance))
import Vulkan.Dynamic (InstanceCmds(pVkDestroyInstance))
import Vulkan.Dynamic (InstanceCmds(pVkEnumeratePhysicalDevices))
import Vulkan.Dynamic (InstanceCmds(pVkGetInstanceProcAddr))
import Vulkan.Dynamic (InstanceCmds(pVkGetPhysicalDeviceFeatures))
import Vulkan.Dynamic (InstanceCmds(pVkGetPhysicalDeviceFormatProperties))
import Vulkan.Dynamic (InstanceCmds(pVkGetPhysicalDeviceImageFormatProperties))
import Vulkan.Dynamic (InstanceCmds(pVkGetPhysicalDeviceMemoryProperties))
import Vulkan.Dynamic (InstanceCmds(pVkGetPhysicalDeviceProperties))
import Vulkan.Dynamic (InstanceCmds(pVkGetPhysicalDeviceQueueFamilyProperties))
import Vulkan.Core10.Enums.InstanceCreateFlagBits (InstanceCreateFlags)
import Vulkan.Core10.Handles (Instance_T)
import Vulkan.Core10.APIConstants (MAX_MEMORY_HEAPS)
import Vulkan.Core10.APIConstants (MAX_MEMORY_TYPES)
import Vulkan.Core10.APIConstants (MAX_PHYSICAL_DEVICE_NAME_SIZE)
import Vulkan.Core10.Enums.MemoryHeapFlagBits (MemoryHeapFlags)
import Vulkan.Core10.Enums.MemoryPropertyFlagBits (MemoryPropertyFlags)
import Vulkan.Core10.FuncPointers (PFN_vkVoidFunction)
import Vulkan.CStruct.Extends (PeekChain)
import Vulkan.CStruct.Extends (PeekChain(..))
import Vulkan.Core10.Handles (PhysicalDevice)
import Vulkan.Core10.Handles (PhysicalDevice(..))
import Vulkan.Core10.Handles (PhysicalDevice(PhysicalDevice))
import Vulkan.Core10.Enums.PhysicalDeviceType (PhysicalDeviceType)
import Vulkan.Core10.Handles (PhysicalDevice_T)
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (PokeChain(..))
import Vulkan.Core10.Enums.QueueFlagBits (QueueFlags)
import Vulkan.Core10.Enums.Result (Result)
import Vulkan.Core10.Enums.Result (Result(..))
import Vulkan.Core10.Enums.SampleCountFlagBits (SampleCountFlags)
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.APIConstants (UUID_SIZE)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_validation_features (ValidationFeaturesEXT)
import {-# SOURCE #-} Vulkan.Extensions.VK_EXT_validation_flags (ValidationFlagsEXT)
import Vulkan.Exception (VulkanException(..))
import Vulkan.Core10.APIConstants (pattern MAX_MEMORY_HEAPS)
import Vulkan.Core10.APIConstants (pattern MAX_MEMORY_TYPES)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_APPLICATION_INFO))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_INSTANCE_CREATE_INFO))
import Vulkan.Core10.Enums.Result (Result(SUCCESS))
import Vulkan.Core10.AllocationCallbacks (AllocationCallbacks(..))
import Vulkan.Core10.FuncPointers (FN_vkAllocationFunction)
import Vulkan.Core10.FuncPointers (FN_vkFreeFunction)
import Vulkan.Core10.FuncPointers (FN_vkInternalAllocationNotification)
import Vulkan.Core10.FuncPointers (FN_vkInternalFreeNotification)
import Vulkan.Core10.FuncPointers (FN_vkReallocationFunction)
import Vulkan.Core10.FuncPointers (FN_vkVoidFunction)
import Vulkan.Core10.Enums.Format (Format(..))
import Vulkan.Core10.Enums.FormatFeatureFlagBits (FormatFeatureFlagBits(..))
import Vulkan.Core10.Enums.FormatFeatureFlagBits (FormatFeatureFlags)
import Vulkan.Core10.Enums.ImageCreateFlagBits (ImageCreateFlagBits(..))
import Vulkan.Core10.Enums.ImageCreateFlagBits (ImageCreateFlags)
import Vulkan.Core10.Enums.ImageTiling (ImageTiling(..))
import Vulkan.Core10.Enums.ImageType (ImageType(..))
import Vulkan.Core10.Enums.ImageUsageFlagBits (ImageUsageFlagBits(..))
import Vulkan.Core10.Enums.ImageUsageFlagBits (ImageUsageFlags)
import Vulkan.Core10.Handles (Instance(..))
import Vulkan.Core10.Enums.InstanceCreateFlagBits (InstanceCreateFlagBits(..))
import Vulkan.Core10.Enums.InstanceCreateFlagBits (InstanceCreateFlags)
import Vulkan.Core10.Enums.InternalAllocationType (InternalAllocationType(..))
import Vulkan.Core10.Enums.MemoryHeapFlagBits (MemoryHeapFlagBits(..))
import Vulkan.Core10.Enums.MemoryHeapFlagBits (MemoryHeapFlags)
import Vulkan.Core10.Enums.MemoryPropertyFlagBits (MemoryPropertyFlagBits(..))
import Vulkan.Core10.Enums.MemoryPropertyFlagBits (MemoryPropertyFlags)
import Vulkan.Core10.FuncPointers (PFN_vkAllocationFunction)
import Vulkan.Core10.FuncPointers (PFN_vkFreeFunction)
import Vulkan.Core10.FuncPointers (PFN_vkInternalAllocationNotification)
import Vulkan.Core10.FuncPointers (PFN_vkInternalFreeNotification)
import Vulkan.Core10.FuncPointers (PFN_vkReallocationFunction)
import Vulkan.Core10.FuncPointers (PFN_vkVoidFunction)
import Vulkan.Core10.Handles (PhysicalDevice(..))
import Vulkan.Core10.Enums.PhysicalDeviceType (PhysicalDeviceType(..))
import Vulkan.Core10.Enums.QueueFlagBits (QueueFlagBits(..))
import Vulkan.Core10.Enums.QueueFlagBits (QueueFlags)
import Vulkan.Core10.Enums.SampleCountFlagBits (SampleCountFlagBits(..))
import Vulkan.Core10.Enums.SampleCountFlagBits (SampleCountFlags)
import Vulkan.Core10.Enums.SystemAllocationScope (SystemAllocationScope(..))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkCreateInstance
:: FunPtr (Ptr (SomeStruct InstanceCreateInfo) -> Ptr AllocationCallbacks -> Ptr (Ptr Instance_T) -> IO Result) -> Ptr (SomeStruct InstanceCreateInfo) -> Ptr AllocationCallbacks -> Ptr (Ptr Instance_T) -> IO Result
createInstance :: forall a io
. (Extendss InstanceCreateInfo a, PokeChain a, MonadIO io)
=>
(InstanceCreateInfo a)
->
("allocator" ::: Maybe AllocationCallbacks)
-> io (Instance)
createInstance :: forall (a :: [*]) (io :: * -> *).
(Extendss InstanceCreateInfo a, PokeChain a, MonadIO io) =>
InstanceCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks) -> io Instance
createInstance InstanceCreateInfo a
createInfo "allocator" ::: Maybe AllocationCallbacks
allocator = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
FunPtr
(("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pInstance" ::: Ptr (Ptr Instance_T))
-> IO Result)
vkCreateInstancePtr <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a b. FunPtr a -> FunPtr b
castFunPtr @_ @(("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo)) -> ("pAllocator" ::: Ptr AllocationCallbacks) -> ("pInstance" ::: Ptr (Ptr Instance_T)) -> IO Result) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Instance_T -> ("pName" ::: Ptr CChar) -> IO PFN_vkVoidFunction
getInstanceProcAddr' forall a. Ptr a
nullPtr (forall a. Addr# -> Ptr a
Ptr Addr#
"vkCreateInstance"#)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pInstance" ::: Ptr (Ptr Instance_T))
-> IO Result)
vkCreateInstancePtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkCreateInstance is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkCreateInstance' :: ("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pInstance" ::: Ptr (Ptr Instance_T))
-> IO Result
vkCreateInstance' = FunPtr
(("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pInstance" ::: Ptr (Ptr Instance_T))
-> IO Result)
-> ("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pInstance" ::: Ptr (Ptr Instance_T))
-> IO Result
mkVkCreateInstance FunPtr
(("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pInstance" ::: Ptr (Ptr Instance_T))
-> IO Result)
vkCreateInstancePtr
Ptr (InstanceCreateInfo a)
pCreateInfo <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (InstanceCreateInfo a
createInfo)
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
"allocator" ::: Maybe AllocationCallbacks
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
Just AllocationCallbacks
j -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
"pInstance" ::: Ptr (Ptr Instance_T)
pPInstance <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @(Ptr Instance_T) Int
8) forall a. Ptr a -> IO ()
free
Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkCreateInstance" (("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pInstance" ::: Ptr (Ptr Instance_T))
-> IO Result
vkCreateInstance'
(forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (InstanceCreateInfo a)
pCreateInfo)
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator
("pInstance" ::: Ptr (Ptr Instance_T)
pPInstance))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
Ptr Instance_T
pInstance <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @(Ptr Instance_T) "pInstance" ::: Ptr (Ptr Instance_T)
pPInstance
Instance
pInstance' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ (\Ptr Instance_T
h -> Ptr Instance_T -> InstanceCmds -> Instance
Instance Ptr Instance_T
h forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Instance_T -> IO InstanceCmds
initInstanceCmds Ptr Instance_T
h) Ptr Instance_T
pInstance
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Instance
pInstance')
withInstance :: forall a io r . (Extendss InstanceCreateInfo a, PokeChain a, MonadIO io) => InstanceCreateInfo a -> Maybe AllocationCallbacks -> (io Instance -> (Instance -> io ()) -> r) -> r
withInstance :: forall (a :: [*]) (io :: * -> *) r.
(Extendss InstanceCreateInfo a, PokeChain a, MonadIO io) =>
InstanceCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io Instance -> (Instance -> io ()) -> r)
-> r
withInstance InstanceCreateInfo a
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator io Instance -> (Instance -> io ()) -> r
b =
io Instance -> (Instance -> io ()) -> r
b (forall (a :: [*]) (io :: * -> *).
(Extendss InstanceCreateInfo a, PokeChain a, MonadIO io) =>
InstanceCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks) -> io Instance
createInstance InstanceCreateInfo a
pCreateInfo "allocator" ::: Maybe AllocationCallbacks
pAllocator)
(\(Instance
o0) -> forall (io :: * -> *).
MonadIO io =>
Instance -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
destroyInstance Instance
o0 "allocator" ::: Maybe AllocationCallbacks
pAllocator)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkDestroyInstance
:: FunPtr (Ptr Instance_T -> Ptr AllocationCallbacks -> IO ()) -> Ptr Instance_T -> Ptr AllocationCallbacks -> IO ()
destroyInstance :: forall io
. (MonadIO io)
=>
Instance
->
("allocator" ::: Maybe AllocationCallbacks)
-> io ()
destroyInstance :: forall (io :: * -> *).
MonadIO io =>
Instance -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
destroyInstance Instance
instance' "allocator" ::: Maybe AllocationCallbacks
allocator = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkDestroyInstancePtr :: FunPtr
(Ptr Instance_T
-> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroyInstancePtr = InstanceCmds
-> FunPtr
(Ptr Instance_T
-> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
pVkDestroyInstance (case Instance
instance' of Instance{InstanceCmds
$sel:instanceCmds:Instance :: Instance -> InstanceCmds
instanceCmds :: InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Instance_T
-> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroyInstancePtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkDestroyInstance is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkDestroyInstance' :: Ptr Instance_T
-> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroyInstance' = FunPtr
(Ptr Instance_T
-> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
-> Ptr Instance_T
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> IO ()
mkVkDestroyInstance FunPtr
(Ptr Instance_T
-> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroyInstancePtr
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator <- case ("allocator" ::: Maybe AllocationCallbacks
allocator) of
"allocator" ::: Maybe AllocationCallbacks
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
Just AllocationCallbacks
j -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkDestroyInstance" (Ptr Instance_T
-> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroyInstance'
(Instance -> Ptr Instance_T
instanceHandle (Instance
instance'))
"pAllocator" ::: Ptr AllocationCallbacks
pAllocator)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ()
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkEnumeratePhysicalDevices
:: FunPtr (Ptr Instance_T -> Ptr Word32 -> Ptr (Ptr PhysicalDevice_T) -> IO Result) -> Ptr Instance_T -> Ptr Word32 -> Ptr (Ptr PhysicalDevice_T) -> IO Result
enumeratePhysicalDevices :: forall io
. (MonadIO io)
=>
Instance
-> io (Result, ("physicalDevices" ::: Vector PhysicalDevice))
enumeratePhysicalDevices :: forall (io :: * -> *).
MonadIO io =>
Instance
-> io (Result, "physicalDevices" ::: Vector PhysicalDevice)
enumeratePhysicalDevices Instance
instance' = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let cmds :: InstanceCmds
cmds = case Instance
instance' of Instance{InstanceCmds
instanceCmds :: InstanceCmds
$sel:instanceCmds:Instance :: Instance -> InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds
let vkEnumeratePhysicalDevicesPtr :: FunPtr
(Ptr Instance_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> IO Result)
vkEnumeratePhysicalDevicesPtr = InstanceCmds
-> FunPtr
(Ptr Instance_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> IO Result)
pVkEnumeratePhysicalDevices InstanceCmds
cmds
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Instance_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> IO Result)
vkEnumeratePhysicalDevicesPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkEnumeratePhysicalDevices is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkEnumeratePhysicalDevices' :: Ptr Instance_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> IO Result
vkEnumeratePhysicalDevices' = FunPtr
(Ptr Instance_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> IO Result)
-> Ptr Instance_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> IO Result
mkVkEnumeratePhysicalDevices FunPtr
(Ptr Instance_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> IO Result)
vkEnumeratePhysicalDevicesPtr
let instance'' :: Ptr Instance_T
instance'' = Instance -> Ptr Instance_T
instanceHandle (Instance
instance')
"pPhysicalDeviceCount" ::: Ptr Word32
pPPhysicalDeviceCount <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @Word32 Int
4) forall a. Ptr a -> IO ()
free
Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkEnumeratePhysicalDevices" (Ptr Instance_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> IO Result
vkEnumeratePhysicalDevices'
Ptr Instance_T
instance''
("pPhysicalDeviceCount" ::: Ptr Word32
pPPhysicalDeviceCount)
(forall a. Ptr a
nullPtr))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
Word32
pPhysicalDeviceCount <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPhysicalDeviceCount" ::: Ptr Word32
pPPhysicalDeviceCount
"pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T)
pPPhysicalDevices <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @(Ptr PhysicalDevice_T) ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPhysicalDeviceCount)) forall a. Num a => a -> a -> a
* Int
8)) forall a. Ptr a -> IO ()
free
Result
r' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkEnumeratePhysicalDevices" (Ptr Instance_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> IO Result
vkEnumeratePhysicalDevices'
Ptr Instance_T
instance''
("pPhysicalDeviceCount" ::: Ptr Word32
pPPhysicalDeviceCount)
("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T)
pPPhysicalDevices))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r' forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r'))
Word32
pPhysicalDeviceCount' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPhysicalDeviceCount" ::: Ptr Word32
pPPhysicalDeviceCount
"physicalDevices" ::: Vector PhysicalDevice
pPhysicalDevices' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPhysicalDeviceCount')) (\Int
i -> do
Ptr PhysicalDevice_T
pPhysicalDevicesElem <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr PhysicalDevice_T) (("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T)
pPPhysicalDevices forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr PhysicalDevice_T)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (\Ptr PhysicalDevice_T
h -> Ptr PhysicalDevice_T -> InstanceCmds -> PhysicalDevice
PhysicalDevice Ptr PhysicalDevice_T
h InstanceCmds
cmds ) Ptr PhysicalDevice_T
pPhysicalDevicesElem)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ((Result
r'), "physicalDevices" ::: Vector PhysicalDevice
pPhysicalDevices')
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkGetDeviceProcAddr
:: FunPtr (Ptr Device_T -> Ptr CChar -> IO PFN_vkVoidFunction) -> Ptr Device_T -> Ptr CChar -> IO PFN_vkVoidFunction
getDeviceProcAddr :: forall io
. (MonadIO io)
=>
Device
->
("name" ::: ByteString)
-> io (PFN_vkVoidFunction)
getDeviceProcAddr :: forall (io :: * -> *).
MonadIO io =>
Device -> ("name" ::: ByteString) -> io PFN_vkVoidFunction
getDeviceProcAddr Device
device "name" ::: ByteString
name = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkGetDeviceProcAddrPtr :: FunPtr
(Ptr Device_T -> ("pName" ::: Ptr CChar) -> IO PFN_vkVoidFunction)
vkGetDeviceProcAddrPtr = DeviceCmds
-> FunPtr
(Ptr Device_T -> ("pName" ::: Ptr CChar) -> IO PFN_vkVoidFunction)
pVkGetDeviceProcAddr (case Device
device of Device{DeviceCmds
$sel:deviceCmds:Device :: Device -> DeviceCmds
deviceCmds :: DeviceCmds
deviceCmds} -> DeviceCmds
deviceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T -> ("pName" ::: Ptr CChar) -> IO PFN_vkVoidFunction)
vkGetDeviceProcAddrPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetDeviceProcAddr is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkGetDeviceProcAddr' :: Ptr Device_T -> ("pName" ::: Ptr CChar) -> IO PFN_vkVoidFunction
vkGetDeviceProcAddr' = FunPtr
(Ptr Device_T -> ("pName" ::: Ptr CChar) -> IO PFN_vkVoidFunction)
-> Ptr Device_T -> ("pName" ::: Ptr CChar) -> IO PFN_vkVoidFunction
mkVkGetDeviceProcAddr FunPtr
(Ptr Device_T -> ("pName" ::: Ptr CChar) -> IO PFN_vkVoidFunction)
vkGetDeviceProcAddrPtr
"pName" ::: Ptr CChar
pName <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a.
("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO a) -> IO a
useAsCString ("name" ::: ByteString
name)
PFN_vkVoidFunction
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetDeviceProcAddr" (Ptr Device_T -> ("pName" ::: Ptr CChar) -> IO PFN_vkVoidFunction
vkGetDeviceProcAddr'
(Device -> Ptr Device_T
deviceHandle (Device
device))
"pName" ::: Ptr CChar
pName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (PFN_vkVoidFunction
r)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkGetInstanceProcAddr
:: FunPtr (Ptr Instance_T -> Ptr CChar -> IO PFN_vkVoidFunction) -> Ptr Instance_T -> Ptr CChar -> IO PFN_vkVoidFunction
getInstanceProcAddr :: forall io
. (MonadIO io)
=>
Instance
->
("name" ::: ByteString)
-> io (PFN_vkVoidFunction)
getInstanceProcAddr :: forall (io :: * -> *).
MonadIO io =>
Instance -> ("name" ::: ByteString) -> io PFN_vkVoidFunction
getInstanceProcAddr Instance
instance' "name" ::: ByteString
name = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkGetInstanceProcAddrPtr :: FunPtr
(Ptr Instance_T
-> ("pName" ::: Ptr CChar) -> IO PFN_vkVoidFunction)
vkGetInstanceProcAddrPtr = InstanceCmds
-> FunPtr
(Ptr Instance_T
-> ("pName" ::: Ptr CChar) -> IO PFN_vkVoidFunction)
pVkGetInstanceProcAddr (case Instance
instance' of Instance{InstanceCmds
instanceCmds :: InstanceCmds
$sel:instanceCmds:Instance :: Instance -> InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Instance_T
-> ("pName" ::: Ptr CChar) -> IO PFN_vkVoidFunction)
vkGetInstanceProcAddrPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetInstanceProcAddr is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkGetInstanceProcAddr' :: Ptr Instance_T -> ("pName" ::: Ptr CChar) -> IO PFN_vkVoidFunction
vkGetInstanceProcAddr' = FunPtr
(Ptr Instance_T
-> ("pName" ::: Ptr CChar) -> IO PFN_vkVoidFunction)
-> Ptr Instance_T
-> ("pName" ::: Ptr CChar)
-> IO PFN_vkVoidFunction
mkVkGetInstanceProcAddr FunPtr
(Ptr Instance_T
-> ("pName" ::: Ptr CChar) -> IO PFN_vkVoidFunction)
vkGetInstanceProcAddrPtr
"pName" ::: Ptr CChar
pName <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a.
("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO a) -> IO a
useAsCString ("name" ::: ByteString
name)
PFN_vkVoidFunction
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetInstanceProcAddr" (Ptr Instance_T -> ("pName" ::: Ptr CChar) -> IO PFN_vkVoidFunction
vkGetInstanceProcAddr'
(Instance -> Ptr Instance_T
instanceHandle (Instance
instance'))
"pName" ::: Ptr CChar
pName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (PFN_vkVoidFunction
r)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkGetPhysicalDeviceProperties
:: FunPtr (Ptr PhysicalDevice_T -> Ptr PhysicalDeviceProperties -> IO ()) -> Ptr PhysicalDevice_T -> Ptr PhysicalDeviceProperties -> IO ()
getPhysicalDeviceProperties :: forall io
. (MonadIO io)
=>
PhysicalDevice
-> io (PhysicalDeviceProperties)
getPhysicalDeviceProperties :: forall (io :: * -> *).
MonadIO io =>
PhysicalDevice -> io PhysicalDeviceProperties
getPhysicalDeviceProperties PhysicalDevice
physicalDevice = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkGetPhysicalDevicePropertiesPtr :: FunPtr
(Ptr PhysicalDevice_T
-> ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO ())
vkGetPhysicalDevicePropertiesPtr = InstanceCmds
-> FunPtr
(Ptr PhysicalDevice_T
-> ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO ())
pVkGetPhysicalDeviceProperties (case PhysicalDevice
physicalDevice of PhysicalDevice{InstanceCmds
$sel:instanceCmds:PhysicalDevice :: PhysicalDevice -> InstanceCmds
instanceCmds :: InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr PhysicalDevice_T
-> ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO ())
vkGetPhysicalDevicePropertiesPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetPhysicalDeviceProperties is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkGetPhysicalDeviceProperties' :: Ptr PhysicalDevice_T
-> ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO ()
vkGetPhysicalDeviceProperties' = FunPtr
(Ptr PhysicalDevice_T
-> ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO ())
-> Ptr PhysicalDevice_T
-> ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> IO ()
mkVkGetPhysicalDeviceProperties FunPtr
(Ptr PhysicalDevice_T
-> ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO ())
vkGetPhysicalDevicePropertiesPtr
"pProperties" ::: Ptr PhysicalDeviceProperties
pPProperties <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @PhysicalDeviceProperties)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPhysicalDeviceProperties" (Ptr PhysicalDevice_T
-> ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO ()
vkGetPhysicalDeviceProperties'
(PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice))
("pProperties" ::: Ptr PhysicalDeviceProperties
pPProperties))
PhysicalDeviceProperties
pProperties <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PhysicalDeviceProperties "pProperties" ::: Ptr PhysicalDeviceProperties
pPProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (PhysicalDeviceProperties
pProperties)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkGetPhysicalDeviceQueueFamilyProperties
:: FunPtr (Ptr PhysicalDevice_T -> Ptr Word32 -> Ptr QueueFamilyProperties -> IO ()) -> Ptr PhysicalDevice_T -> Ptr Word32 -> Ptr QueueFamilyProperties -> IO ()
getPhysicalDeviceQueueFamilyProperties :: forall io
. (MonadIO io)
=>
PhysicalDevice
-> io (("queueFamilyProperties" ::: Vector QueueFamilyProperties))
getPhysicalDeviceQueueFamilyProperties :: forall (io :: * -> *).
MonadIO io =>
PhysicalDevice
-> io ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
getPhysicalDeviceQueueFamilyProperties PhysicalDevice
physicalDevice = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkGetPhysicalDeviceQueueFamilyPropertiesPtr :: FunPtr
(Ptr PhysicalDevice_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO ())
vkGetPhysicalDeviceQueueFamilyPropertiesPtr = InstanceCmds
-> FunPtr
(Ptr PhysicalDevice_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO ())
pVkGetPhysicalDeviceQueueFamilyProperties (case PhysicalDevice
physicalDevice of PhysicalDevice{InstanceCmds
instanceCmds :: InstanceCmds
$sel:instanceCmds:PhysicalDevice :: PhysicalDevice -> InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr PhysicalDevice_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO ())
vkGetPhysicalDeviceQueueFamilyPropertiesPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetPhysicalDeviceQueueFamilyProperties is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkGetPhysicalDeviceQueueFamilyProperties' :: Ptr PhysicalDevice_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO ()
vkGetPhysicalDeviceQueueFamilyProperties' = FunPtr
(Ptr PhysicalDevice_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO ())
-> Ptr PhysicalDevice_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO ()
mkVkGetPhysicalDeviceQueueFamilyProperties FunPtr
(Ptr PhysicalDevice_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO ())
vkGetPhysicalDeviceQueueFamilyPropertiesPtr
let physicalDevice' :: Ptr PhysicalDevice_T
physicalDevice' = PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)
"pPhysicalDeviceCount" ::: Ptr Word32
pPQueueFamilyPropertyCount <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @Word32 Int
4) forall a. Ptr a -> IO ()
free
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPhysicalDeviceQueueFamilyProperties" (Ptr PhysicalDevice_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO ()
vkGetPhysicalDeviceQueueFamilyProperties'
Ptr PhysicalDevice_T
physicalDevice'
("pPhysicalDeviceCount" ::: Ptr Word32
pPQueueFamilyPropertyCount)
(forall a. Ptr a
nullPtr))
Word32
pQueueFamilyPropertyCount <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPhysicalDeviceCount" ::: Ptr Word32
pPQueueFamilyPropertyCount
"pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
pPQueueFamilyProperties <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Int -> IO (Ptr a)
callocBytes @QueueFamilyProperties ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pQueueFamilyPropertyCount)) forall a. Num a => a -> a -> a
* Int
24)) forall a. Ptr a -> IO ()
free
[()]
_ <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Int
i -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => Ptr a -> IO b -> IO b
pokeZeroCStruct ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
pPQueueFamilyProperties forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i forall a. Num a => a -> a -> a
* Int
24) :: Ptr QueueFamilyProperties) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ ())) [Int
0..(forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pQueueFamilyPropertyCount)) forall a. Num a => a -> a -> a
- Int
1]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPhysicalDeviceQueueFamilyProperties" (Ptr PhysicalDevice_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO ()
vkGetPhysicalDeviceQueueFamilyProperties'
Ptr PhysicalDevice_T
physicalDevice'
("pPhysicalDeviceCount" ::: Ptr Word32
pPQueueFamilyPropertyCount)
(("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
pPQueueFamilyProperties)))
Word32
pQueueFamilyPropertyCount' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPhysicalDeviceCount" ::: Ptr Word32
pPQueueFamilyPropertyCount
"queueFamilyProperties" ::: Vector QueueFamilyProperties
pQueueFamilyProperties' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pQueueFamilyPropertyCount')) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @QueueFamilyProperties ((("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
pPQueueFamilyProperties) forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
24 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr QueueFamilyProperties)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ("queueFamilyProperties" ::: Vector QueueFamilyProperties
pQueueFamilyProperties')
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkGetPhysicalDeviceMemoryProperties
:: FunPtr (Ptr PhysicalDevice_T -> Ptr PhysicalDeviceMemoryProperties -> IO ()) -> Ptr PhysicalDevice_T -> Ptr PhysicalDeviceMemoryProperties -> IO ()
getPhysicalDeviceMemoryProperties :: forall io
. (MonadIO io)
=>
PhysicalDevice
-> io (PhysicalDeviceMemoryProperties)
getPhysicalDeviceMemoryProperties :: forall (io :: * -> *).
MonadIO io =>
PhysicalDevice -> io PhysicalDeviceMemoryProperties
getPhysicalDeviceMemoryProperties PhysicalDevice
physicalDevice = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkGetPhysicalDeviceMemoryPropertiesPtr :: FunPtr
(Ptr PhysicalDevice_T
-> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO ())
vkGetPhysicalDeviceMemoryPropertiesPtr = InstanceCmds
-> FunPtr
(Ptr PhysicalDevice_T
-> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO ())
pVkGetPhysicalDeviceMemoryProperties (case PhysicalDevice
physicalDevice of PhysicalDevice{InstanceCmds
instanceCmds :: InstanceCmds
$sel:instanceCmds:PhysicalDevice :: PhysicalDevice -> InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr PhysicalDevice_T
-> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO ())
vkGetPhysicalDeviceMemoryPropertiesPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetPhysicalDeviceMemoryProperties is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkGetPhysicalDeviceMemoryProperties' :: Ptr PhysicalDevice_T
-> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO ()
vkGetPhysicalDeviceMemoryProperties' = FunPtr
(Ptr PhysicalDevice_T
-> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO ())
-> Ptr PhysicalDevice_T
-> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO ()
mkVkGetPhysicalDeviceMemoryProperties FunPtr
(Ptr PhysicalDevice_T
-> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO ())
vkGetPhysicalDeviceMemoryPropertiesPtr
"pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
pPMemoryProperties <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @PhysicalDeviceMemoryProperties)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPhysicalDeviceMemoryProperties" (Ptr PhysicalDevice_T
-> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO ()
vkGetPhysicalDeviceMemoryProperties'
(PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice))
("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
pPMemoryProperties))
PhysicalDeviceMemoryProperties
pMemoryProperties <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PhysicalDeviceMemoryProperties "pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
pPMemoryProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (PhysicalDeviceMemoryProperties
pMemoryProperties)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkGetPhysicalDeviceFeatures
:: FunPtr (Ptr PhysicalDevice_T -> Ptr PhysicalDeviceFeatures -> IO ()) -> Ptr PhysicalDevice_T -> Ptr PhysicalDeviceFeatures -> IO ()
getPhysicalDeviceFeatures :: forall io
. (MonadIO io)
=>
PhysicalDevice
-> io (PhysicalDeviceFeatures)
getPhysicalDeviceFeatures :: forall (io :: * -> *).
MonadIO io =>
PhysicalDevice -> io PhysicalDeviceFeatures
getPhysicalDeviceFeatures PhysicalDevice
physicalDevice = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkGetPhysicalDeviceFeaturesPtr :: FunPtr
(Ptr PhysicalDevice_T
-> ("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO ())
vkGetPhysicalDeviceFeaturesPtr = InstanceCmds
-> FunPtr
(Ptr PhysicalDevice_T
-> ("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO ())
pVkGetPhysicalDeviceFeatures (case PhysicalDevice
physicalDevice of PhysicalDevice{InstanceCmds
instanceCmds :: InstanceCmds
$sel:instanceCmds:PhysicalDevice :: PhysicalDevice -> InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr PhysicalDevice_T
-> ("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO ())
vkGetPhysicalDeviceFeaturesPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetPhysicalDeviceFeatures is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkGetPhysicalDeviceFeatures' :: Ptr PhysicalDevice_T
-> ("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO ()
vkGetPhysicalDeviceFeatures' = FunPtr
(Ptr PhysicalDevice_T
-> ("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO ())
-> Ptr PhysicalDevice_T
-> ("pFeatures" ::: Ptr PhysicalDeviceFeatures)
-> IO ()
mkVkGetPhysicalDeviceFeatures FunPtr
(Ptr PhysicalDevice_T
-> ("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO ())
vkGetPhysicalDeviceFeaturesPtr
"pFeatures" ::: Ptr PhysicalDeviceFeatures
pPFeatures <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @PhysicalDeviceFeatures)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPhysicalDeviceFeatures" (Ptr PhysicalDevice_T
-> ("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO ()
vkGetPhysicalDeviceFeatures'
(PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice))
("pFeatures" ::: Ptr PhysicalDeviceFeatures
pPFeatures))
PhysicalDeviceFeatures
pFeatures <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PhysicalDeviceFeatures "pFeatures" ::: Ptr PhysicalDeviceFeatures
pPFeatures
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (PhysicalDeviceFeatures
pFeatures)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkGetPhysicalDeviceFormatProperties
:: FunPtr (Ptr PhysicalDevice_T -> Format -> Ptr FormatProperties -> IO ()) -> Ptr PhysicalDevice_T -> Format -> Ptr FormatProperties -> IO ()
getPhysicalDeviceFormatProperties :: forall io
. (MonadIO io)
=>
PhysicalDevice
->
Format
-> io (FormatProperties)
getPhysicalDeviceFormatProperties :: forall (io :: * -> *).
MonadIO io =>
PhysicalDevice -> Format -> io FormatProperties
getPhysicalDeviceFormatProperties PhysicalDevice
physicalDevice
Format
format = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkGetPhysicalDeviceFormatPropertiesPtr :: FunPtr
(Ptr PhysicalDevice_T
-> Format
-> ("pFormatProperties" ::: Ptr FormatProperties)
-> IO ())
vkGetPhysicalDeviceFormatPropertiesPtr = InstanceCmds
-> FunPtr
(Ptr PhysicalDevice_T
-> Format
-> ("pFormatProperties" ::: Ptr FormatProperties)
-> IO ())
pVkGetPhysicalDeviceFormatProperties (case PhysicalDevice
physicalDevice of PhysicalDevice{InstanceCmds
instanceCmds :: InstanceCmds
$sel:instanceCmds:PhysicalDevice :: PhysicalDevice -> InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr PhysicalDevice_T
-> Format
-> ("pFormatProperties" ::: Ptr FormatProperties)
-> IO ())
vkGetPhysicalDeviceFormatPropertiesPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetPhysicalDeviceFormatProperties is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkGetPhysicalDeviceFormatProperties' :: Ptr PhysicalDevice_T
-> Format
-> ("pFormatProperties" ::: Ptr FormatProperties)
-> IO ()
vkGetPhysicalDeviceFormatProperties' = FunPtr
(Ptr PhysicalDevice_T
-> Format
-> ("pFormatProperties" ::: Ptr FormatProperties)
-> IO ())
-> Ptr PhysicalDevice_T
-> Format
-> ("pFormatProperties" ::: Ptr FormatProperties)
-> IO ()
mkVkGetPhysicalDeviceFormatProperties FunPtr
(Ptr PhysicalDevice_T
-> Format
-> ("pFormatProperties" ::: Ptr FormatProperties)
-> IO ())
vkGetPhysicalDeviceFormatPropertiesPtr
"pFormatProperties" ::: Ptr FormatProperties
pPFormatProperties <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @FormatProperties)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPhysicalDeviceFormatProperties" (Ptr PhysicalDevice_T
-> Format
-> ("pFormatProperties" ::: Ptr FormatProperties)
-> IO ()
vkGetPhysicalDeviceFormatProperties'
(PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice))
(Format
format)
("pFormatProperties" ::: Ptr FormatProperties
pPFormatProperties))
FormatProperties
pFormatProperties <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @FormatProperties "pFormatProperties" ::: Ptr FormatProperties
pPFormatProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (FormatProperties
pFormatProperties)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"dynamic" mkVkGetPhysicalDeviceImageFormatProperties
:: FunPtr (Ptr PhysicalDevice_T -> Format -> ImageType -> ImageTiling -> ImageUsageFlags -> ImageCreateFlags -> Ptr ImageFormatProperties -> IO Result) -> Ptr PhysicalDevice_T -> Format -> ImageType -> ImageTiling -> ImageUsageFlags -> ImageCreateFlags -> Ptr ImageFormatProperties -> IO Result
getPhysicalDeviceImageFormatProperties :: forall io
. (MonadIO io)
=>
PhysicalDevice
->
Format
->
ImageType
->
ImageTiling
->
ImageUsageFlags
->
ImageCreateFlags
-> io (ImageFormatProperties)
getPhysicalDeviceImageFormatProperties :: forall (io :: * -> *).
MonadIO io =>
PhysicalDevice
-> Format
-> ImageType
-> ImageTiling
-> ImageUsageFlags
-> ImageCreateFlags
-> io ImageFormatProperties
getPhysicalDeviceImageFormatProperties PhysicalDevice
physicalDevice
Format
format
ImageType
type'
ImageTiling
tiling
ImageUsageFlags
usage
ImageCreateFlags
flags = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
let vkGetPhysicalDeviceImageFormatPropertiesPtr :: FunPtr
(Ptr PhysicalDevice_T
-> Format
-> ImageType
-> ImageTiling
-> ImageUsageFlags
-> ImageCreateFlags
-> ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO Result)
vkGetPhysicalDeviceImageFormatPropertiesPtr = InstanceCmds
-> FunPtr
(Ptr PhysicalDevice_T
-> Format
-> ImageType
-> ImageTiling
-> ImageUsageFlags
-> ImageCreateFlags
-> ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO Result)
pVkGetPhysicalDeviceImageFormatProperties (case PhysicalDevice
physicalDevice of PhysicalDevice{InstanceCmds
instanceCmds :: InstanceCmds
$sel:instanceCmds:PhysicalDevice :: PhysicalDevice -> InstanceCmds
instanceCmds} -> InstanceCmds
instanceCmds)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr PhysicalDevice_T
-> Format
-> ImageType
-> ImageTiling
-> ImageUsageFlags
-> ImageCreateFlags
-> ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO Result)
vkGetPhysicalDeviceImageFormatPropertiesPtr forall a. Eq a => a -> a -> Bool
/= forall a. FunPtr a
nullFunPtr) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"The function pointer for vkGetPhysicalDeviceImageFormatProperties is null" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
let vkGetPhysicalDeviceImageFormatProperties' :: Ptr PhysicalDevice_T
-> Format
-> ImageType
-> ImageTiling
-> ImageUsageFlags
-> ImageCreateFlags
-> ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO Result
vkGetPhysicalDeviceImageFormatProperties' = FunPtr
(Ptr PhysicalDevice_T
-> Format
-> ImageType
-> ImageTiling
-> ImageUsageFlags
-> ImageCreateFlags
-> ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO Result)
-> Ptr PhysicalDevice_T
-> Format
-> ImageType
-> ImageTiling
-> ImageUsageFlags
-> ImageCreateFlags
-> ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO Result
mkVkGetPhysicalDeviceImageFormatProperties FunPtr
(Ptr PhysicalDevice_T
-> Format
-> ImageType
-> ImageTiling
-> ImageUsageFlags
-> ImageCreateFlags
-> ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO Result)
vkGetPhysicalDeviceImageFormatPropertiesPtr
"pImageFormatProperties" ::: Ptr ImageFormatProperties
pPImageFormatProperties <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @ImageFormatProperties)
Result
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. String -> IO a -> IO a
traceAroundEvent String
"vkGetPhysicalDeviceImageFormatProperties" (Ptr PhysicalDevice_T
-> Format
-> ImageType
-> ImageTiling
-> ImageUsageFlags
-> ImageCreateFlags
-> ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO Result
vkGetPhysicalDeviceImageFormatProperties'
(PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice))
(Format
format)
(ImageType
type')
(ImageTiling
tiling)
(ImageUsageFlags
usage)
(ImageCreateFlags
flags)
("pImageFormatProperties" ::: Ptr ImageFormatProperties
pPImageFormatProperties))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
ImageFormatProperties
pImageFormatProperties <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ImageFormatProperties "pImageFormatProperties" ::: Ptr ImageFormatProperties
pPImageFormatProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (ImageFormatProperties
pImageFormatProperties)
data PhysicalDeviceProperties = PhysicalDeviceProperties
{
PhysicalDeviceProperties -> Word32
apiVersion :: Word32
,
PhysicalDeviceProperties -> Word32
driverVersion :: Word32
,
PhysicalDeviceProperties -> Word32
vendorID :: Word32
,
PhysicalDeviceProperties -> Word32
deviceID :: Word32
,
PhysicalDeviceProperties -> PhysicalDeviceType
deviceType :: PhysicalDeviceType
,
PhysicalDeviceProperties -> "name" ::: ByteString
deviceName :: ByteString
,
PhysicalDeviceProperties -> "name" ::: ByteString
pipelineCacheUUID :: ByteString
,
PhysicalDeviceProperties -> PhysicalDeviceLimits
limits :: PhysicalDeviceLimits
,
PhysicalDeviceProperties -> PhysicalDeviceSparseProperties
sparseProperties :: PhysicalDeviceSparseProperties
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceProperties)
#endif
deriving instance Show PhysicalDeviceProperties
instance ToCStruct PhysicalDeviceProperties where
withCStruct :: forall b.
PhysicalDeviceProperties
-> (("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO b)
-> IO b
withCStruct PhysicalDeviceProperties
x ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
824 forall a b. (a -> b) -> a -> b
$ \"pProperties" ::: Ptr PhysicalDeviceProperties
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr PhysicalDeviceProperties
p PhysicalDeviceProperties
x (("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO b
f "pProperties" ::: Ptr PhysicalDeviceProperties
p)
pokeCStruct :: forall b.
("pProperties" ::: Ptr PhysicalDeviceProperties)
-> PhysicalDeviceProperties -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr PhysicalDeviceProperties
p PhysicalDeviceProperties{Word32
"name" ::: ByteString
PhysicalDeviceSparseProperties
PhysicalDeviceLimits
PhysicalDeviceType
sparseProperties :: PhysicalDeviceSparseProperties
limits :: PhysicalDeviceLimits
pipelineCacheUUID :: "name" ::: ByteString
deviceName :: "name" ::: ByteString
deviceType :: PhysicalDeviceType
deviceID :: Word32
vendorID :: Word32
driverVersion :: Word32
apiVersion :: Word32
$sel:sparseProperties:PhysicalDeviceProperties :: PhysicalDeviceProperties -> PhysicalDeviceSparseProperties
$sel:limits:PhysicalDeviceProperties :: PhysicalDeviceProperties -> PhysicalDeviceLimits
$sel:pipelineCacheUUID:PhysicalDeviceProperties :: PhysicalDeviceProperties -> "name" ::: ByteString
$sel:deviceName:PhysicalDeviceProperties :: PhysicalDeviceProperties -> "name" ::: ByteString
$sel:deviceType:PhysicalDeviceProperties :: PhysicalDeviceProperties -> PhysicalDeviceType
$sel:deviceID:PhysicalDeviceProperties :: PhysicalDeviceProperties -> Word32
$sel:vendorID:PhysicalDeviceProperties :: PhysicalDeviceProperties -> Word32
$sel:driverVersion:PhysicalDeviceProperties :: PhysicalDeviceProperties -> Word32
$sel:apiVersion:PhysicalDeviceProperties :: PhysicalDeviceProperties -> Word32
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) (Word32
apiVersion)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32)) (Word32
driverVersion)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32)) (Word32
vendorID)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Word32)) (Word32
deviceID)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PhysicalDeviceType)) (PhysicalDeviceType
deviceType)
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ("name" ::: ByteString) -> IO ()
pokeFixedLengthNullTerminatedByteString (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr (FixedArray MAX_PHYSICAL_DEVICE_NAME_SIZE CChar))) ("name" ::: ByteString
deviceName)
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> ("name" ::: ByteString) -> IO ()
pokeFixedLengthByteString (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
276 :: Ptr (FixedArray UUID_SIZE Word8))) ("name" ::: ByteString
pipelineCacheUUID)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
296 :: Ptr PhysicalDeviceLimits)) (PhysicalDeviceLimits
limits)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
800 :: Ptr PhysicalDeviceSparseProperties)) (PhysicalDeviceSparseProperties
sparseProperties)
IO b
f
cStructSize :: Int
cStructSize = Int
824
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO b -> IO b
pokeZeroCStruct "pProperties" ::: Ptr PhysicalDeviceProperties
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PhysicalDeviceType)) (forall a. Zero a => a
zero)
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ("name" ::: ByteString) -> IO ()
pokeFixedLengthNullTerminatedByteString (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr (FixedArray MAX_PHYSICAL_DEVICE_NAME_SIZE CChar))) (forall a. Monoid a => a
mempty)
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> ("name" ::: ByteString) -> IO ()
pokeFixedLengthByteString (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
276 :: Ptr (FixedArray UUID_SIZE Word8))) (forall a. Monoid a => a
mempty)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
296 :: Ptr PhysicalDeviceLimits)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
800 :: Ptr PhysicalDeviceSparseProperties)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct PhysicalDeviceProperties where
peekCStruct :: ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> IO PhysicalDeviceProperties
peekCStruct "pProperties" ::: Ptr PhysicalDeviceProperties
p = do
Word32
apiVersion <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32))
Word32
driverVersion <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32))
Word32
vendorID <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32))
Word32
deviceID <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Word32))
PhysicalDeviceType
deviceType <- forall a. Storable a => Ptr a -> IO a
peek @PhysicalDeviceType (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr PhysicalDeviceType))
"name" ::: ByteString
deviceName <- ("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString)
packCString (forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr (FixedArray MAX_PHYSICAL_DEVICE_NAME_SIZE CChar))))
"name" ::: ByteString
pipelineCacheUUID <- forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> IO ("name" ::: ByteString)
peekByteStringFromSizedVectorPtr (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
276 :: Ptr (FixedArray UUID_SIZE Word8)))
PhysicalDeviceLimits
limits <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PhysicalDeviceLimits (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
296 :: Ptr PhysicalDeviceLimits))
PhysicalDeviceSparseProperties
sparseProperties <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PhysicalDeviceSparseProperties (("pProperties" ::: Ptr PhysicalDeviceProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
800 :: Ptr PhysicalDeviceSparseProperties))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word32
-> Word32
-> Word32
-> Word32
-> PhysicalDeviceType
-> ("name" ::: ByteString)
-> ("name" ::: ByteString)
-> PhysicalDeviceLimits
-> PhysicalDeviceSparseProperties
-> PhysicalDeviceProperties
PhysicalDeviceProperties
Word32
apiVersion
Word32
driverVersion
Word32
vendorID
Word32
deviceID
PhysicalDeviceType
deviceType
"name" ::: ByteString
deviceName
"name" ::: ByteString
pipelineCacheUUID
PhysicalDeviceLimits
limits
PhysicalDeviceSparseProperties
sparseProperties
instance Storable PhysicalDeviceProperties where
sizeOf :: PhysicalDeviceProperties -> Int
sizeOf ~PhysicalDeviceProperties
_ = Int
824
alignment :: PhysicalDeviceProperties -> Int
alignment ~PhysicalDeviceProperties
_ = Int
8
peek :: ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> IO PhysicalDeviceProperties
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> PhysicalDeviceProperties -> IO ()
poke "pProperties" ::: Ptr PhysicalDeviceProperties
ptr PhysicalDeviceProperties
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pProperties" ::: Ptr PhysicalDeviceProperties
ptr PhysicalDeviceProperties
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDeviceProperties where
zero :: PhysicalDeviceProperties
zero = Word32
-> Word32
-> Word32
-> Word32
-> PhysicalDeviceType
-> ("name" ::: ByteString)
-> ("name" ::: ByteString)
-> PhysicalDeviceLimits
-> PhysicalDeviceSparseProperties
-> PhysicalDeviceProperties
PhysicalDeviceProperties
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Monoid a => a
mempty
forall a. Monoid a => a
mempty
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data ApplicationInfo = ApplicationInfo
{
ApplicationInfo -> Maybe ("name" ::: ByteString)
applicationName :: Maybe ByteString
,
ApplicationInfo -> Word32
applicationVersion :: Word32
,
ApplicationInfo -> Maybe ("name" ::: ByteString)
engineName :: Maybe ByteString
,
ApplicationInfo -> Word32
engineVersion :: Word32
,
ApplicationInfo -> Word32
apiVersion :: Word32
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ApplicationInfo)
#endif
deriving instance Show ApplicationInfo
instance ToCStruct ApplicationInfo where
withCStruct :: forall b. ApplicationInfo -> (Ptr ApplicationInfo -> IO b) -> IO b
withCStruct ApplicationInfo
x Ptr ApplicationInfo -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
48 forall a b. (a -> b) -> a -> b
$ \Ptr ApplicationInfo
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ApplicationInfo
p ApplicationInfo
x (Ptr ApplicationInfo -> IO b
f Ptr ApplicationInfo
p)
pokeCStruct :: forall b. Ptr ApplicationInfo -> ApplicationInfo -> IO b -> IO b
pokeCStruct Ptr ApplicationInfo
p ApplicationInfo{Maybe ("name" ::: ByteString)
Word32
apiVersion :: Word32
engineVersion :: Word32
engineName :: Maybe ("name" ::: ByteString)
applicationVersion :: Word32
applicationName :: Maybe ("name" ::: ByteString)
$sel:apiVersion:ApplicationInfo :: ApplicationInfo -> Word32
$sel:engineVersion:ApplicationInfo :: ApplicationInfo -> Word32
$sel:engineName:ApplicationInfo :: ApplicationInfo -> Maybe ("name" ::: ByteString)
$sel:applicationVersion:ApplicationInfo :: ApplicationInfo -> Word32
$sel:applicationName:ApplicationInfo :: ApplicationInfo -> Maybe ("name" ::: ByteString)
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_APPLICATION_INFO)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
"pName" ::: Ptr CChar
pApplicationName'' <- case (Maybe ("name" ::: ByteString)
applicationName) of
Maybe ("name" ::: ByteString)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
Just "name" ::: ByteString
j -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a.
("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO a) -> IO a
useAsCString ("name" ::: ByteString
j)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr CChar))) "pName" ::: Ptr CChar
pApplicationName''
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Word32
applicationVersion)
"pName" ::: Ptr CChar
pEngineName'' <- case (Maybe ("name" ::: ByteString)
engineName) of
Maybe ("name" ::: ByteString)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
Just "name" ::: ByteString
j -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a.
("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO a) -> IO a
useAsCString ("name" ::: ByteString
j)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr CChar))) "pName" ::: Ptr CChar
pEngineName''
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word32)) (Word32
engineVersion)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Word32)) (Word32
apiVersion)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = Int
48
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. Ptr ApplicationInfo -> IO b -> IO b
pokeZeroCStruct Ptr ApplicationInfo
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_APPLICATION_INFO)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Word32)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct ApplicationInfo where
peekCStruct :: Ptr ApplicationInfo -> IO ApplicationInfo
peekCStruct Ptr ApplicationInfo
p = do
"pName" ::: Ptr CChar
pApplicationName <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr CChar) ((Ptr ApplicationInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr (Ptr CChar)))
Maybe ("name" ::: ByteString)
pApplicationName' <- forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek (\"pName" ::: Ptr CChar
j -> ("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString)
packCString ("pName" ::: Ptr CChar
j)) "pName" ::: Ptr CChar
pApplicationName
Word32
applicationVersion <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr ApplicationInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32))
"pName" ::: Ptr CChar
pEngineName <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr CChar) ((Ptr ApplicationInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr (Ptr CChar)))
Maybe ("name" ::: ByteString)
pEngineName' <- forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek (\"pName" ::: Ptr CChar
j -> ("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString)
packCString ("pName" ::: Ptr CChar
j)) "pName" ::: Ptr CChar
pEngineName
Word32
engineVersion <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr ApplicationInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word32))
Word32
apiVersion <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr ApplicationInfo
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Word32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe ("name" ::: ByteString)
-> Word32
-> Maybe ("name" ::: ByteString)
-> Word32
-> Word32
-> ApplicationInfo
ApplicationInfo
Maybe ("name" ::: ByteString)
pApplicationName'
Word32
applicationVersion
Maybe ("name" ::: ByteString)
pEngineName'
Word32
engineVersion
Word32
apiVersion
instance Zero ApplicationInfo where
zero :: ApplicationInfo
zero = Maybe ("name" ::: ByteString)
-> Word32
-> Maybe ("name" ::: ByteString)
-> Word32
-> Word32
-> ApplicationInfo
ApplicationInfo
forall a. Maybe a
Nothing
forall a. Zero a => a
zero
forall a. Maybe a
Nothing
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data InstanceCreateInfo (es :: [Type]) = InstanceCreateInfo
{
forall (es :: [*]). InstanceCreateInfo es -> Chain es
next :: Chain es
,
forall (es :: [*]). InstanceCreateInfo es -> InstanceCreateFlags
flags :: InstanceCreateFlags
,
forall (es :: [*]). InstanceCreateInfo es -> Maybe ApplicationInfo
applicationInfo :: Maybe ApplicationInfo
,
forall (es :: [*]).
InstanceCreateInfo es -> Vector ("name" ::: ByteString)
enabledLayerNames :: Vector ByteString
,
forall (es :: [*]).
InstanceCreateInfo es -> Vector ("name" ::: ByteString)
enabledExtensionNames :: Vector ByteString
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (InstanceCreateInfo (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (InstanceCreateInfo es)
instance Extensible InstanceCreateInfo where
extensibleTypeName :: String
extensibleTypeName = String
"InstanceCreateInfo"
setNext :: forall (ds :: [*]) (es :: [*]).
InstanceCreateInfo ds -> Chain es -> InstanceCreateInfo es
setNext InstanceCreateInfo{Maybe ApplicationInfo
Vector ("name" ::: ByteString)
Chain ds
InstanceCreateFlags
enabledExtensionNames :: Vector ("name" ::: ByteString)
enabledLayerNames :: Vector ("name" ::: ByteString)
applicationInfo :: Maybe ApplicationInfo
flags :: InstanceCreateFlags
next :: Chain ds
$sel:enabledExtensionNames:InstanceCreateInfo :: forall (es :: [*]).
InstanceCreateInfo es -> Vector ("name" ::: ByteString)
$sel:enabledLayerNames:InstanceCreateInfo :: forall (es :: [*]).
InstanceCreateInfo es -> Vector ("name" ::: ByteString)
$sel:applicationInfo:InstanceCreateInfo :: forall (es :: [*]). InstanceCreateInfo es -> Maybe ApplicationInfo
$sel:flags:InstanceCreateInfo :: forall (es :: [*]). InstanceCreateInfo es -> InstanceCreateFlags
$sel:next:InstanceCreateInfo :: forall (es :: [*]). InstanceCreateInfo es -> Chain es
..} Chain es
next' = InstanceCreateInfo{$sel:next:InstanceCreateInfo :: Chain es
next = Chain es
next', Maybe ApplicationInfo
Vector ("name" ::: ByteString)
InstanceCreateFlags
enabledExtensionNames :: Vector ("name" ::: ByteString)
enabledLayerNames :: Vector ("name" ::: ByteString)
applicationInfo :: Maybe ApplicationInfo
flags :: InstanceCreateFlags
$sel:enabledExtensionNames:InstanceCreateInfo :: Vector ("name" ::: ByteString)
$sel:enabledLayerNames:InstanceCreateInfo :: Vector ("name" ::: ByteString)
$sel:applicationInfo:InstanceCreateInfo :: Maybe ApplicationInfo
$sel:flags:InstanceCreateInfo :: InstanceCreateFlags
..}
getNext :: forall (es :: [*]). InstanceCreateInfo es -> Chain es
getNext InstanceCreateInfo{Maybe ApplicationInfo
Vector ("name" ::: ByteString)
Chain es
InstanceCreateFlags
enabledExtensionNames :: Vector ("name" ::: ByteString)
enabledLayerNames :: Vector ("name" ::: ByteString)
applicationInfo :: Maybe ApplicationInfo
flags :: InstanceCreateFlags
next :: Chain es
$sel:enabledExtensionNames:InstanceCreateInfo :: forall (es :: [*]).
InstanceCreateInfo es -> Vector ("name" ::: ByteString)
$sel:enabledLayerNames:InstanceCreateInfo :: forall (es :: [*]).
InstanceCreateInfo es -> Vector ("name" ::: ByteString)
$sel:applicationInfo:InstanceCreateInfo :: forall (es :: [*]). InstanceCreateInfo es -> Maybe ApplicationInfo
$sel:flags:InstanceCreateInfo :: forall (es :: [*]). InstanceCreateInfo es -> InstanceCreateFlags
$sel:next:InstanceCreateInfo :: forall (es :: [*]). InstanceCreateInfo es -> Chain es
..} = Chain es
next
extends :: forall e b proxy. Typeable e => proxy e -> (Extends InstanceCreateInfo e => b) -> Maybe b
extends :: forall e b (proxy :: * -> *).
Typeable e =>
proxy e -> (Extends InstanceCreateInfo e => b) -> Maybe b
extends proxy e
_ Extends InstanceCreateInfo e => b
f
| Just e :~: DirectDriverLoadingListLUNARG
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @DirectDriverLoadingListLUNARG = forall a. a -> Maybe a
Just Extends InstanceCreateInfo e => b
f
| Just e :~: ExportMetalObjectCreateInfoEXT
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ExportMetalObjectCreateInfoEXT = forall a. a -> Maybe a
Just Extends InstanceCreateInfo e => b
f
| Just e :~: DebugUtilsMessengerCreateInfoEXT
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @DebugUtilsMessengerCreateInfoEXT = forall a. a -> Maybe a
Just Extends InstanceCreateInfo e => b
f
| Just e :~: ValidationFeaturesEXT
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ValidationFeaturesEXT = forall a. a -> Maybe a
Just Extends InstanceCreateInfo e => b
f
| Just e :~: ValidationFlagsEXT
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ValidationFlagsEXT = forall a. a -> Maybe a
Just Extends InstanceCreateInfo e => b
f
| Just e :~: DebugReportCallbackCreateInfoEXT
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @DebugReportCallbackCreateInfoEXT = forall a. a -> Maybe a
Just Extends InstanceCreateInfo e => b
f
| Bool
otherwise = forall a. Maybe a
Nothing
instance ( Extendss InstanceCreateInfo es
, PokeChain es ) => ToCStruct (InstanceCreateInfo es) where
withCStruct :: forall b.
InstanceCreateInfo es
-> (Ptr (InstanceCreateInfo es) -> IO b) -> IO b
withCStruct InstanceCreateInfo es
x Ptr (InstanceCreateInfo es) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
64 forall a b. (a -> b) -> a -> b
$ \Ptr (InstanceCreateInfo es)
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (InstanceCreateInfo es)
p InstanceCreateInfo es
x (Ptr (InstanceCreateInfo es) -> IO b
f Ptr (InstanceCreateInfo es)
p)
pokeCStruct :: forall b.
Ptr (InstanceCreateInfo es)
-> InstanceCreateInfo es -> IO b -> IO b
pokeCStruct Ptr (InstanceCreateInfo es)
p InstanceCreateInfo{Maybe ApplicationInfo
Vector ("name" ::: ByteString)
Chain es
InstanceCreateFlags
enabledExtensionNames :: Vector ("name" ::: ByteString)
enabledLayerNames :: Vector ("name" ::: ByteString)
applicationInfo :: Maybe ApplicationInfo
flags :: InstanceCreateFlags
next :: Chain es
$sel:enabledExtensionNames:InstanceCreateInfo :: forall (es :: [*]).
InstanceCreateInfo es -> Vector ("name" ::: ByteString)
$sel:enabledLayerNames:InstanceCreateInfo :: forall (es :: [*]).
InstanceCreateInfo es -> Vector ("name" ::: ByteString)
$sel:applicationInfo:InstanceCreateInfo :: forall (es :: [*]). InstanceCreateInfo es -> Maybe ApplicationInfo
$sel:flags:InstanceCreateInfo :: forall (es :: [*]). InstanceCreateInfo es -> InstanceCreateFlags
$sel:next:InstanceCreateInfo :: forall (es :: [*]). InstanceCreateInfo es -> Chain es
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_INSTANCE_CREATE_INFO)
Ptr ()
pNext'' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext''
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr InstanceCreateFlags)) (InstanceCreateFlags
flags)
Ptr ApplicationInfo
pApplicationInfo'' <- case (Maybe ApplicationInfo
applicationInfo) of
Maybe ApplicationInfo
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Ptr a
nullPtr
Just ApplicationInfo
j -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (ApplicationInfo
j)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr ApplicationInfo))) Ptr ApplicationInfo
pApplicationInfo''
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector ("name" ::: ByteString)
enabledLayerNames)) :: Word32))
Ptr ("pName" ::: Ptr CChar)
pPpEnabledLayerNames' <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @(Ptr CChar) ((forall a. Vector a -> Int
Data.Vector.length (Vector ("name" ::: ByteString)
enabledLayerNames)) forall a. Num a => a -> a -> a
* Int
8)
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i "name" ::: ByteString
e -> do
"pName" ::: Ptr CChar
ppEnabledLayerNames'' <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a.
("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO a) -> IO a
useAsCString ("name" ::: ByteString
e)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ("pName" ::: Ptr CChar)
pPpEnabledLayerNames' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr CChar)) "pName" ::: Ptr CChar
ppEnabledLayerNames'') (Vector ("name" ::: ByteString)
enabledLayerNames)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr (Ptr CChar)))) (Ptr ("pName" ::: Ptr CChar)
pPpEnabledLayerNames')
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Word32)) ((forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector ("name" ::: ByteString)
enabledExtensionNames)) :: Word32))
Ptr ("pName" ::: Ptr CChar)
pPpEnabledExtensionNames' <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes @(Ptr CChar) ((forall a. Vector a -> Int
Data.Vector.length (Vector ("name" ::: ByteString)
enabledExtensionNames)) forall a. Num a => a -> a -> a
* Int
8)
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i "name" ::: ByteString
e -> do
"pName" ::: Ptr CChar
ppEnabledExtensionNames'' <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a.
("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO a) -> IO a
useAsCString ("name" ::: ByteString
e)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ("pName" ::: Ptr CChar)
pPpEnabledExtensionNames' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr CChar)) "pName" ::: Ptr CChar
ppEnabledExtensionNames'') (Vector ("name" ::: ByteString)
enabledExtensionNames)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr (Ptr (Ptr CChar)))) (Ptr ("pName" ::: Ptr CChar)
pPpEnabledExtensionNames')
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = Int
64
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. Ptr (InstanceCreateInfo es) -> IO b -> IO b
pokeZeroCStruct Ptr (InstanceCreateInfo es)
p IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_INSTANCE_CREATE_INFO)
Ptr ()
pNext' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Ptr a -> Ptr b
castPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) Ptr ()
pNext'
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
instance ( Extendss InstanceCreateInfo es
, PeekChain es ) => FromCStruct (InstanceCreateInfo es) where
peekCStruct :: Ptr (InstanceCreateInfo es) -> IO (InstanceCreateInfo es)
peekCStruct Ptr (InstanceCreateInfo es)
p = do
Ptr ()
pNext <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (InstanceCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ())))
Chain es
next <- forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
InstanceCreateFlags
flags <- forall a. Storable a => Ptr a -> IO a
peek @InstanceCreateFlags ((Ptr (InstanceCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr InstanceCreateFlags))
Ptr ApplicationInfo
pApplicationInfo <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr ApplicationInfo) ((Ptr (InstanceCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr ApplicationInfo)))
Maybe ApplicationInfo
pApplicationInfo' <- forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek (\Ptr ApplicationInfo
j -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ApplicationInfo (Ptr ApplicationInfo
j)) Ptr ApplicationInfo
pApplicationInfo
Word32
enabledLayerCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (InstanceCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32))
Ptr ("pName" ::: Ptr CChar)
ppEnabledLayerNames <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr (Ptr CChar)) ((Ptr (InstanceCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr (Ptr (Ptr CChar))))
Vector ("name" ::: ByteString)
ppEnabledLayerNames' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
enabledLayerCount) (\Int
i -> ("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString)
packCString forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek ((Ptr ("pName" ::: Ptr CChar)
ppEnabledLayerNames forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr CChar))))
Word32
enabledExtensionCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (InstanceCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Word32))
Ptr ("pName" ::: Ptr CChar)
ppEnabledExtensionNames <- forall a. Storable a => Ptr a -> IO a
peek @(Ptr (Ptr CChar)) ((Ptr (InstanceCreateInfo es)
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr (Ptr (Ptr CChar))))
Vector ("name" ::: ByteString)
ppEnabledExtensionNames' <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
enabledExtensionCount) (\Int
i -> ("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString)
packCString forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek ((Ptr ("pName" ::: Ptr CChar)
ppEnabledExtensionNames forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr CChar))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (es :: [*]).
Chain es
-> InstanceCreateFlags
-> Maybe ApplicationInfo
-> Vector ("name" ::: ByteString)
-> Vector ("name" ::: ByteString)
-> InstanceCreateInfo es
InstanceCreateInfo
Chain es
next
InstanceCreateFlags
flags
Maybe ApplicationInfo
pApplicationInfo'
Vector ("name" ::: ByteString)
ppEnabledLayerNames'
Vector ("name" ::: ByteString)
ppEnabledExtensionNames'
instance es ~ '[] => Zero (InstanceCreateInfo es) where
zero :: InstanceCreateInfo es
zero = forall (es :: [*]).
Chain es
-> InstanceCreateFlags
-> Maybe ApplicationInfo
-> Vector ("name" ::: ByteString)
-> Vector ("name" ::: ByteString)
-> InstanceCreateInfo es
InstanceCreateInfo
()
forall a. Zero a => a
zero
forall a. Maybe a
Nothing
forall a. Monoid a => a
mempty
forall a. Monoid a => a
mempty
data QueueFamilyProperties = QueueFamilyProperties
{
QueueFamilyProperties -> QueueFlags
queueFlags :: QueueFlags
,
QueueFamilyProperties -> Word32
queueCount :: Word32
,
QueueFamilyProperties -> Word32
timestampValidBits :: Word32
,
QueueFamilyProperties -> Extent3D
minImageTransferGranularity :: Extent3D
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (QueueFamilyProperties)
#endif
deriving instance Show QueueFamilyProperties
instance ToCStruct QueueFamilyProperties where
withCStruct :: forall b.
QueueFamilyProperties
-> (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO b)
-> IO b
withCStruct QueueFamilyProperties
x ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \"pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p QueueFamilyProperties
x (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties) -> IO b
f "pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p)
pokeCStruct :: forall b.
("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> QueueFamilyProperties -> IO b -> IO b
pokeCStruct "pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p QueueFamilyProperties{Word32
Extent3D
QueueFlags
minImageTransferGranularity :: Extent3D
timestampValidBits :: Word32
queueCount :: Word32
queueFlags :: QueueFlags
$sel:minImageTransferGranularity:QueueFamilyProperties :: QueueFamilyProperties -> Extent3D
$sel:timestampValidBits:QueueFamilyProperties :: QueueFamilyProperties -> Word32
$sel:queueCount:QueueFamilyProperties :: QueueFamilyProperties -> Word32
$sel:queueFlags:QueueFamilyProperties :: QueueFamilyProperties -> QueueFlags
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr QueueFlags)) (QueueFlags
queueFlags)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32)) (Word32
queueCount)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32)) (Word32
timestampValidBits)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Extent3D)) (Extent3D
minImageTransferGranularity)
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
4
pokeZeroCStruct :: forall b.
("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO b -> IO b
pokeZeroCStruct "pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Extent3D)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct QueueFamilyProperties where
peekCStruct :: ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO QueueFamilyProperties
peekCStruct "pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p = do
QueueFlags
queueFlags <- forall a. Storable a => Ptr a -> IO a
peek @QueueFlags (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr QueueFlags))
Word32
queueCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32))
Word32
timestampValidBits <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32))
Extent3D
minImageTransferGranularity <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent3D (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Extent3D))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ QueueFlags -> Word32 -> Word32 -> Extent3D -> QueueFamilyProperties
QueueFamilyProperties
QueueFlags
queueFlags
Word32
queueCount
Word32
timestampValidBits
Extent3D
minImageTransferGranularity
instance Storable QueueFamilyProperties where
sizeOf :: QueueFamilyProperties -> Int
sizeOf ~QueueFamilyProperties
_ = Int
24
alignment :: QueueFamilyProperties -> Int
alignment ~QueueFamilyProperties
_ = Int
4
peek :: ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO QueueFamilyProperties
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> QueueFamilyProperties -> IO ()
poke "pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
ptr QueueFamilyProperties
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
ptr QueueFamilyProperties
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero QueueFamilyProperties where
zero :: QueueFamilyProperties
zero = QueueFlags -> Word32 -> Word32 -> Extent3D -> QueueFamilyProperties
QueueFamilyProperties
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data PhysicalDeviceMemoryProperties = PhysicalDeviceMemoryProperties
{
PhysicalDeviceMemoryProperties -> Word32
memoryTypeCount :: Word32
,
PhysicalDeviceMemoryProperties -> Vector MemoryType
memoryTypes :: Vector MemoryType
,
PhysicalDeviceMemoryProperties -> Word32
memoryHeapCount :: Word32
,
PhysicalDeviceMemoryProperties -> Vector MemoryHeap
memoryHeaps :: Vector MemoryHeap
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceMemoryProperties)
#endif
deriving instance Show PhysicalDeviceMemoryProperties
instance ToCStruct PhysicalDeviceMemoryProperties where
withCStruct :: forall b.
PhysicalDeviceMemoryProperties
-> (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO b)
-> IO b
withCStruct PhysicalDeviceMemoryProperties
x ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
520 forall a b. (a -> b) -> a -> b
$ \"pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p PhysicalDeviceMemoryProperties
x (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO b
f "pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p)
pokeCStruct :: forall b.
("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> PhysicalDeviceMemoryProperties -> IO b -> IO b
pokeCStruct "pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p PhysicalDeviceMemoryProperties{Word32
Vector MemoryType
Vector MemoryHeap
memoryHeaps :: Vector MemoryHeap
memoryHeapCount :: Word32
memoryTypes :: Vector MemoryType
memoryTypeCount :: Word32
$sel:memoryHeaps:PhysicalDeviceMemoryProperties :: PhysicalDeviceMemoryProperties -> Vector MemoryHeap
$sel:memoryHeapCount:PhysicalDeviceMemoryProperties :: PhysicalDeviceMemoryProperties -> Word32
$sel:memoryTypes:PhysicalDeviceMemoryProperties :: PhysicalDeviceMemoryProperties -> Vector MemoryType
$sel:memoryTypeCount:PhysicalDeviceMemoryProperties :: PhysicalDeviceMemoryProperties -> Word32
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) (Word32
memoryTypeCount)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector MemoryType
memoryTypes)) forall a. Ord a => a -> a -> Bool
<= forall a. Integral a => a
MAX_MEMORY_TYPES) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"memoryTypes is too long, a maximum of MAX_MEMORY_TYPES elements are allowed" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i MemoryType
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke ((forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr (FixedArray MAX_MEMORY_TYPES MemoryType)))) forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MemoryType) (MemoryType
e)) (Vector MemoryType
memoryTypes)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
260 :: Ptr Word32)) (Word32
memoryHeapCount)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((forall a. Vector a -> Int
Data.Vector.length forall a b. (a -> b) -> a -> b
$ (Vector MemoryHeap
memoryHeaps)) forall a. Ord a => a -> a -> Bool
<= forall a. Integral a => a
MAX_MEMORY_HEAPS) forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InvalidArgument String
"" String
"memoryHeaps is too long, a maximum of MAX_MEMORY_HEAPS elements are allowed" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\Int
i MemoryHeap
e -> forall a. Storable a => Ptr a -> a -> IO ()
poke ((forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
264 :: Ptr (FixedArray MAX_MEMORY_HEAPS MemoryHeap)))) forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
16 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MemoryHeap) (MemoryHeap
e)) (Vector MemoryHeap
memoryHeaps)
IO b
f
cStructSize :: Int
cStructSize = Int
520
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO b -> IO b
pokeZeroCStruct "pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
260 :: Ptr Word32)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct PhysicalDeviceMemoryProperties where
peekCStruct :: ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO PhysicalDeviceMemoryProperties
peekCStruct "pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p = do
Word32
memoryTypeCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32))
Vector MemoryType
memoryTypes <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a. Integral a => a
MAX_MEMORY_TYPES) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @MemoryType (((forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr @MemoryType (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr (FixedArray MAX_MEMORY_TYPES MemoryType)))) forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
8 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MemoryType)))
Word32
memoryHeapCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
260 :: Ptr Word32))
Vector MemoryHeap
memoryHeaps <- forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (forall a. Integral a => a
MAX_MEMORY_HEAPS) (\Int
i -> forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @MemoryHeap (((forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr @MemoryHeap (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
264 :: Ptr (FixedArray MAX_MEMORY_HEAPS MemoryHeap)))) forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
16 forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MemoryHeap)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word32
-> Vector MemoryType
-> Word32
-> Vector MemoryHeap
-> PhysicalDeviceMemoryProperties
PhysicalDeviceMemoryProperties
Word32
memoryTypeCount Vector MemoryType
memoryTypes Word32
memoryHeapCount Vector MemoryHeap
memoryHeaps
instance Storable PhysicalDeviceMemoryProperties where
sizeOf :: PhysicalDeviceMemoryProperties -> Int
sizeOf ~PhysicalDeviceMemoryProperties
_ = Int
520
alignment :: PhysicalDeviceMemoryProperties -> Int
alignment ~PhysicalDeviceMemoryProperties
_ = Int
8
peek :: ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO PhysicalDeviceMemoryProperties
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> PhysicalDeviceMemoryProperties -> IO ()
poke "pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
ptr PhysicalDeviceMemoryProperties
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
ptr PhysicalDeviceMemoryProperties
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDeviceMemoryProperties where
zero :: PhysicalDeviceMemoryProperties
zero = Word32
-> Vector MemoryType
-> Word32
-> Vector MemoryHeap
-> PhysicalDeviceMemoryProperties
PhysicalDeviceMemoryProperties
forall a. Zero a => a
zero
forall a. Monoid a => a
mempty
forall a. Zero a => a
zero
forall a. Monoid a => a
mempty
data MemoryType = MemoryType
{
MemoryType -> MemoryPropertyFlags
propertyFlags :: MemoryPropertyFlags
,
MemoryType -> Word32
heapIndex :: Word32
}
deriving (Typeable, MemoryType -> MemoryType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemoryType -> MemoryType -> Bool
$c/= :: MemoryType -> MemoryType -> Bool
== :: MemoryType -> MemoryType -> Bool
$c== :: MemoryType -> MemoryType -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MemoryType)
#endif
deriving instance Show MemoryType
instance ToCStruct MemoryType where
withCStruct :: forall b. MemoryType -> (Ptr MemoryType -> IO b) -> IO b
withCStruct MemoryType
x Ptr MemoryType -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
8 forall a b. (a -> b) -> a -> b
$ \Ptr MemoryType
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr MemoryType
p MemoryType
x (Ptr MemoryType -> IO b
f Ptr MemoryType
p)
pokeCStruct :: forall b. Ptr MemoryType -> MemoryType -> IO b -> IO b
pokeCStruct Ptr MemoryType
p MemoryType{Word32
MemoryPropertyFlags
heapIndex :: Word32
propertyFlags :: MemoryPropertyFlags
$sel:heapIndex:MemoryType :: MemoryType -> Word32
$sel:propertyFlags:MemoryType :: MemoryType -> MemoryPropertyFlags
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryType
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr MemoryPropertyFlags)) (MemoryPropertyFlags
propertyFlags)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryType
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32)) (Word32
heapIndex)
IO b
f
cStructSize :: Int
cStructSize = Int
8
cStructAlignment :: Int
cStructAlignment = Int
4
pokeZeroCStruct :: forall b. Ptr MemoryType -> IO b -> IO b
pokeZeroCStruct Ptr MemoryType
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryType
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct MemoryType where
peekCStruct :: Ptr MemoryType -> IO MemoryType
peekCStruct Ptr MemoryType
p = do
MemoryPropertyFlags
propertyFlags <- forall a. Storable a => Ptr a -> IO a
peek @MemoryPropertyFlags ((Ptr MemoryType
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr MemoryPropertyFlags))
Word32
heapIndex <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr MemoryType
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ MemoryPropertyFlags -> Word32 -> MemoryType
MemoryType
MemoryPropertyFlags
propertyFlags Word32
heapIndex
instance Storable MemoryType where
sizeOf :: MemoryType -> Int
sizeOf ~MemoryType
_ = Int
8
alignment :: MemoryType -> Int
alignment ~MemoryType
_ = Int
4
peek :: Ptr MemoryType -> IO MemoryType
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr MemoryType -> MemoryType -> IO ()
poke Ptr MemoryType
ptr MemoryType
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr MemoryType
ptr MemoryType
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero MemoryType where
zero :: MemoryType
zero = MemoryPropertyFlags -> Word32 -> MemoryType
MemoryType
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data MemoryHeap = MemoryHeap
{
MemoryHeap -> DeviceSize
size :: DeviceSize
,
MemoryHeap -> MemoryHeapFlags
flags :: MemoryHeapFlags
}
deriving (Typeable, MemoryHeap -> MemoryHeap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemoryHeap -> MemoryHeap -> Bool
$c/= :: MemoryHeap -> MemoryHeap -> Bool
== :: MemoryHeap -> MemoryHeap -> Bool
$c== :: MemoryHeap -> MemoryHeap -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (MemoryHeap)
#endif
deriving instance Show MemoryHeap
instance ToCStruct MemoryHeap where
withCStruct :: forall b. MemoryHeap -> (Ptr MemoryHeap -> IO b) -> IO b
withCStruct MemoryHeap
x Ptr MemoryHeap -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
16 forall a b. (a -> b) -> a -> b
$ \Ptr MemoryHeap
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr MemoryHeap
p MemoryHeap
x (Ptr MemoryHeap -> IO b
f Ptr MemoryHeap
p)
pokeCStruct :: forall b. Ptr MemoryHeap -> MemoryHeap -> IO b -> IO b
pokeCStruct Ptr MemoryHeap
p MemoryHeap{DeviceSize
MemoryHeapFlags
flags :: MemoryHeapFlags
size :: DeviceSize
$sel:flags:MemoryHeap :: MemoryHeap -> MemoryHeapFlags
$sel:size:MemoryHeap :: MemoryHeap -> DeviceSize
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryHeap
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DeviceSize)) (DeviceSize
size)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryHeap
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr MemoryHeapFlags)) (MemoryHeapFlags
flags)
IO b
f
cStructSize :: Int
cStructSize = Int
16
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. Ptr MemoryHeap -> IO b -> IO b
pokeZeroCStruct Ptr MemoryHeap
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryHeap
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct MemoryHeap where
peekCStruct :: Ptr MemoryHeap -> IO MemoryHeap
peekCStruct Ptr MemoryHeap
p = do
DeviceSize
size <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr MemoryHeap
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr DeviceSize))
MemoryHeapFlags
flags <- forall a. Storable a => Ptr a -> IO a
peek @MemoryHeapFlags ((Ptr MemoryHeap
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr MemoryHeapFlags))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DeviceSize -> MemoryHeapFlags -> MemoryHeap
MemoryHeap
DeviceSize
size MemoryHeapFlags
flags
instance Storable MemoryHeap where
sizeOf :: MemoryHeap -> Int
sizeOf ~MemoryHeap
_ = Int
16
alignment :: MemoryHeap -> Int
alignment ~MemoryHeap
_ = Int
8
peek :: Ptr MemoryHeap -> IO MemoryHeap
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr MemoryHeap -> MemoryHeap -> IO ()
poke Ptr MemoryHeap
ptr MemoryHeap
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr MemoryHeap
ptr MemoryHeap
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero MemoryHeap where
zero :: MemoryHeap
zero = DeviceSize -> MemoryHeapFlags -> MemoryHeap
MemoryHeap
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data FormatProperties = FormatProperties
{
FormatProperties -> FormatFeatureFlags
linearTilingFeatures :: FormatFeatureFlags
,
FormatProperties -> FormatFeatureFlags
optimalTilingFeatures :: FormatFeatureFlags
,
FormatProperties -> FormatFeatureFlags
bufferFeatures :: FormatFeatureFlags
}
deriving (Typeable, FormatProperties -> FormatProperties -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormatProperties -> FormatProperties -> Bool
$c/= :: FormatProperties -> FormatProperties -> Bool
== :: FormatProperties -> FormatProperties -> Bool
$c== :: FormatProperties -> FormatProperties -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (FormatProperties)
#endif
deriving instance Show FormatProperties
instance ToCStruct FormatProperties where
withCStruct :: forall b.
FormatProperties
-> (("pFormatProperties" ::: Ptr FormatProperties) -> IO b) -> IO b
withCStruct FormatProperties
x ("pFormatProperties" ::: Ptr FormatProperties) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
12 forall a b. (a -> b) -> a -> b
$ \"pFormatProperties" ::: Ptr FormatProperties
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pFormatProperties" ::: Ptr FormatProperties
p FormatProperties
x (("pFormatProperties" ::: Ptr FormatProperties) -> IO b
f "pFormatProperties" ::: Ptr FormatProperties
p)
pokeCStruct :: forall b.
("pFormatProperties" ::: Ptr FormatProperties)
-> FormatProperties -> IO b -> IO b
pokeCStruct "pFormatProperties" ::: Ptr FormatProperties
p FormatProperties{FormatFeatureFlags
bufferFeatures :: FormatFeatureFlags
optimalTilingFeatures :: FormatFeatureFlags
linearTilingFeatures :: FormatFeatureFlags
$sel:bufferFeatures:FormatProperties :: FormatProperties -> FormatFeatureFlags
$sel:optimalTilingFeatures:FormatProperties :: FormatProperties -> FormatFeatureFlags
$sel:linearTilingFeatures:FormatProperties :: FormatProperties -> FormatFeatureFlags
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFormatProperties" ::: Ptr FormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr FormatFeatureFlags)) (FormatFeatureFlags
linearTilingFeatures)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFormatProperties" ::: Ptr FormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr FormatFeatureFlags)) (FormatFeatureFlags
optimalTilingFeatures)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFormatProperties" ::: Ptr FormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr FormatFeatureFlags)) (FormatFeatureFlags
bufferFeatures)
IO b
f
cStructSize :: Int
cStructSize = Int
12
cStructAlignment :: Int
cStructAlignment = Int
4
pokeZeroCStruct :: forall b.
("pFormatProperties" ::: Ptr FormatProperties) -> IO b -> IO b
pokeZeroCStruct "pFormatProperties" ::: Ptr FormatProperties
_ IO b
f = IO b
f
instance FromCStruct FormatProperties where
peekCStruct :: ("pFormatProperties" ::: Ptr FormatProperties)
-> IO FormatProperties
peekCStruct "pFormatProperties" ::: Ptr FormatProperties
p = do
FormatFeatureFlags
linearTilingFeatures <- forall a. Storable a => Ptr a -> IO a
peek @FormatFeatureFlags (("pFormatProperties" ::: Ptr FormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr FormatFeatureFlags))
FormatFeatureFlags
optimalTilingFeatures <- forall a. Storable a => Ptr a -> IO a
peek @FormatFeatureFlags (("pFormatProperties" ::: Ptr FormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr FormatFeatureFlags))
FormatFeatureFlags
bufferFeatures <- forall a. Storable a => Ptr a -> IO a
peek @FormatFeatureFlags (("pFormatProperties" ::: Ptr FormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr FormatFeatureFlags))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FormatFeatureFlags
-> FormatFeatureFlags -> FormatFeatureFlags -> FormatProperties
FormatProperties
FormatFeatureFlags
linearTilingFeatures FormatFeatureFlags
optimalTilingFeatures FormatFeatureFlags
bufferFeatures
instance Storable FormatProperties where
sizeOf :: FormatProperties -> Int
sizeOf ~FormatProperties
_ = Int
12
alignment :: FormatProperties -> Int
alignment ~FormatProperties
_ = Int
4
peek :: ("pFormatProperties" ::: Ptr FormatProperties)
-> IO FormatProperties
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: ("pFormatProperties" ::: Ptr FormatProperties)
-> FormatProperties -> IO ()
poke "pFormatProperties" ::: Ptr FormatProperties
ptr FormatProperties
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pFormatProperties" ::: Ptr FormatProperties
ptr FormatProperties
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero FormatProperties where
zero :: FormatProperties
zero = FormatFeatureFlags
-> FormatFeatureFlags -> FormatFeatureFlags -> FormatProperties
FormatProperties
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data ImageFormatProperties = ImageFormatProperties
{
ImageFormatProperties -> Extent3D
maxExtent :: Extent3D
,
ImageFormatProperties -> Word32
maxMipLevels :: Word32
,
ImageFormatProperties -> Word32
maxArrayLayers :: Word32
,
ImageFormatProperties -> SampleCountFlags
sampleCounts :: SampleCountFlags
,
ImageFormatProperties -> DeviceSize
maxResourceSize :: DeviceSize
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ImageFormatProperties)
#endif
deriving instance Show ImageFormatProperties
instance ToCStruct ImageFormatProperties where
withCStruct :: forall b.
ImageFormatProperties
-> (("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO b)
-> IO b
withCStruct ImageFormatProperties
x ("pImageFormatProperties" ::: Ptr ImageFormatProperties) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \"pImageFormatProperties" ::: Ptr ImageFormatProperties
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pImageFormatProperties" ::: Ptr ImageFormatProperties
p ImageFormatProperties
x (("pImageFormatProperties" ::: Ptr ImageFormatProperties) -> IO b
f "pImageFormatProperties" ::: Ptr ImageFormatProperties
p)
pokeCStruct :: forall b.
("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> ImageFormatProperties -> IO b -> IO b
pokeCStruct "pImageFormatProperties" ::: Ptr ImageFormatProperties
p ImageFormatProperties{Word32
DeviceSize
SampleCountFlags
Extent3D
maxResourceSize :: DeviceSize
sampleCounts :: SampleCountFlags
maxArrayLayers :: Word32
maxMipLevels :: Word32
maxExtent :: Extent3D
$sel:maxResourceSize:ImageFormatProperties :: ImageFormatProperties -> DeviceSize
$sel:sampleCounts:ImageFormatProperties :: ImageFormatProperties -> SampleCountFlags
$sel:maxArrayLayers:ImageFormatProperties :: ImageFormatProperties -> Word32
$sel:maxMipLevels:ImageFormatProperties :: ImageFormatProperties -> Word32
$sel:maxExtent:ImageFormatProperties :: ImageFormatProperties -> Extent3D
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Extent3D)) (Extent3D
maxExtent)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Word32)) (Word32
maxMipLevels)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
maxArrayLayers)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr SampleCountFlags)) (SampleCountFlags
sampleCounts)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DeviceSize)) (DeviceSize
maxResourceSize)
IO b
f
cStructSize :: Int
cStructSize = Int
32
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO b -> IO b
pokeZeroCStruct "pImageFormatProperties" ::: Ptr ImageFormatProperties
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Extent3D)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct ImageFormatProperties where
peekCStruct :: ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO ImageFormatProperties
peekCStruct "pImageFormatProperties" ::: Ptr ImageFormatProperties
p = do
Extent3D
maxExtent <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent3D (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Extent3D))
Word32
maxMipLevels <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Word32))
Word32
maxArrayLayers <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
SampleCountFlags
sampleCounts <- forall a. Storable a => Ptr a -> IO a
peek @SampleCountFlags (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr SampleCountFlags))
DeviceSize
maxResourceSize <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr DeviceSize))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Extent3D
-> Word32
-> Word32
-> SampleCountFlags
-> DeviceSize
-> ImageFormatProperties
ImageFormatProperties
Extent3D
maxExtent Word32
maxMipLevels Word32
maxArrayLayers SampleCountFlags
sampleCounts DeviceSize
maxResourceSize
instance Storable ImageFormatProperties where
sizeOf :: ImageFormatProperties -> Int
sizeOf ~ImageFormatProperties
_ = Int
32
alignment :: ImageFormatProperties -> Int
alignment ~ImageFormatProperties
_ = Int
8
peek :: ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO ImageFormatProperties
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> ImageFormatProperties -> IO ()
poke "pImageFormatProperties" ::: Ptr ImageFormatProperties
ptr ImageFormatProperties
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pImageFormatProperties" ::: Ptr ImageFormatProperties
ptr ImageFormatProperties
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero ImageFormatProperties where
zero :: ImageFormatProperties
zero = Extent3D
-> Word32
-> Word32
-> SampleCountFlags
-> DeviceSize
-> ImageFormatProperties
ImageFormatProperties
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data PhysicalDeviceFeatures = PhysicalDeviceFeatures
{
PhysicalDeviceFeatures -> Bool
robustBufferAccess :: Bool
,
PhysicalDeviceFeatures -> Bool
fullDrawIndexUint32 :: Bool
,
PhysicalDeviceFeatures -> Bool
imageCubeArray :: Bool
,
PhysicalDeviceFeatures -> Bool
independentBlend :: Bool
,
PhysicalDeviceFeatures -> Bool
geometryShader :: Bool
,
PhysicalDeviceFeatures -> Bool
tessellationShader :: Bool
,
PhysicalDeviceFeatures -> Bool
sampleRateShading :: Bool
,
PhysicalDeviceFeatures -> Bool
dualSrcBlend :: Bool
,
PhysicalDeviceFeatures -> Bool
logicOp :: Bool
,
PhysicalDeviceFeatures -> Bool
multiDrawIndirect :: Bool
,
PhysicalDeviceFeatures -> Bool
drawIndirectFirstInstance :: Bool
,
PhysicalDeviceFeatures -> Bool
depthClamp :: Bool
,
PhysicalDeviceFeatures -> Bool
depthBiasClamp :: Bool
,
PhysicalDeviceFeatures -> Bool
fillModeNonSolid :: Bool
,
PhysicalDeviceFeatures -> Bool
depthBounds :: Bool
,
PhysicalDeviceFeatures -> Bool
wideLines :: Bool
,
PhysicalDeviceFeatures -> Bool
largePoints :: Bool
,
PhysicalDeviceFeatures -> Bool
alphaToOne :: Bool
,
PhysicalDeviceFeatures -> Bool
multiViewport :: Bool
,
PhysicalDeviceFeatures -> Bool
samplerAnisotropy :: Bool
,
PhysicalDeviceFeatures -> Bool
textureCompressionETC2 :: Bool
,
PhysicalDeviceFeatures -> Bool
textureCompressionASTC_LDR :: Bool
,
PhysicalDeviceFeatures -> Bool
textureCompressionBC :: Bool
,
PhysicalDeviceFeatures -> Bool
occlusionQueryPrecise :: Bool
,
PhysicalDeviceFeatures -> Bool
pipelineStatisticsQuery :: Bool
,
PhysicalDeviceFeatures -> Bool
vertexPipelineStoresAndAtomics :: Bool
,
PhysicalDeviceFeatures -> Bool
fragmentStoresAndAtomics :: Bool
,
PhysicalDeviceFeatures -> Bool
shaderTessellationAndGeometryPointSize :: Bool
,
PhysicalDeviceFeatures -> Bool
shaderImageGatherExtended :: Bool
,
PhysicalDeviceFeatures -> Bool
shaderStorageImageExtendedFormats :: Bool
,
PhysicalDeviceFeatures -> Bool
shaderStorageImageMultisample :: Bool
,
PhysicalDeviceFeatures -> Bool
shaderStorageImageReadWithoutFormat :: Bool
,
PhysicalDeviceFeatures -> Bool
shaderStorageImageWriteWithoutFormat :: Bool
,
PhysicalDeviceFeatures -> Bool
shaderUniformBufferArrayDynamicIndexing :: Bool
,
PhysicalDeviceFeatures -> Bool
shaderSampledImageArrayDynamicIndexing :: Bool
,
PhysicalDeviceFeatures -> Bool
shaderStorageBufferArrayDynamicIndexing :: Bool
,
PhysicalDeviceFeatures -> Bool
shaderStorageImageArrayDynamicIndexing :: Bool
,
PhysicalDeviceFeatures -> Bool
shaderClipDistance :: Bool
,
PhysicalDeviceFeatures -> Bool
shaderCullDistance :: Bool
,
PhysicalDeviceFeatures -> Bool
shaderFloat64 :: Bool
,
PhysicalDeviceFeatures -> Bool
shaderInt64 :: Bool
,
PhysicalDeviceFeatures -> Bool
shaderInt16 :: Bool
,
PhysicalDeviceFeatures -> Bool
shaderResourceResidency :: Bool
,
PhysicalDeviceFeatures -> Bool
shaderResourceMinLod :: Bool
,
PhysicalDeviceFeatures -> Bool
sparseBinding :: Bool
,
PhysicalDeviceFeatures -> Bool
sparseResidencyBuffer :: Bool
,
PhysicalDeviceFeatures -> Bool
sparseResidencyImage2D :: Bool
,
PhysicalDeviceFeatures -> Bool
sparseResidencyImage3D :: Bool
,
PhysicalDeviceFeatures -> Bool
sparseResidency2Samples :: Bool
,
PhysicalDeviceFeatures -> Bool
sparseResidency4Samples :: Bool
,
PhysicalDeviceFeatures -> Bool
sparseResidency8Samples :: Bool
,
PhysicalDeviceFeatures -> Bool
sparseResidency16Samples :: Bool
,
PhysicalDeviceFeatures -> Bool
sparseResidencyAliased :: Bool
,
PhysicalDeviceFeatures -> Bool
variableMultisampleRate :: Bool
,
PhysicalDeviceFeatures -> Bool
inheritedQueries :: Bool
}
deriving (Typeable, PhysicalDeviceFeatures -> PhysicalDeviceFeatures -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceFeatures -> PhysicalDeviceFeatures -> Bool
$c/= :: PhysicalDeviceFeatures -> PhysicalDeviceFeatures -> Bool
== :: PhysicalDeviceFeatures -> PhysicalDeviceFeatures -> Bool
$c== :: PhysicalDeviceFeatures -> PhysicalDeviceFeatures -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceFeatures)
#endif
deriving instance Show PhysicalDeviceFeatures
instance ToCStruct PhysicalDeviceFeatures where
withCStruct :: forall b.
PhysicalDeviceFeatures
-> (("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO b) -> IO b
withCStruct PhysicalDeviceFeatures
x ("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
220 forall a b. (a -> b) -> a -> b
$ \"pFeatures" ::: Ptr PhysicalDeviceFeatures
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pFeatures" ::: Ptr PhysicalDeviceFeatures
p PhysicalDeviceFeatures
x (("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO b
f "pFeatures" ::: Ptr PhysicalDeviceFeatures
p)
pokeCStruct :: forall b.
("pFeatures" ::: Ptr PhysicalDeviceFeatures)
-> PhysicalDeviceFeatures -> IO b -> IO b
pokeCStruct "pFeatures" ::: Ptr PhysicalDeviceFeatures
p PhysicalDeviceFeatures{Bool
inheritedQueries :: Bool
variableMultisampleRate :: Bool
sparseResidencyAliased :: Bool
sparseResidency16Samples :: Bool
sparseResidency8Samples :: Bool
sparseResidency4Samples :: Bool
sparseResidency2Samples :: Bool
sparseResidencyImage3D :: Bool
sparseResidencyImage2D :: Bool
sparseResidencyBuffer :: Bool
sparseBinding :: Bool
shaderResourceMinLod :: Bool
shaderResourceResidency :: Bool
shaderInt16 :: Bool
shaderInt64 :: Bool
shaderFloat64 :: Bool
shaderCullDistance :: Bool
shaderClipDistance :: Bool
shaderStorageImageArrayDynamicIndexing :: Bool
shaderStorageBufferArrayDynamicIndexing :: Bool
shaderSampledImageArrayDynamicIndexing :: Bool
shaderUniformBufferArrayDynamicIndexing :: Bool
shaderStorageImageWriteWithoutFormat :: Bool
shaderStorageImageReadWithoutFormat :: Bool
shaderStorageImageMultisample :: Bool
shaderStorageImageExtendedFormats :: Bool
shaderImageGatherExtended :: Bool
shaderTessellationAndGeometryPointSize :: Bool
fragmentStoresAndAtomics :: Bool
vertexPipelineStoresAndAtomics :: Bool
pipelineStatisticsQuery :: Bool
occlusionQueryPrecise :: Bool
textureCompressionBC :: Bool
textureCompressionASTC_LDR :: Bool
textureCompressionETC2 :: Bool
samplerAnisotropy :: Bool
multiViewport :: Bool
alphaToOne :: Bool
largePoints :: Bool
wideLines :: Bool
depthBounds :: Bool
fillModeNonSolid :: Bool
depthBiasClamp :: Bool
depthClamp :: Bool
drawIndirectFirstInstance :: Bool
multiDrawIndirect :: Bool
logicOp :: Bool
dualSrcBlend :: Bool
sampleRateShading :: Bool
tessellationShader :: Bool
geometryShader :: Bool
independentBlend :: Bool
imageCubeArray :: Bool
fullDrawIndexUint32 :: Bool
robustBufferAccess :: Bool
$sel:inheritedQueries:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:variableMultisampleRate:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:sparseResidencyAliased:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:sparseResidency16Samples:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:sparseResidency8Samples:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:sparseResidency4Samples:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:sparseResidency2Samples:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:sparseResidencyImage3D:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:sparseResidencyImage2D:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:sparseResidencyBuffer:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:sparseBinding:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:shaderResourceMinLod:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:shaderResourceResidency:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:shaderInt16:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:shaderInt64:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:shaderFloat64:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:shaderCullDistance:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:shaderClipDistance:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:shaderStorageImageArrayDynamicIndexing:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:shaderStorageBufferArrayDynamicIndexing:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:shaderSampledImageArrayDynamicIndexing:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:shaderUniformBufferArrayDynamicIndexing:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:shaderStorageImageWriteWithoutFormat:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:shaderStorageImageReadWithoutFormat:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:shaderStorageImageMultisample:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:shaderStorageImageExtendedFormats:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:shaderImageGatherExtended:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:shaderTessellationAndGeometryPointSize:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:fragmentStoresAndAtomics:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:vertexPipelineStoresAndAtomics:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:pipelineStatisticsQuery:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:occlusionQueryPrecise:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:textureCompressionBC:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:textureCompressionASTC_LDR:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:textureCompressionETC2:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:samplerAnisotropy:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:multiViewport:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:alphaToOne:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:largePoints:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:wideLines:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:depthBounds:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:fillModeNonSolid:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:depthBiasClamp:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:depthClamp:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:drawIndirectFirstInstance:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:multiDrawIndirect:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:logicOp:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:dualSrcBlend:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:sampleRateShading:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:tessellationShader:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:geometryShader:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:independentBlend:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:imageCubeArray:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:fullDrawIndexUint32:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
$sel:robustBufferAccess:PhysicalDeviceFeatures :: PhysicalDeviceFeatures -> Bool
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
robustBufferAccess))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
fullDrawIndexUint32))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
imageCubeArray))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
independentBlend))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
geometryShader))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
tessellationShader))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
sampleRateShading))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
dualSrcBlend))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
logicOp))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
multiDrawIndirect))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
drawIndirectFirstInstance))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
depthClamp))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
depthBiasClamp))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
52 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
fillModeNonSolid))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
depthBounds))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
wideLines))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
largePoints))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
68 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
alphaToOne))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
multiViewport))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
76 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
samplerAnisotropy))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
textureCompressionETC2))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
84 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
textureCompressionASTC_LDR))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
88 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
textureCompressionBC))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
92 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
occlusionQueryPrecise))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
96 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
pipelineStatisticsQuery))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
100 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
vertexPipelineStoresAndAtomics))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
104 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
fragmentStoresAndAtomics))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
108 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
shaderTessellationAndGeometryPointSize))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
112 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
shaderImageGatherExtended))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
116 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
shaderStorageImageExtendedFormats))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
120 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
shaderStorageImageMultisample))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
124 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
shaderStorageImageReadWithoutFormat))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
128 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
shaderStorageImageWriteWithoutFormat))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
132 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
shaderUniformBufferArrayDynamicIndexing))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
136 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
shaderSampledImageArrayDynamicIndexing))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
140 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
shaderStorageBufferArrayDynamicIndexing))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
144 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
shaderStorageImageArrayDynamicIndexing))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
148 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
shaderClipDistance))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
152 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
shaderCullDistance))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
156 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
shaderFloat64))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
160 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
shaderInt64))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
164 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
shaderInt16))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
168 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
shaderResourceResidency))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
172 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
shaderResourceMinLod))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
176 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
sparseBinding))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
180 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
sparseResidencyBuffer))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
184 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
sparseResidencyImage2D))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
188 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
sparseResidencyImage3D))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
192 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
sparseResidency2Samples))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
196 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
sparseResidency4Samples))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
200 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
sparseResidency8Samples))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
204 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
sparseResidency16Samples))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
208 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
sparseResidencyAliased))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
212 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
variableMultisampleRate))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
216 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
inheritedQueries))
IO b
f
cStructSize :: Int
cStructSize = Int
220
cStructAlignment :: Int
cStructAlignment = Int
4
pokeZeroCStruct :: forall b.
("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO b -> IO b
pokeZeroCStruct "pFeatures" ::: Ptr PhysicalDeviceFeatures
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
52 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
68 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
76 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
84 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
88 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
92 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
96 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
100 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
104 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
108 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
112 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
116 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
120 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
124 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
128 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
132 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
136 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
140 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
144 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
148 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
152 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
156 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
160 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
164 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
168 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
172 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
176 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
180 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
184 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
188 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
192 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
196 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
200 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
204 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
208 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
212 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
216 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
IO b
f
instance FromCStruct PhysicalDeviceFeatures where
peekCStruct :: ("pFeatures" ::: Ptr PhysicalDeviceFeatures)
-> IO PhysicalDeviceFeatures
peekCStruct "pFeatures" ::: Ptr PhysicalDeviceFeatures
p = do
Bool32
robustBufferAccess <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Bool32))
Bool32
fullDrawIndexUint32 <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Bool32))
Bool32
imageCubeArray <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Bool32))
Bool32
independentBlend <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Bool32))
Bool32
geometryShader <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
Bool32
tessellationShader <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Bool32))
Bool32
sampleRateShading <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Bool32))
Bool32
dualSrcBlend <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Bool32))
Bool32
logicOp <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Bool32))
Bool32
multiDrawIndirect <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Bool32))
Bool32
drawIndirectFirstInstance <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Bool32))
Bool32
depthClamp <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44 :: Ptr Bool32))
Bool32
depthBiasClamp <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr Bool32))
Bool32
fillModeNonSolid <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
52 :: Ptr Bool32))
Bool32
depthBounds <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr Bool32))
Bool32
wideLines <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
60 :: Ptr Bool32))
Bool32
largePoints <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr Bool32))
Bool32
alphaToOne <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
68 :: Ptr Bool32))
Bool32
multiViewport <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr Bool32))
Bool32
samplerAnisotropy <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
76 :: Ptr Bool32))
Bool32
textureCompressionETC2 <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80 :: Ptr Bool32))
Bool32
textureCompressionASTC_LDR <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
84 :: Ptr Bool32))
Bool32
textureCompressionBC <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
88 :: Ptr Bool32))
Bool32
occlusionQueryPrecise <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
92 :: Ptr Bool32))
Bool32
pipelineStatisticsQuery <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
96 :: Ptr Bool32))
Bool32
vertexPipelineStoresAndAtomics <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
100 :: Ptr Bool32))
Bool32
fragmentStoresAndAtomics <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
104 :: Ptr Bool32))
Bool32
shaderTessellationAndGeometryPointSize <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
108 :: Ptr Bool32))
Bool32
shaderImageGatherExtended <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
112 :: Ptr Bool32))
Bool32
shaderStorageImageExtendedFormats <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
116 :: Ptr Bool32))
Bool32
shaderStorageImageMultisample <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
120 :: Ptr Bool32))
Bool32
shaderStorageImageReadWithoutFormat <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
124 :: Ptr Bool32))
Bool32
shaderStorageImageWriteWithoutFormat <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
128 :: Ptr Bool32))
Bool32
shaderUniformBufferArrayDynamicIndexing <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
132 :: Ptr Bool32))
Bool32
shaderSampledImageArrayDynamicIndexing <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
136 :: Ptr Bool32))
Bool32
shaderStorageBufferArrayDynamicIndexing <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
140 :: Ptr Bool32))
Bool32
shaderStorageImageArrayDynamicIndexing <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
144 :: Ptr Bool32))
Bool32
shaderClipDistance <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
148 :: Ptr Bool32))
Bool32
shaderCullDistance <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
152 :: Ptr Bool32))
Bool32
shaderFloat64 <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
156 :: Ptr Bool32))
Bool32
shaderInt64 <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
160 :: Ptr Bool32))
Bool32
shaderInt16 <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
164 :: Ptr Bool32))
Bool32
shaderResourceResidency <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
168 :: Ptr Bool32))
Bool32
shaderResourceMinLod <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
172 :: Ptr Bool32))
Bool32
sparseBinding <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
176 :: Ptr Bool32))
Bool32
sparseResidencyBuffer <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
180 :: Ptr Bool32))
Bool32
sparseResidencyImage2D <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
184 :: Ptr Bool32))
Bool32
sparseResidencyImage3D <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
188 :: Ptr Bool32))
Bool32
sparseResidency2Samples <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
192 :: Ptr Bool32))
Bool32
sparseResidency4Samples <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
196 :: Ptr Bool32))
Bool32
sparseResidency8Samples <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
200 :: Ptr Bool32))
Bool32
sparseResidency16Samples <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
204 :: Ptr Bool32))
Bool32
sparseResidencyAliased <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
208 :: Ptr Bool32))
Bool32
variableMultisampleRate <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
212 :: Ptr Bool32))
Bool32
inheritedQueries <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 (("pFeatures" ::: Ptr PhysicalDeviceFeatures
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
216 :: Ptr Bool32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> PhysicalDeviceFeatures
PhysicalDeviceFeatures
(Bool32 -> Bool
bool32ToBool Bool32
robustBufferAccess)
(Bool32 -> Bool
bool32ToBool Bool32
fullDrawIndexUint32)
(Bool32 -> Bool
bool32ToBool Bool32
imageCubeArray)
(Bool32 -> Bool
bool32ToBool Bool32
independentBlend)
(Bool32 -> Bool
bool32ToBool Bool32
geometryShader)
(Bool32 -> Bool
bool32ToBool Bool32
tessellationShader)
(Bool32 -> Bool
bool32ToBool Bool32
sampleRateShading)
(Bool32 -> Bool
bool32ToBool Bool32
dualSrcBlend)
(Bool32 -> Bool
bool32ToBool Bool32
logicOp)
(Bool32 -> Bool
bool32ToBool Bool32
multiDrawIndirect)
(Bool32 -> Bool
bool32ToBool Bool32
drawIndirectFirstInstance)
(Bool32 -> Bool
bool32ToBool Bool32
depthClamp)
(Bool32 -> Bool
bool32ToBool Bool32
depthBiasClamp)
(Bool32 -> Bool
bool32ToBool Bool32
fillModeNonSolid)
(Bool32 -> Bool
bool32ToBool Bool32
depthBounds)
(Bool32 -> Bool
bool32ToBool Bool32
wideLines)
(Bool32 -> Bool
bool32ToBool Bool32
largePoints)
(Bool32 -> Bool
bool32ToBool Bool32
alphaToOne)
(Bool32 -> Bool
bool32ToBool Bool32
multiViewport)
(Bool32 -> Bool
bool32ToBool Bool32
samplerAnisotropy)
(Bool32 -> Bool
bool32ToBool Bool32
textureCompressionETC2)
(Bool32 -> Bool
bool32ToBool Bool32
textureCompressionASTC_LDR)
(Bool32 -> Bool
bool32ToBool Bool32
textureCompressionBC)
(Bool32 -> Bool
bool32ToBool Bool32
occlusionQueryPrecise)
(Bool32 -> Bool
bool32ToBool Bool32
pipelineStatisticsQuery)
(Bool32 -> Bool
bool32ToBool Bool32
vertexPipelineStoresAndAtomics)
(Bool32 -> Bool
bool32ToBool Bool32
fragmentStoresAndAtomics)
(Bool32 -> Bool
bool32ToBool Bool32
shaderTessellationAndGeometryPointSize)
(Bool32 -> Bool
bool32ToBool Bool32
shaderImageGatherExtended)
(Bool32 -> Bool
bool32ToBool Bool32
shaderStorageImageExtendedFormats)
(Bool32 -> Bool
bool32ToBool Bool32
shaderStorageImageMultisample)
(Bool32 -> Bool
bool32ToBool Bool32
shaderStorageImageReadWithoutFormat)
(Bool32 -> Bool
bool32ToBool Bool32
shaderStorageImageWriteWithoutFormat)
(Bool32 -> Bool
bool32ToBool Bool32
shaderUniformBufferArrayDynamicIndexing)
(Bool32 -> Bool
bool32ToBool Bool32
shaderSampledImageArrayDynamicIndexing)
(Bool32 -> Bool
bool32ToBool Bool32
shaderStorageBufferArrayDynamicIndexing)
(Bool32 -> Bool
bool32ToBool Bool32
shaderStorageImageArrayDynamicIndexing)
(Bool32 -> Bool
bool32ToBool Bool32
shaderClipDistance)
(Bool32 -> Bool
bool32ToBool Bool32
shaderCullDistance)
(Bool32 -> Bool
bool32ToBool Bool32
shaderFloat64)
(Bool32 -> Bool
bool32ToBool Bool32
shaderInt64)
(Bool32 -> Bool
bool32ToBool Bool32
shaderInt16)
(Bool32 -> Bool
bool32ToBool Bool32
shaderResourceResidency)
(Bool32 -> Bool
bool32ToBool Bool32
shaderResourceMinLod)
(Bool32 -> Bool
bool32ToBool Bool32
sparseBinding)
(Bool32 -> Bool
bool32ToBool Bool32
sparseResidencyBuffer)
(Bool32 -> Bool
bool32ToBool Bool32
sparseResidencyImage2D)
(Bool32 -> Bool
bool32ToBool Bool32
sparseResidencyImage3D)
(Bool32 -> Bool
bool32ToBool Bool32
sparseResidency2Samples)
(Bool32 -> Bool
bool32ToBool Bool32
sparseResidency4Samples)
(Bool32 -> Bool
bool32ToBool Bool32
sparseResidency8Samples)
(Bool32 -> Bool
bool32ToBool Bool32
sparseResidency16Samples)
(Bool32 -> Bool
bool32ToBool Bool32
sparseResidencyAliased)
(Bool32 -> Bool
bool32ToBool Bool32
variableMultisampleRate)
(Bool32 -> Bool
bool32ToBool Bool32
inheritedQueries)
instance Storable PhysicalDeviceFeatures where
sizeOf :: PhysicalDeviceFeatures -> Int
sizeOf ~PhysicalDeviceFeatures
_ = Int
220
alignment :: PhysicalDeviceFeatures -> Int
alignment ~PhysicalDeviceFeatures
_ = Int
4
peek :: ("pFeatures" ::: Ptr PhysicalDeviceFeatures)
-> IO PhysicalDeviceFeatures
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: ("pFeatures" ::: Ptr PhysicalDeviceFeatures)
-> PhysicalDeviceFeatures -> IO ()
poke "pFeatures" ::: Ptr PhysicalDeviceFeatures
ptr PhysicalDeviceFeatures
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pFeatures" ::: Ptr PhysicalDeviceFeatures
ptr PhysicalDeviceFeatures
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDeviceFeatures where
zero :: PhysicalDeviceFeatures
zero = Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> PhysicalDeviceFeatures
PhysicalDeviceFeatures
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data PhysicalDeviceSparseProperties = PhysicalDeviceSparseProperties
{
PhysicalDeviceSparseProperties -> Bool
residencyStandard2DBlockShape :: Bool
,
PhysicalDeviceSparseProperties -> Bool
residencyStandard2DMultisampleBlockShape :: Bool
,
PhysicalDeviceSparseProperties -> Bool
residencyStandard3DBlockShape :: Bool
,
PhysicalDeviceSparseProperties -> Bool
residencyAlignedMipSize :: Bool
,
PhysicalDeviceSparseProperties -> Bool
residencyNonResidentStrict :: Bool
}
deriving (Typeable, PhysicalDeviceSparseProperties
-> PhysicalDeviceSparseProperties -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceSparseProperties
-> PhysicalDeviceSparseProperties -> Bool
$c/= :: PhysicalDeviceSparseProperties
-> PhysicalDeviceSparseProperties -> Bool
== :: PhysicalDeviceSparseProperties
-> PhysicalDeviceSparseProperties -> Bool
$c== :: PhysicalDeviceSparseProperties
-> PhysicalDeviceSparseProperties -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceSparseProperties)
#endif
deriving instance Show PhysicalDeviceSparseProperties
instance ToCStruct PhysicalDeviceSparseProperties where
withCStruct :: forall b.
PhysicalDeviceSparseProperties
-> (Ptr PhysicalDeviceSparseProperties -> IO b) -> IO b
withCStruct PhysicalDeviceSparseProperties
x Ptr PhysicalDeviceSparseProperties -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
20 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceSparseProperties
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceSparseProperties
p PhysicalDeviceSparseProperties
x (Ptr PhysicalDeviceSparseProperties -> IO b
f Ptr PhysicalDeviceSparseProperties
p)
pokeCStruct :: forall b.
Ptr PhysicalDeviceSparseProperties
-> PhysicalDeviceSparseProperties -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceSparseProperties
p PhysicalDeviceSparseProperties{Bool
residencyNonResidentStrict :: Bool
residencyAlignedMipSize :: Bool
residencyStandard3DBlockShape :: Bool
residencyStandard2DMultisampleBlockShape :: Bool
residencyStandard2DBlockShape :: Bool
$sel:residencyNonResidentStrict:PhysicalDeviceSparseProperties :: PhysicalDeviceSparseProperties -> Bool
$sel:residencyAlignedMipSize:PhysicalDeviceSparseProperties :: PhysicalDeviceSparseProperties -> Bool
$sel:residencyStandard3DBlockShape:PhysicalDeviceSparseProperties :: PhysicalDeviceSparseProperties -> Bool
$sel:residencyStandard2DMultisampleBlockShape:PhysicalDeviceSparseProperties :: PhysicalDeviceSparseProperties -> Bool
$sel:residencyStandard2DBlockShape:PhysicalDeviceSparseProperties :: PhysicalDeviceSparseProperties -> Bool
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSparseProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
residencyStandard2DBlockShape))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSparseProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
residencyStandard2DMultisampleBlockShape))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSparseProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
residencyStandard3DBlockShape))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSparseProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
residencyAlignedMipSize))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSparseProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
residencyNonResidentStrict))
IO b
f
cStructSize :: Int
cStructSize = Int
20
cStructAlignment :: Int
cStructAlignment = Int
4
pokeZeroCStruct :: forall b. Ptr PhysicalDeviceSparseProperties -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceSparseProperties
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSparseProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSparseProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSparseProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSparseProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceSparseProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
IO b
f
instance FromCStruct PhysicalDeviceSparseProperties where
peekCStruct :: Ptr PhysicalDeviceSparseProperties
-> IO PhysicalDeviceSparseProperties
peekCStruct Ptr PhysicalDeviceSparseProperties
p = do
Bool32
residencyStandard2DBlockShape <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceSparseProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Bool32))
Bool32
residencyStandard2DMultisampleBlockShape <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceSparseProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Bool32))
Bool32
residencyStandard3DBlockShape <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceSparseProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Bool32))
Bool32
residencyAlignedMipSize <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceSparseProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Bool32))
Bool32
residencyNonResidentStrict <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceSparseProperties
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool
-> Bool -> Bool -> Bool -> Bool -> PhysicalDeviceSparseProperties
PhysicalDeviceSparseProperties
(Bool32 -> Bool
bool32ToBool Bool32
residencyStandard2DBlockShape)
(Bool32 -> Bool
bool32ToBool Bool32
residencyStandard2DMultisampleBlockShape)
(Bool32 -> Bool
bool32ToBool Bool32
residencyStandard3DBlockShape)
(Bool32 -> Bool
bool32ToBool Bool32
residencyAlignedMipSize)
(Bool32 -> Bool
bool32ToBool Bool32
residencyNonResidentStrict)
instance Storable PhysicalDeviceSparseProperties where
sizeOf :: PhysicalDeviceSparseProperties -> Int
sizeOf ~PhysicalDeviceSparseProperties
_ = Int
20
alignment :: PhysicalDeviceSparseProperties -> Int
alignment ~PhysicalDeviceSparseProperties
_ = Int
4
peek :: Ptr PhysicalDeviceSparseProperties
-> IO PhysicalDeviceSparseProperties
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PhysicalDeviceSparseProperties
-> PhysicalDeviceSparseProperties -> IO ()
poke Ptr PhysicalDeviceSparseProperties
ptr PhysicalDeviceSparseProperties
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceSparseProperties
ptr PhysicalDeviceSparseProperties
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDeviceSparseProperties where
zero :: PhysicalDeviceSparseProperties
zero = Bool
-> Bool -> Bool -> Bool -> Bool -> PhysicalDeviceSparseProperties
PhysicalDeviceSparseProperties
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
data PhysicalDeviceLimits = PhysicalDeviceLimits
{
PhysicalDeviceLimits -> Word32
maxImageDimension1D :: Word32
,
PhysicalDeviceLimits -> Word32
maxImageDimension2D :: Word32
,
PhysicalDeviceLimits -> Word32
maxImageDimension3D :: Word32
,
PhysicalDeviceLimits -> Word32
maxImageDimensionCube :: Word32
,
PhysicalDeviceLimits -> Word32
maxImageArrayLayers :: Word32
,
PhysicalDeviceLimits -> Word32
maxTexelBufferElements :: Word32
,
PhysicalDeviceLimits -> Word32
maxUniformBufferRange :: Word32
,
PhysicalDeviceLimits -> Word32
maxStorageBufferRange :: Word32
,
PhysicalDeviceLimits -> Word32
maxPushConstantsSize :: Word32
,
PhysicalDeviceLimits -> Word32
maxMemoryAllocationCount :: Word32
,
PhysicalDeviceLimits -> Word32
maxSamplerAllocationCount :: Word32
,
PhysicalDeviceLimits -> DeviceSize
bufferImageGranularity :: DeviceSize
,
PhysicalDeviceLimits -> DeviceSize
sparseAddressSpaceSize :: DeviceSize
,
PhysicalDeviceLimits -> Word32
maxBoundDescriptorSets :: Word32
,
PhysicalDeviceLimits -> Word32
maxPerStageDescriptorSamplers :: Word32
,
PhysicalDeviceLimits -> Word32
maxPerStageDescriptorUniformBuffers :: Word32
,
PhysicalDeviceLimits -> Word32
maxPerStageDescriptorStorageBuffers :: Word32
,
PhysicalDeviceLimits -> Word32
maxPerStageDescriptorSampledImages :: Word32
,
PhysicalDeviceLimits -> Word32
maxPerStageDescriptorStorageImages :: Word32
,
PhysicalDeviceLimits -> Word32
maxPerStageDescriptorInputAttachments :: Word32
,
PhysicalDeviceLimits -> Word32
maxPerStageResources :: Word32
,
PhysicalDeviceLimits -> Word32
maxDescriptorSetSamplers :: Word32
,
PhysicalDeviceLimits -> Word32
maxDescriptorSetUniformBuffers :: Word32
,
PhysicalDeviceLimits -> Word32
maxDescriptorSetUniformBuffersDynamic :: Word32
,
PhysicalDeviceLimits -> Word32
maxDescriptorSetStorageBuffers :: Word32
,
PhysicalDeviceLimits -> Word32
maxDescriptorSetStorageBuffersDynamic :: Word32
,
PhysicalDeviceLimits -> Word32
maxDescriptorSetSampledImages :: Word32
,
PhysicalDeviceLimits -> Word32
maxDescriptorSetStorageImages :: Word32
,
PhysicalDeviceLimits -> Word32
maxDescriptorSetInputAttachments :: Word32
,
PhysicalDeviceLimits -> Word32
maxVertexInputAttributes :: Word32
,
PhysicalDeviceLimits -> Word32
maxVertexInputBindings :: Word32
,
PhysicalDeviceLimits -> Word32
maxVertexInputAttributeOffset :: Word32
,
PhysicalDeviceLimits -> Word32
maxVertexInputBindingStride :: Word32
,
PhysicalDeviceLimits -> Word32
maxVertexOutputComponents :: Word32
,
PhysicalDeviceLimits -> Word32
maxTessellationGenerationLevel :: Word32
,
PhysicalDeviceLimits -> Word32
maxTessellationPatchSize :: Word32
,
PhysicalDeviceLimits -> Word32
maxTessellationControlPerVertexInputComponents :: Word32
,
PhysicalDeviceLimits -> Word32
maxTessellationControlPerVertexOutputComponents :: Word32
,
PhysicalDeviceLimits -> Word32
maxTessellationControlPerPatchOutputComponents :: Word32
,
PhysicalDeviceLimits -> Word32
maxTessellationControlTotalOutputComponents :: Word32
,
PhysicalDeviceLimits -> Word32
maxTessellationEvaluationInputComponents :: Word32
,
PhysicalDeviceLimits -> Word32
maxTessellationEvaluationOutputComponents :: Word32
,
PhysicalDeviceLimits -> Word32
maxGeometryShaderInvocations :: Word32
,
PhysicalDeviceLimits -> Word32
maxGeometryInputComponents :: Word32
,
PhysicalDeviceLimits -> Word32
maxGeometryOutputComponents :: Word32
,
PhysicalDeviceLimits -> Word32
maxGeometryOutputVertices :: Word32
,
PhysicalDeviceLimits -> Word32
maxGeometryTotalOutputComponents :: Word32
,
PhysicalDeviceLimits -> Word32
maxFragmentInputComponents :: Word32
,
PhysicalDeviceLimits -> Word32
maxFragmentOutputAttachments :: Word32
,
PhysicalDeviceLimits -> Word32
maxFragmentDualSrcAttachments :: Word32
,
PhysicalDeviceLimits -> Word32
maxFragmentCombinedOutputResources :: Word32
,
PhysicalDeviceLimits -> Word32
maxComputeSharedMemorySize :: Word32
,
PhysicalDeviceLimits -> (Word32, Word32, Word32)
maxComputeWorkGroupCount :: (Word32, Word32, Word32)
,
PhysicalDeviceLimits -> Word32
maxComputeWorkGroupInvocations :: Word32
,
PhysicalDeviceLimits -> (Word32, Word32, Word32)
maxComputeWorkGroupSize :: (Word32, Word32, Word32)
,
PhysicalDeviceLimits -> Word32
subPixelPrecisionBits :: Word32
,
PhysicalDeviceLimits -> Word32
subTexelPrecisionBits :: Word32
,
PhysicalDeviceLimits -> Word32
mipmapPrecisionBits :: Word32
,
PhysicalDeviceLimits -> Word32
maxDrawIndexedIndexValue :: Word32
,
PhysicalDeviceLimits -> Word32
maxDrawIndirectCount :: Word32
,
PhysicalDeviceLimits -> Float
maxSamplerLodBias :: Float
,
PhysicalDeviceLimits -> Float
maxSamplerAnisotropy :: Float
,
PhysicalDeviceLimits -> Word32
maxViewports :: Word32
,
PhysicalDeviceLimits -> (Word32, Word32)
maxViewportDimensions :: (Word32, Word32)
,
PhysicalDeviceLimits -> (Float, Float)
viewportBoundsRange :: (Float, Float)
,
PhysicalDeviceLimits -> Word32
viewportSubPixelBits :: Word32
,
PhysicalDeviceLimits -> DeviceSize
minMemoryMapAlignment :: Word64
,
PhysicalDeviceLimits -> DeviceSize
minTexelBufferOffsetAlignment :: DeviceSize
,
PhysicalDeviceLimits -> DeviceSize
minUniformBufferOffsetAlignment :: DeviceSize
,
PhysicalDeviceLimits -> DeviceSize
minStorageBufferOffsetAlignment :: DeviceSize
,
PhysicalDeviceLimits -> Int32
minTexelOffset :: Int32
,
PhysicalDeviceLimits -> Word32
maxTexelOffset :: Word32
,
PhysicalDeviceLimits -> Int32
minTexelGatherOffset :: Int32
,
PhysicalDeviceLimits -> Word32
maxTexelGatherOffset :: Word32
,
PhysicalDeviceLimits -> Float
minInterpolationOffset :: Float
,
PhysicalDeviceLimits -> Float
maxInterpolationOffset :: Float
,
PhysicalDeviceLimits -> Word32
subPixelInterpolationOffsetBits :: Word32
,
PhysicalDeviceLimits -> Word32
maxFramebufferWidth :: Word32
,
PhysicalDeviceLimits -> Word32
maxFramebufferHeight :: Word32
,
PhysicalDeviceLimits -> Word32
maxFramebufferLayers :: Word32
,
PhysicalDeviceLimits -> SampleCountFlags
framebufferColorSampleCounts :: SampleCountFlags
,
PhysicalDeviceLimits -> SampleCountFlags
framebufferDepthSampleCounts :: SampleCountFlags
,
PhysicalDeviceLimits -> SampleCountFlags
framebufferStencilSampleCounts :: SampleCountFlags
,
PhysicalDeviceLimits -> SampleCountFlags
framebufferNoAttachmentsSampleCounts :: SampleCountFlags
,
PhysicalDeviceLimits -> Word32
maxColorAttachments :: Word32
,
PhysicalDeviceLimits -> SampleCountFlags
sampledImageColorSampleCounts :: SampleCountFlags
,
PhysicalDeviceLimits -> SampleCountFlags
sampledImageIntegerSampleCounts :: SampleCountFlags
,
PhysicalDeviceLimits -> SampleCountFlags
sampledImageDepthSampleCounts :: SampleCountFlags
,
PhysicalDeviceLimits -> SampleCountFlags
sampledImageStencilSampleCounts :: SampleCountFlags
,
PhysicalDeviceLimits -> SampleCountFlags
storageImageSampleCounts :: SampleCountFlags
,
PhysicalDeviceLimits -> Word32
maxSampleMaskWords :: Word32
,
PhysicalDeviceLimits -> Bool
timestampComputeAndGraphics :: Bool
,
PhysicalDeviceLimits -> Float
timestampPeriod :: Float
,
PhysicalDeviceLimits -> Word32
maxClipDistances :: Word32
,
PhysicalDeviceLimits -> Word32
maxCullDistances :: Word32
,
PhysicalDeviceLimits -> Word32
maxCombinedClipAndCullDistances :: Word32
,
PhysicalDeviceLimits -> Word32
discreteQueuePriorities :: Word32
,
PhysicalDeviceLimits -> (Float, Float)
pointSizeRange :: (Float, Float)
,
PhysicalDeviceLimits -> (Float, Float)
lineWidthRange :: (Float, Float)
,
PhysicalDeviceLimits -> Float
pointSizeGranularity :: Float
,
PhysicalDeviceLimits -> Float
lineWidthGranularity :: Float
,
PhysicalDeviceLimits -> Bool
strictLines :: Bool
,
PhysicalDeviceLimits -> Bool
standardSampleLocations :: Bool
,
PhysicalDeviceLimits -> DeviceSize
optimalBufferCopyOffsetAlignment :: DeviceSize
,
PhysicalDeviceLimits -> DeviceSize
optimalBufferCopyRowPitchAlignment :: DeviceSize
,
PhysicalDeviceLimits -> DeviceSize
nonCoherentAtomSize :: DeviceSize
}
deriving (Typeable, PhysicalDeviceLimits -> PhysicalDeviceLimits -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceLimits -> PhysicalDeviceLimits -> Bool
$c/= :: PhysicalDeviceLimits -> PhysicalDeviceLimits -> Bool
== :: PhysicalDeviceLimits -> PhysicalDeviceLimits -> Bool
$c== :: PhysicalDeviceLimits -> PhysicalDeviceLimits -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceLimits)
#endif
deriving instance Show PhysicalDeviceLimits
instance ToCStruct PhysicalDeviceLimits where
withCStruct :: forall b.
PhysicalDeviceLimits -> (Ptr PhysicalDeviceLimits -> IO b) -> IO b
withCStruct PhysicalDeviceLimits
x Ptr PhysicalDeviceLimits -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
504 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceLimits
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceLimits
p PhysicalDeviceLimits
x (Ptr PhysicalDeviceLimits -> IO b
f Ptr PhysicalDeviceLimits
p)
pokeCStruct :: forall b.
Ptr PhysicalDeviceLimits -> PhysicalDeviceLimits -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceLimits
p PhysicalDeviceLimits{Bool
Float
Int32
Word32
DeviceSize
(Float, Float)
(Word32, Word32)
(Word32, Word32, Word32)
SampleCountFlags
nonCoherentAtomSize :: DeviceSize
optimalBufferCopyRowPitchAlignment :: DeviceSize
optimalBufferCopyOffsetAlignment :: DeviceSize
standardSampleLocations :: Bool
strictLines :: Bool
lineWidthGranularity :: Float
pointSizeGranularity :: Float
lineWidthRange :: (Float, Float)
pointSizeRange :: (Float, Float)
discreteQueuePriorities :: Word32
maxCombinedClipAndCullDistances :: Word32
maxCullDistances :: Word32
maxClipDistances :: Word32
timestampPeriod :: Float
timestampComputeAndGraphics :: Bool
maxSampleMaskWords :: Word32
storageImageSampleCounts :: SampleCountFlags
sampledImageStencilSampleCounts :: SampleCountFlags
sampledImageDepthSampleCounts :: SampleCountFlags
sampledImageIntegerSampleCounts :: SampleCountFlags
sampledImageColorSampleCounts :: SampleCountFlags
maxColorAttachments :: Word32
framebufferNoAttachmentsSampleCounts :: SampleCountFlags
framebufferStencilSampleCounts :: SampleCountFlags
framebufferDepthSampleCounts :: SampleCountFlags
framebufferColorSampleCounts :: SampleCountFlags
maxFramebufferLayers :: Word32
maxFramebufferHeight :: Word32
maxFramebufferWidth :: Word32
subPixelInterpolationOffsetBits :: Word32
maxInterpolationOffset :: Float
minInterpolationOffset :: Float
maxTexelGatherOffset :: Word32
minTexelGatherOffset :: Int32
maxTexelOffset :: Word32
minTexelOffset :: Int32
minStorageBufferOffsetAlignment :: DeviceSize
minUniformBufferOffsetAlignment :: DeviceSize
minTexelBufferOffsetAlignment :: DeviceSize
minMemoryMapAlignment :: DeviceSize
viewportSubPixelBits :: Word32
viewportBoundsRange :: (Float, Float)
maxViewportDimensions :: (Word32, Word32)
maxViewports :: Word32
maxSamplerAnisotropy :: Float
maxSamplerLodBias :: Float
maxDrawIndirectCount :: Word32
maxDrawIndexedIndexValue :: Word32
mipmapPrecisionBits :: Word32
subTexelPrecisionBits :: Word32
subPixelPrecisionBits :: Word32
maxComputeWorkGroupSize :: (Word32, Word32, Word32)
maxComputeWorkGroupInvocations :: Word32
maxComputeWorkGroupCount :: (Word32, Word32, Word32)
maxComputeSharedMemorySize :: Word32
maxFragmentCombinedOutputResources :: Word32
maxFragmentDualSrcAttachments :: Word32
maxFragmentOutputAttachments :: Word32
maxFragmentInputComponents :: Word32
maxGeometryTotalOutputComponents :: Word32
maxGeometryOutputVertices :: Word32
maxGeometryOutputComponents :: Word32
maxGeometryInputComponents :: Word32
maxGeometryShaderInvocations :: Word32
maxTessellationEvaluationOutputComponents :: Word32
maxTessellationEvaluationInputComponents :: Word32
maxTessellationControlTotalOutputComponents :: Word32
maxTessellationControlPerPatchOutputComponents :: Word32
maxTessellationControlPerVertexOutputComponents :: Word32
maxTessellationControlPerVertexInputComponents :: Word32
maxTessellationPatchSize :: Word32
maxTessellationGenerationLevel :: Word32
maxVertexOutputComponents :: Word32
maxVertexInputBindingStride :: Word32
maxVertexInputAttributeOffset :: Word32
maxVertexInputBindings :: Word32
maxVertexInputAttributes :: Word32
maxDescriptorSetInputAttachments :: Word32
maxDescriptorSetStorageImages :: Word32
maxDescriptorSetSampledImages :: Word32
maxDescriptorSetStorageBuffersDynamic :: Word32
maxDescriptorSetStorageBuffers :: Word32
maxDescriptorSetUniformBuffersDynamic :: Word32
maxDescriptorSetUniformBuffers :: Word32
maxDescriptorSetSamplers :: Word32
maxPerStageResources :: Word32
maxPerStageDescriptorInputAttachments :: Word32
maxPerStageDescriptorStorageImages :: Word32
maxPerStageDescriptorSampledImages :: Word32
maxPerStageDescriptorStorageBuffers :: Word32
maxPerStageDescriptorUniformBuffers :: Word32
maxPerStageDescriptorSamplers :: Word32
maxBoundDescriptorSets :: Word32
sparseAddressSpaceSize :: DeviceSize
bufferImageGranularity :: DeviceSize
maxSamplerAllocationCount :: Word32
maxMemoryAllocationCount :: Word32
maxPushConstantsSize :: Word32
maxStorageBufferRange :: Word32
maxUniformBufferRange :: Word32
maxTexelBufferElements :: Word32
maxImageArrayLayers :: Word32
maxImageDimensionCube :: Word32
maxImageDimension3D :: Word32
maxImageDimension2D :: Word32
maxImageDimension1D :: Word32
$sel:nonCoherentAtomSize:PhysicalDeviceLimits :: PhysicalDeviceLimits -> DeviceSize
$sel:optimalBufferCopyRowPitchAlignment:PhysicalDeviceLimits :: PhysicalDeviceLimits -> DeviceSize
$sel:optimalBufferCopyOffsetAlignment:PhysicalDeviceLimits :: PhysicalDeviceLimits -> DeviceSize
$sel:standardSampleLocations:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Bool
$sel:strictLines:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Bool
$sel:lineWidthGranularity:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Float
$sel:pointSizeGranularity:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Float
$sel:lineWidthRange:PhysicalDeviceLimits :: PhysicalDeviceLimits -> (Float, Float)
$sel:pointSizeRange:PhysicalDeviceLimits :: PhysicalDeviceLimits -> (Float, Float)
$sel:discreteQueuePriorities:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxCombinedClipAndCullDistances:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxCullDistances:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxClipDistances:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:timestampPeriod:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Float
$sel:timestampComputeAndGraphics:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Bool
$sel:maxSampleMaskWords:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:storageImageSampleCounts:PhysicalDeviceLimits :: PhysicalDeviceLimits -> SampleCountFlags
$sel:sampledImageStencilSampleCounts:PhysicalDeviceLimits :: PhysicalDeviceLimits -> SampleCountFlags
$sel:sampledImageDepthSampleCounts:PhysicalDeviceLimits :: PhysicalDeviceLimits -> SampleCountFlags
$sel:sampledImageIntegerSampleCounts:PhysicalDeviceLimits :: PhysicalDeviceLimits -> SampleCountFlags
$sel:sampledImageColorSampleCounts:PhysicalDeviceLimits :: PhysicalDeviceLimits -> SampleCountFlags
$sel:maxColorAttachments:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:framebufferNoAttachmentsSampleCounts:PhysicalDeviceLimits :: PhysicalDeviceLimits -> SampleCountFlags
$sel:framebufferStencilSampleCounts:PhysicalDeviceLimits :: PhysicalDeviceLimits -> SampleCountFlags
$sel:framebufferDepthSampleCounts:PhysicalDeviceLimits :: PhysicalDeviceLimits -> SampleCountFlags
$sel:framebufferColorSampleCounts:PhysicalDeviceLimits :: PhysicalDeviceLimits -> SampleCountFlags
$sel:maxFramebufferLayers:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxFramebufferHeight:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxFramebufferWidth:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:subPixelInterpolationOffsetBits:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxInterpolationOffset:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Float
$sel:minInterpolationOffset:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Float
$sel:maxTexelGatherOffset:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:minTexelGatherOffset:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Int32
$sel:maxTexelOffset:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:minTexelOffset:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Int32
$sel:minStorageBufferOffsetAlignment:PhysicalDeviceLimits :: PhysicalDeviceLimits -> DeviceSize
$sel:minUniformBufferOffsetAlignment:PhysicalDeviceLimits :: PhysicalDeviceLimits -> DeviceSize
$sel:minTexelBufferOffsetAlignment:PhysicalDeviceLimits :: PhysicalDeviceLimits -> DeviceSize
$sel:minMemoryMapAlignment:PhysicalDeviceLimits :: PhysicalDeviceLimits -> DeviceSize
$sel:viewportSubPixelBits:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:viewportBoundsRange:PhysicalDeviceLimits :: PhysicalDeviceLimits -> (Float, Float)
$sel:maxViewportDimensions:PhysicalDeviceLimits :: PhysicalDeviceLimits -> (Word32, Word32)
$sel:maxViewports:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxSamplerAnisotropy:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Float
$sel:maxSamplerLodBias:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Float
$sel:maxDrawIndirectCount:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxDrawIndexedIndexValue:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:mipmapPrecisionBits:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:subTexelPrecisionBits:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:subPixelPrecisionBits:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxComputeWorkGroupSize:PhysicalDeviceLimits :: PhysicalDeviceLimits -> (Word32, Word32, Word32)
$sel:maxComputeWorkGroupInvocations:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxComputeWorkGroupCount:PhysicalDeviceLimits :: PhysicalDeviceLimits -> (Word32, Word32, Word32)
$sel:maxComputeSharedMemorySize:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxFragmentCombinedOutputResources:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxFragmentDualSrcAttachments:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxFragmentOutputAttachments:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxFragmentInputComponents:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxGeometryTotalOutputComponents:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxGeometryOutputVertices:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxGeometryOutputComponents:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxGeometryInputComponents:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxGeometryShaderInvocations:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxTessellationEvaluationOutputComponents:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxTessellationEvaluationInputComponents:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxTessellationControlTotalOutputComponents:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxTessellationControlPerPatchOutputComponents:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxTessellationControlPerVertexOutputComponents:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxTessellationControlPerVertexInputComponents:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxTessellationPatchSize:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxTessellationGenerationLevel:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxVertexOutputComponents:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxVertexInputBindingStride:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxVertexInputAttributeOffset:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxVertexInputBindings:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxVertexInputAttributes:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxDescriptorSetInputAttachments:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxDescriptorSetStorageImages:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxDescriptorSetSampledImages:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxDescriptorSetStorageBuffersDynamic:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxDescriptorSetStorageBuffers:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxDescriptorSetUniformBuffersDynamic:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxDescriptorSetUniformBuffers:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxDescriptorSetSamplers:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxPerStageResources:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxPerStageDescriptorInputAttachments:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxPerStageDescriptorStorageImages:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxPerStageDescriptorSampledImages:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxPerStageDescriptorStorageBuffers:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxPerStageDescriptorUniformBuffers:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxPerStageDescriptorSamplers:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxBoundDescriptorSets:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:sparseAddressSpaceSize:PhysicalDeviceLimits :: PhysicalDeviceLimits -> DeviceSize
$sel:bufferImageGranularity:PhysicalDeviceLimits :: PhysicalDeviceLimits -> DeviceSize
$sel:maxSamplerAllocationCount:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxMemoryAllocationCount:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxPushConstantsSize:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxStorageBufferRange:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxUniformBufferRange:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxTexelBufferElements:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxImageArrayLayers:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxImageDimensionCube:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxImageDimension3D:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxImageDimension2D:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
$sel:maxImageDimension1D:PhysicalDeviceLimits :: PhysicalDeviceLimits -> Word32
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) (Word32
maxImageDimension1D)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32)) (Word32
maxImageDimension2D)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32)) (Word32
maxImageDimension3D)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Word32)) (Word32
maxImageDimensionCube)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (Word32
maxImageArrayLayers)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (Word32
maxTexelBufferElements)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (Word32
maxUniformBufferRange)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (Word32
maxStorageBufferRange)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) (Word32
maxPushConstantsSize)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32)) (Word32
maxMemoryAllocationCount)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word32)) (Word32
maxSamplerAllocationCount)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr DeviceSize)) (DeviceSize
bufferImageGranularity)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr DeviceSize)) (DeviceSize
sparseAddressSpaceSize)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr Word32)) (Word32
maxBoundDescriptorSets)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
68 :: Ptr Word32)) (Word32
maxPerStageDescriptorSamplers)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr Word32)) (Word32
maxPerStageDescriptorUniformBuffers)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
76 :: Ptr Word32)) (Word32
maxPerStageDescriptorStorageBuffers)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80 :: Ptr Word32)) (Word32
maxPerStageDescriptorSampledImages)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
84 :: Ptr Word32)) (Word32
maxPerStageDescriptorStorageImages)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
88 :: Ptr Word32)) (Word32
maxPerStageDescriptorInputAttachments)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
92 :: Ptr Word32)) (Word32
maxPerStageResources)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
96 :: Ptr Word32)) (Word32
maxDescriptorSetSamplers)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
100 :: Ptr Word32)) (Word32
maxDescriptorSetUniformBuffers)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
104 :: Ptr Word32)) (Word32
maxDescriptorSetUniformBuffersDynamic)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
108 :: Ptr Word32)) (Word32
maxDescriptorSetStorageBuffers)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
112 :: Ptr Word32)) (Word32
maxDescriptorSetStorageBuffersDynamic)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
116 :: Ptr Word32)) (Word32
maxDescriptorSetSampledImages)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
120 :: Ptr Word32)) (Word32
maxDescriptorSetStorageImages)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
124 :: Ptr Word32)) (Word32
maxDescriptorSetInputAttachments)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
128 :: Ptr Word32)) (Word32
maxVertexInputAttributes)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
132 :: Ptr Word32)) (Word32
maxVertexInputBindings)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
136 :: Ptr Word32)) (Word32
maxVertexInputAttributeOffset)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
140 :: Ptr Word32)) (Word32
maxVertexInputBindingStride)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
144 :: Ptr Word32)) (Word32
maxVertexOutputComponents)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
148 :: Ptr Word32)) (Word32
maxTessellationGenerationLevel)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
152 :: Ptr Word32)) (Word32
maxTessellationPatchSize)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
156 :: Ptr Word32)) (Word32
maxTessellationControlPerVertexInputComponents)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
160 :: Ptr Word32)) (Word32
maxTessellationControlPerVertexOutputComponents)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
164 :: Ptr Word32)) (Word32
maxTessellationControlPerPatchOutputComponents)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
168 :: Ptr Word32)) (Word32
maxTessellationControlTotalOutputComponents)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
172 :: Ptr Word32)) (Word32
maxTessellationEvaluationInputComponents)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
176 :: Ptr Word32)) (Word32
maxTessellationEvaluationOutputComponents)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
180 :: Ptr Word32)) (Word32
maxGeometryShaderInvocations)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
184 :: Ptr Word32)) (Word32
maxGeometryInputComponents)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
188 :: Ptr Word32)) (Word32
maxGeometryOutputComponents)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
192 :: Ptr Word32)) (Word32
maxGeometryOutputVertices)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
196 :: Ptr Word32)) (Word32
maxGeometryTotalOutputComponents)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
200 :: Ptr Word32)) (Word32
maxFragmentInputComponents)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
204 :: Ptr Word32)) (Word32
maxFragmentOutputAttachments)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
208 :: Ptr Word32)) (Word32
maxFragmentDualSrcAttachments)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
212 :: Ptr Word32)) (Word32
maxFragmentCombinedOutputResources)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
216 :: Ptr Word32)) (Word32
maxComputeSharedMemorySize)
let pMaxComputeWorkGroupCount' :: "pPhysicalDeviceCount" ::: Ptr Word32
pMaxComputeWorkGroupCount' = forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
220 :: Ptr (FixedArray 3 Word32)))
case ((Word32, Word32, Word32)
maxComputeWorkGroupCount) of
(Word32
e0, Word32
e1, Word32
e2) -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pPhysicalDeviceCount" ::: Ptr Word32
pMaxComputeWorkGroupCount' :: Ptr Word32) (Word32
e0)
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pPhysicalDeviceCount" ::: Ptr Word32
pMaxComputeWorkGroupCount' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32) (Word32
e1)
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pPhysicalDeviceCount" ::: Ptr Word32
pMaxComputeWorkGroupCount' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32) (Word32
e2)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
232 :: Ptr Word32)) (Word32
maxComputeWorkGroupInvocations)
let pMaxComputeWorkGroupSize' :: "pPhysicalDeviceCount" ::: Ptr Word32
pMaxComputeWorkGroupSize' = forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
236 :: Ptr (FixedArray 3 Word32)))
case ((Word32, Word32, Word32)
maxComputeWorkGroupSize) of
(Word32
e0, Word32
e1, Word32
e2) -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pPhysicalDeviceCount" ::: Ptr Word32
pMaxComputeWorkGroupSize' :: Ptr Word32) (Word32
e0)
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pPhysicalDeviceCount" ::: Ptr Word32
pMaxComputeWorkGroupSize' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32) (Word32
e1)
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pPhysicalDeviceCount" ::: Ptr Word32
pMaxComputeWorkGroupSize' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32) (Word32
e2)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
248 :: Ptr Word32)) (Word32
subPixelPrecisionBits)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
252 :: Ptr Word32)) (Word32
subTexelPrecisionBits)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
256 :: Ptr Word32)) (Word32
mipmapPrecisionBits)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
260 :: Ptr Word32)) (Word32
maxDrawIndexedIndexValue)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
264 :: Ptr Word32)) (Word32
maxDrawIndirectCount)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
268 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
maxSamplerLodBias))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
272 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
maxSamplerAnisotropy))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
276 :: Ptr Word32)) (Word32
maxViewports)
let pMaxViewportDimensions' :: "pPhysicalDeviceCount" ::: Ptr Word32
pMaxViewportDimensions' = forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
280 :: Ptr (FixedArray 2 Word32)))
case ((Word32, Word32)
maxViewportDimensions) of
(Word32
e0, Word32
e1) -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pPhysicalDeviceCount" ::: Ptr Word32
pMaxViewportDimensions' :: Ptr Word32) (Word32
e0)
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pPhysicalDeviceCount" ::: Ptr Word32
pMaxViewportDimensions' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32) (Word32
e1)
let pViewportBoundsRange' :: Ptr CFloat
pViewportBoundsRange' = forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
288 :: Ptr (FixedArray 2 CFloat)))
case ((Float, Float)
viewportBoundsRange) of
(Float
e0, Float
e1) -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CFloat
pViewportBoundsRange' :: Ptr CFloat) (Float -> CFloat
CFloat (Float
e0))
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CFloat
pViewportBoundsRange' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr CFloat) (Float -> CFloat
CFloat (Float
e1))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
296 :: Ptr Word32)) (Word32
viewportSubPixelBits)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
304 :: Ptr CSize)) (DeviceSize -> CSize
CSize (DeviceSize
minMemoryMapAlignment))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
312 :: Ptr DeviceSize)) (DeviceSize
minTexelBufferOffsetAlignment)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
320 :: Ptr DeviceSize)) (DeviceSize
minUniformBufferOffsetAlignment)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
328 :: Ptr DeviceSize)) (DeviceSize
minStorageBufferOffsetAlignment)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
336 :: Ptr Int32)) (Int32
minTexelOffset)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
340 :: Ptr Word32)) (Word32
maxTexelOffset)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
344 :: Ptr Int32)) (Int32
minTexelGatherOffset)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
348 :: Ptr Word32)) (Word32
maxTexelGatherOffset)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
352 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
minInterpolationOffset))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
356 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
maxInterpolationOffset))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
360 :: Ptr Word32)) (Word32
subPixelInterpolationOffsetBits)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
364 :: Ptr Word32)) (Word32
maxFramebufferWidth)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
368 :: Ptr Word32)) (Word32
maxFramebufferHeight)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
372 :: Ptr Word32)) (Word32
maxFramebufferLayers)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
376 :: Ptr SampleCountFlags)) (SampleCountFlags
framebufferColorSampleCounts)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
380 :: Ptr SampleCountFlags)) (SampleCountFlags
framebufferDepthSampleCounts)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
384 :: Ptr SampleCountFlags)) (SampleCountFlags
framebufferStencilSampleCounts)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
388 :: Ptr SampleCountFlags)) (SampleCountFlags
framebufferNoAttachmentsSampleCounts)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
392 :: Ptr Word32)) (Word32
maxColorAttachments)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
396 :: Ptr SampleCountFlags)) (SampleCountFlags
sampledImageColorSampleCounts)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
400 :: Ptr SampleCountFlags)) (SampleCountFlags
sampledImageIntegerSampleCounts)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
404 :: Ptr SampleCountFlags)) (SampleCountFlags
sampledImageDepthSampleCounts)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
408 :: Ptr SampleCountFlags)) (SampleCountFlags
sampledImageStencilSampleCounts)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
412 :: Ptr SampleCountFlags)) (SampleCountFlags
storageImageSampleCounts)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
416 :: Ptr Word32)) (Word32
maxSampleMaskWords)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
420 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
timestampComputeAndGraphics))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
424 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
timestampPeriod))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
428 :: Ptr Word32)) (Word32
maxClipDistances)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
432 :: Ptr Word32)) (Word32
maxCullDistances)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
436 :: Ptr Word32)) (Word32
maxCombinedClipAndCullDistances)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
440 :: Ptr Word32)) (Word32
discreteQueuePriorities)
let pPointSizeRange' :: Ptr CFloat
pPointSizeRange' = forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
444 :: Ptr (FixedArray 2 CFloat)))
case ((Float, Float)
pointSizeRange) of
(Float
e0, Float
e1) -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CFloat
pPointSizeRange' :: Ptr CFloat) (Float -> CFloat
CFloat (Float
e0))
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CFloat
pPointSizeRange' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr CFloat) (Float -> CFloat
CFloat (Float
e1))
let pLineWidthRange' :: Ptr CFloat
pLineWidthRange' = forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
452 :: Ptr (FixedArray 2 CFloat)))
case ((Float, Float)
lineWidthRange) of
(Float
e0, Float
e1) -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CFloat
pLineWidthRange' :: Ptr CFloat) (Float -> CFloat
CFloat (Float
e0))
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CFloat
pLineWidthRange' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr CFloat) (Float -> CFloat
CFloat (Float
e1))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
460 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
pointSizeGranularity))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
464 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
lineWidthGranularity))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
468 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
strictLines))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
472 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
standardSampleLocations))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
480 :: Ptr DeviceSize)) (DeviceSize
optimalBufferCopyOffsetAlignment)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
488 :: Ptr DeviceSize)) (DeviceSize
optimalBufferCopyRowPitchAlignment)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
496 :: Ptr DeviceSize)) (DeviceSize
nonCoherentAtomSize)
IO b
f
cStructSize :: Int
cStructSize = Int
504
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b. Ptr PhysicalDeviceLimits -> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceLimits
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
68 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
76 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
84 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
88 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
92 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
96 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
100 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
104 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
108 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
112 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
116 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
120 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
124 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
128 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
132 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
136 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
140 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
144 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
148 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
152 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
156 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
160 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
164 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
168 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
172 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
176 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
180 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
184 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
188 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
192 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
196 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
200 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
204 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
208 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
212 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
216 :: Ptr Word32)) (forall a. Zero a => a
zero)
let pMaxComputeWorkGroupCount' :: "pPhysicalDeviceCount" ::: Ptr Word32
pMaxComputeWorkGroupCount' = forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
220 :: Ptr (FixedArray 3 Word32)))
case ((forall a. Zero a => a
zero, forall a. Zero a => a
zero, forall a. Zero a => a
zero)) of
(Word32
e0, Word32
e1, Word32
e2) -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pPhysicalDeviceCount" ::: Ptr Word32
pMaxComputeWorkGroupCount' :: Ptr Word32) (Word32
e0)
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pPhysicalDeviceCount" ::: Ptr Word32
pMaxComputeWorkGroupCount' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32) (Word32
e1)
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pPhysicalDeviceCount" ::: Ptr Word32
pMaxComputeWorkGroupCount' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32) (Word32
e2)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
232 :: Ptr Word32)) (forall a. Zero a => a
zero)
let pMaxComputeWorkGroupSize' :: "pPhysicalDeviceCount" ::: Ptr Word32
pMaxComputeWorkGroupSize' = forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
236 :: Ptr (FixedArray 3 Word32)))
case ((forall a. Zero a => a
zero, forall a. Zero a => a
zero, forall a. Zero a => a
zero)) of
(Word32
e0, Word32
e1, Word32
e2) -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pPhysicalDeviceCount" ::: Ptr Word32
pMaxComputeWorkGroupSize' :: Ptr Word32) (Word32
e0)
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pPhysicalDeviceCount" ::: Ptr Word32
pMaxComputeWorkGroupSize' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32) (Word32
e1)
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pPhysicalDeviceCount" ::: Ptr Word32
pMaxComputeWorkGroupSize' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32) (Word32
e2)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
248 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
252 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
256 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
260 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
264 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
268 :: Ptr CFloat)) (Float -> CFloat
CFloat (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
272 :: Ptr CFloat)) (Float -> CFloat
CFloat (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
276 :: Ptr Word32)) (forall a. Zero a => a
zero)
let pMaxViewportDimensions' :: "pPhysicalDeviceCount" ::: Ptr Word32
pMaxViewportDimensions' = forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
280 :: Ptr (FixedArray 2 Word32)))
case ((forall a. Zero a => a
zero, forall a. Zero a => a
zero)) of
(Word32
e0, Word32
e1) -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pPhysicalDeviceCount" ::: Ptr Word32
pMaxViewportDimensions' :: Ptr Word32) (Word32
e0)
forall a. Storable a => Ptr a -> a -> IO ()
poke ("pPhysicalDeviceCount" ::: Ptr Word32
pMaxViewportDimensions' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32) (Word32
e1)
let pViewportBoundsRange' :: Ptr CFloat
pViewportBoundsRange' = forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
288 :: Ptr (FixedArray 2 CFloat)))
case ((forall a. Zero a => a
zero, forall a. Zero a => a
zero)) of
(Float
e0, Float
e1) -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CFloat
pViewportBoundsRange' :: Ptr CFloat) (Float -> CFloat
CFloat (Float
e0))
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CFloat
pViewportBoundsRange' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr CFloat) (Float -> CFloat
CFloat (Float
e1))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
296 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
304 :: Ptr CSize)) (DeviceSize -> CSize
CSize (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
312 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
320 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
328 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
336 :: Ptr Int32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
340 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
344 :: Ptr Int32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
348 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
352 :: Ptr CFloat)) (Float -> CFloat
CFloat (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
356 :: Ptr CFloat)) (Float -> CFloat
CFloat (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
360 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
364 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
368 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
372 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
392 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
416 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
420 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
424 :: Ptr CFloat)) (Float -> CFloat
CFloat (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
428 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
432 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
436 :: Ptr Word32)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
440 :: Ptr Word32)) (forall a. Zero a => a
zero)
let pPointSizeRange' :: Ptr CFloat
pPointSizeRange' = forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
444 :: Ptr (FixedArray 2 CFloat)))
case ((forall a. Zero a => a
zero, forall a. Zero a => a
zero)) of
(Float
e0, Float
e1) -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CFloat
pPointSizeRange' :: Ptr CFloat) (Float -> CFloat
CFloat (Float
e0))
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CFloat
pPointSizeRange' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr CFloat) (Float -> CFloat
CFloat (Float
e1))
let pLineWidthRange' :: Ptr CFloat
pLineWidthRange' = forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
452 :: Ptr (FixedArray 2 CFloat)))
case ((forall a. Zero a => a
zero, forall a. Zero a => a
zero)) of
(Float
e0, Float
e1) -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CFloat
pLineWidthRange' :: Ptr CFloat) (Float -> CFloat
CFloat (Float
e0))
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CFloat
pLineWidthRange' forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr CFloat) (Float -> CFloat
CFloat (Float
e1))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
460 :: Ptr CFloat)) (Float -> CFloat
CFloat (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
464 :: Ptr CFloat)) (Float -> CFloat
CFloat (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
468 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
472 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
480 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
488 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
496 :: Ptr DeviceSize)) (forall a. Zero a => a
zero)
IO b
f
instance FromCStruct PhysicalDeviceLimits where
peekCStruct :: Ptr PhysicalDeviceLimits -> IO PhysicalDeviceLimits
peekCStruct Ptr PhysicalDeviceLimits
p = do
Word32
maxImageDimension1D <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr Word32))
Word32
maxImageDimension2D <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4 :: Ptr Word32))
Word32
maxImageDimension3D <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word32))
Word32
maxImageDimensionCube <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: Ptr Word32))
Word32
maxImageArrayLayers <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Word32))
Word32
maxTexelBufferElements <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
Word32
maxUniformBufferRange <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr Word32))
Word32
maxStorageBufferRange <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
28 :: Ptr Word32))
Word32
maxPushConstantsSize <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr Word32))
Word32
maxMemoryAllocationCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
36 :: Ptr Word32))
Word32
maxSamplerAllocationCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40 :: Ptr Word32))
DeviceSize
bufferImageGranularity <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48 :: Ptr DeviceSize))
DeviceSize
sparseAddressSpaceSize <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56 :: Ptr DeviceSize))
Word32
maxBoundDescriptorSets <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64 :: Ptr Word32))
Word32
maxPerStageDescriptorSamplers <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
68 :: Ptr Word32))
Word32
maxPerStageDescriptorUniformBuffers <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72 :: Ptr Word32))
Word32
maxPerStageDescriptorStorageBuffers <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
76 :: Ptr Word32))
Word32
maxPerStageDescriptorSampledImages <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80 :: Ptr Word32))
Word32
maxPerStageDescriptorStorageImages <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
84 :: Ptr Word32))
Word32
maxPerStageDescriptorInputAttachments <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
88 :: Ptr Word32))
Word32
maxPerStageResources <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
92 :: Ptr Word32))
Word32
maxDescriptorSetSamplers <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
96 :: Ptr Word32))
Word32
maxDescriptorSetUniformBuffers <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
100 :: Ptr Word32))
Word32
maxDescriptorSetUniformBuffersDynamic <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
104 :: Ptr Word32))
Word32
maxDescriptorSetStorageBuffers <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
108 :: Ptr Word32))
Word32
maxDescriptorSetStorageBuffersDynamic <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
112 :: Ptr Word32))
Word32
maxDescriptorSetSampledImages <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
116 :: Ptr Word32))
Word32
maxDescriptorSetStorageImages <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
120 :: Ptr Word32))
Word32
maxDescriptorSetInputAttachments <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
124 :: Ptr Word32))
Word32
maxVertexInputAttributes <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
128 :: Ptr Word32))
Word32
maxVertexInputBindings <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
132 :: Ptr Word32))
Word32
maxVertexInputAttributeOffset <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
136 :: Ptr Word32))
Word32
maxVertexInputBindingStride <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
140 :: Ptr Word32))
Word32
maxVertexOutputComponents <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
144 :: Ptr Word32))
Word32
maxTessellationGenerationLevel <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
148 :: Ptr Word32))
Word32
maxTessellationPatchSize <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
152 :: Ptr Word32))
Word32
maxTessellationControlPerVertexInputComponents <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
156 :: Ptr Word32))
Word32
maxTessellationControlPerVertexOutputComponents <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
160 :: Ptr Word32))
Word32
maxTessellationControlPerPatchOutputComponents <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
164 :: Ptr Word32))
Word32
maxTessellationControlTotalOutputComponents <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
168 :: Ptr Word32))
Word32
maxTessellationEvaluationInputComponents <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
172 :: Ptr Word32))
Word32
maxTessellationEvaluationOutputComponents <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
176 :: Ptr Word32))
Word32
maxGeometryShaderInvocations <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
180 :: Ptr Word32))
Word32
maxGeometryInputComponents <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
184 :: Ptr Word32))
Word32
maxGeometryOutputComponents <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
188 :: Ptr Word32))
Word32
maxGeometryOutputVertices <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
192 :: Ptr Word32))
Word32
maxGeometryTotalOutputComponents <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
196 :: Ptr Word32))
Word32
maxFragmentInputComponents <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
200 :: Ptr Word32))
Word32
maxFragmentOutputAttachments <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
204 :: Ptr Word32))
Word32
maxFragmentDualSrcAttachments <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
208 :: Ptr Word32))
Word32
maxFragmentCombinedOutputResources <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
212 :: Ptr Word32))
Word32
maxComputeSharedMemorySize <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
216 :: Ptr Word32))
let pmaxComputeWorkGroupCount :: "pPhysicalDeviceCount" ::: Ptr Word32
pmaxComputeWorkGroupCount = forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
220 :: Ptr (FixedArray 3 Word32)))
Word32
maxComputeWorkGroupCount0 <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pPhysicalDeviceCount" ::: Ptr Word32
pmaxComputeWorkGroupCount forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` Int
0 :: Ptr Word32))
Word32
maxComputeWorkGroupCount1 <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pPhysicalDeviceCount" ::: Ptr Word32
pmaxComputeWorkGroupCount forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` Int
4 :: Ptr Word32))
Word32
maxComputeWorkGroupCount2 <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pPhysicalDeviceCount" ::: Ptr Word32
pmaxComputeWorkGroupCount forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` Int
8 :: Ptr Word32))
Word32
maxComputeWorkGroupInvocations <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
232 :: Ptr Word32))
let pmaxComputeWorkGroupSize :: "pPhysicalDeviceCount" ::: Ptr Word32
pmaxComputeWorkGroupSize = forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
236 :: Ptr (FixedArray 3 Word32)))
Word32
maxComputeWorkGroupSize0 <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pPhysicalDeviceCount" ::: Ptr Word32
pmaxComputeWorkGroupSize forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` Int
0 :: Ptr Word32))
Word32
maxComputeWorkGroupSize1 <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pPhysicalDeviceCount" ::: Ptr Word32
pmaxComputeWorkGroupSize forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` Int
4 :: Ptr Word32))
Word32
maxComputeWorkGroupSize2 <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pPhysicalDeviceCount" ::: Ptr Word32
pmaxComputeWorkGroupSize forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` Int
8 :: Ptr Word32))
Word32
subPixelPrecisionBits <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
248 :: Ptr Word32))
Word32
subTexelPrecisionBits <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
252 :: Ptr Word32))
Word32
mipmapPrecisionBits <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
256 :: Ptr Word32))
Word32
maxDrawIndexedIndexValue <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
260 :: Ptr Word32))
Word32
maxDrawIndirectCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
264 :: Ptr Word32))
CFloat
maxSamplerLodBias <- forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
268 :: Ptr CFloat))
CFloat
maxSamplerAnisotropy <- forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
272 :: Ptr CFloat))
Word32
maxViewports <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
276 :: Ptr Word32))
let pmaxViewportDimensions :: "pPhysicalDeviceCount" ::: Ptr Word32
pmaxViewportDimensions = forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
280 :: Ptr (FixedArray 2 Word32)))
Word32
maxViewportDimensions0 <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pPhysicalDeviceCount" ::: Ptr Word32
pmaxViewportDimensions forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` Int
0 :: Ptr Word32))
Word32
maxViewportDimensions1 <- forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pPhysicalDeviceCount" ::: Ptr Word32
pmaxViewportDimensions forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` Int
4 :: Ptr Word32))
let pviewportBoundsRange :: Ptr CFloat
pviewportBoundsRange = forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr @CFloat ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
288 :: Ptr (FixedArray 2 CFloat)))
CFloat
viewportBoundsRange0 <- forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr CFloat
pviewportBoundsRange forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` Int
0 :: Ptr CFloat))
CFloat
viewportBoundsRange1 <- forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr CFloat
pviewportBoundsRange forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` Int
4 :: Ptr CFloat))
Word32
viewportSubPixelBits <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
296 :: Ptr Word32))
CSize
minMemoryMapAlignment <- forall a. Storable a => Ptr a -> IO a
peek @CSize ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
304 :: Ptr CSize))
DeviceSize
minTexelBufferOffsetAlignment <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
312 :: Ptr DeviceSize))
DeviceSize
minUniformBufferOffsetAlignment <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
320 :: Ptr DeviceSize))
DeviceSize
minStorageBufferOffsetAlignment <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
328 :: Ptr DeviceSize))
Int32
minTexelOffset <- forall a. Storable a => Ptr a -> IO a
peek @Int32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
336 :: Ptr Int32))
Word32
maxTexelOffset <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
340 :: Ptr Word32))
Int32
minTexelGatherOffset <- forall a. Storable a => Ptr a -> IO a
peek @Int32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
344 :: Ptr Int32))
Word32
maxTexelGatherOffset <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
348 :: Ptr Word32))
CFloat
minInterpolationOffset <- forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
352 :: Ptr CFloat))
CFloat
maxInterpolationOffset <- forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
356 :: Ptr CFloat))
Word32
subPixelInterpolationOffsetBits <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
360 :: Ptr Word32))
Word32
maxFramebufferWidth <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
364 :: Ptr Word32))
Word32
maxFramebufferHeight <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
368 :: Ptr Word32))
Word32
maxFramebufferLayers <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
372 :: Ptr Word32))
SampleCountFlags
framebufferColorSampleCounts <- forall a. Storable a => Ptr a -> IO a
peek @SampleCountFlags ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
376 :: Ptr SampleCountFlags))
SampleCountFlags
framebufferDepthSampleCounts <- forall a. Storable a => Ptr a -> IO a
peek @SampleCountFlags ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
380 :: Ptr SampleCountFlags))
SampleCountFlags
framebufferStencilSampleCounts <- forall a. Storable a => Ptr a -> IO a
peek @SampleCountFlags ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
384 :: Ptr SampleCountFlags))
SampleCountFlags
framebufferNoAttachmentsSampleCounts <- forall a. Storable a => Ptr a -> IO a
peek @SampleCountFlags ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
388 :: Ptr SampleCountFlags))
Word32
maxColorAttachments <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
392 :: Ptr Word32))
SampleCountFlags
sampledImageColorSampleCounts <- forall a. Storable a => Ptr a -> IO a
peek @SampleCountFlags ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
396 :: Ptr SampleCountFlags))
SampleCountFlags
sampledImageIntegerSampleCounts <- forall a. Storable a => Ptr a -> IO a
peek @SampleCountFlags ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
400 :: Ptr SampleCountFlags))
SampleCountFlags
sampledImageDepthSampleCounts <- forall a. Storable a => Ptr a -> IO a
peek @SampleCountFlags ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
404 :: Ptr SampleCountFlags))
SampleCountFlags
sampledImageStencilSampleCounts <- forall a. Storable a => Ptr a -> IO a
peek @SampleCountFlags ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
408 :: Ptr SampleCountFlags))
SampleCountFlags
storageImageSampleCounts <- forall a. Storable a => Ptr a -> IO a
peek @SampleCountFlags ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
412 :: Ptr SampleCountFlags))
Word32
maxSampleMaskWords <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
416 :: Ptr Word32))
Bool32
timestampComputeAndGraphics <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
420 :: Ptr Bool32))
CFloat
timestampPeriod <- forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
424 :: Ptr CFloat))
Word32
maxClipDistances <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
428 :: Ptr Word32))
Word32
maxCullDistances <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
432 :: Ptr Word32))
Word32
maxCombinedClipAndCullDistances <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
436 :: Ptr Word32))
Word32
discreteQueuePriorities <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
440 :: Ptr Word32))
let ppointSizeRange :: Ptr CFloat
ppointSizeRange = forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr @CFloat ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
444 :: Ptr (FixedArray 2 CFloat)))
CFloat
pointSizeRange0 <- forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr CFloat
ppointSizeRange forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` Int
0 :: Ptr CFloat))
CFloat
pointSizeRange1 <- forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr CFloat
ppointSizeRange forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` Int
4 :: Ptr CFloat))
let plineWidthRange :: Ptr CFloat
plineWidthRange = forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr @CFloat ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
452 :: Ptr (FixedArray 2 CFloat)))
CFloat
lineWidthRange0 <- forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr CFloat
plineWidthRange forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` Int
0 :: Ptr CFloat))
CFloat
lineWidthRange1 <- forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr CFloat
plineWidthRange forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` Int
4 :: Ptr CFloat))
CFloat
pointSizeGranularity <- forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
460 :: Ptr CFloat))
CFloat
lineWidthGranularity <- forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
464 :: Ptr CFloat))
Bool32
strictLines <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
468 :: Ptr Bool32))
Bool32
standardSampleLocations <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
472 :: Ptr Bool32))
DeviceSize
optimalBufferCopyOffsetAlignment <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
480 :: Ptr DeviceSize))
DeviceSize
optimalBufferCopyRowPitchAlignment <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
488 :: Ptr DeviceSize))
DeviceSize
nonCoherentAtomSize <- forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr PhysicalDeviceLimits
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
496 :: Ptr DeviceSize))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> DeviceSize
-> DeviceSize
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> (Word32, Word32, Word32)
-> Word32
-> (Word32, Word32, Word32)
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Float
-> Float
-> Word32
-> (Word32, Word32)
-> (Float, Float)
-> Word32
-> DeviceSize
-> DeviceSize
-> DeviceSize
-> DeviceSize
-> Int32
-> Word32
-> Int32
-> Word32
-> Float
-> Float
-> Word32
-> Word32
-> Word32
-> Word32
-> SampleCountFlags
-> SampleCountFlags
-> SampleCountFlags
-> SampleCountFlags
-> Word32
-> SampleCountFlags
-> SampleCountFlags
-> SampleCountFlags
-> SampleCountFlags
-> SampleCountFlags
-> Word32
-> Bool
-> Float
-> Word32
-> Word32
-> Word32
-> Word32
-> (Float, Float)
-> (Float, Float)
-> Float
-> Float
-> Bool
-> Bool
-> DeviceSize
-> DeviceSize
-> DeviceSize
-> PhysicalDeviceLimits
PhysicalDeviceLimits
Word32
maxImageDimension1D
Word32
maxImageDimension2D
Word32
maxImageDimension3D
Word32
maxImageDimensionCube
Word32
maxImageArrayLayers
Word32
maxTexelBufferElements
Word32
maxUniformBufferRange
Word32
maxStorageBufferRange
Word32
maxPushConstantsSize
Word32
maxMemoryAllocationCount
Word32
maxSamplerAllocationCount
DeviceSize
bufferImageGranularity
DeviceSize
sparseAddressSpaceSize
Word32
maxBoundDescriptorSets
Word32
maxPerStageDescriptorSamplers
Word32
maxPerStageDescriptorUniformBuffers
Word32
maxPerStageDescriptorStorageBuffers
Word32
maxPerStageDescriptorSampledImages
Word32
maxPerStageDescriptorStorageImages
Word32
maxPerStageDescriptorInputAttachments
Word32
maxPerStageResources
Word32
maxDescriptorSetSamplers
Word32
maxDescriptorSetUniformBuffers
Word32
maxDescriptorSetUniformBuffersDynamic
Word32
maxDescriptorSetStorageBuffers
Word32
maxDescriptorSetStorageBuffersDynamic
Word32
maxDescriptorSetSampledImages
Word32
maxDescriptorSetStorageImages
Word32
maxDescriptorSetInputAttachments
Word32
maxVertexInputAttributes
Word32
maxVertexInputBindings
Word32
maxVertexInputAttributeOffset
Word32
maxVertexInputBindingStride
Word32
maxVertexOutputComponents
Word32
maxTessellationGenerationLevel
Word32
maxTessellationPatchSize
Word32
maxTessellationControlPerVertexInputComponents
Word32
maxTessellationControlPerVertexOutputComponents
Word32
maxTessellationControlPerPatchOutputComponents
Word32
maxTessellationControlTotalOutputComponents
Word32
maxTessellationEvaluationInputComponents
Word32
maxTessellationEvaluationOutputComponents
Word32
maxGeometryShaderInvocations
Word32
maxGeometryInputComponents
Word32
maxGeometryOutputComponents
Word32
maxGeometryOutputVertices
Word32
maxGeometryTotalOutputComponents
Word32
maxFragmentInputComponents
Word32
maxFragmentOutputAttachments
Word32
maxFragmentDualSrcAttachments
Word32
maxFragmentCombinedOutputResources
Word32
maxComputeSharedMemorySize
(( Word32
maxComputeWorkGroupCount0
, Word32
maxComputeWorkGroupCount1
, Word32
maxComputeWorkGroupCount2 ))
Word32
maxComputeWorkGroupInvocations
(( Word32
maxComputeWorkGroupSize0
, Word32
maxComputeWorkGroupSize1
, Word32
maxComputeWorkGroupSize2 ))
Word32
subPixelPrecisionBits
Word32
subTexelPrecisionBits
Word32
mipmapPrecisionBits
Word32
maxDrawIndexedIndexValue
Word32
maxDrawIndirectCount
(coerce :: forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
maxSamplerLodBias)
(coerce :: forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
maxSamplerAnisotropy)
Word32
maxViewports
((Word32
maxViewportDimensions0, Word32
maxViewportDimensions1))
(( (coerce :: forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
viewportBoundsRange0)
, (coerce :: forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
viewportBoundsRange1) ))
Word32
viewportSubPixelBits
(coerce :: forall a b. Coercible a b => a -> b
coerce @CSize @Word64 CSize
minMemoryMapAlignment)
DeviceSize
minTexelBufferOffsetAlignment
DeviceSize
minUniformBufferOffsetAlignment
DeviceSize
minStorageBufferOffsetAlignment
Int32
minTexelOffset
Word32
maxTexelOffset
Int32
minTexelGatherOffset
Word32
maxTexelGatherOffset
(coerce :: forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
minInterpolationOffset)
(coerce :: forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
maxInterpolationOffset)
Word32
subPixelInterpolationOffsetBits
Word32
maxFramebufferWidth
Word32
maxFramebufferHeight
Word32
maxFramebufferLayers
SampleCountFlags
framebufferColorSampleCounts
SampleCountFlags
framebufferDepthSampleCounts
SampleCountFlags
framebufferStencilSampleCounts
SampleCountFlags
framebufferNoAttachmentsSampleCounts
Word32
maxColorAttachments
SampleCountFlags
sampledImageColorSampleCounts
SampleCountFlags
sampledImageIntegerSampleCounts
SampleCountFlags
sampledImageDepthSampleCounts
SampleCountFlags
sampledImageStencilSampleCounts
SampleCountFlags
storageImageSampleCounts
Word32
maxSampleMaskWords
(Bool32 -> Bool
bool32ToBool Bool32
timestampComputeAndGraphics)
(coerce :: forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
timestampPeriod)
Word32
maxClipDistances
Word32
maxCullDistances
Word32
maxCombinedClipAndCullDistances
Word32
discreteQueuePriorities
(( (coerce :: forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
pointSizeRange0)
, (coerce :: forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
pointSizeRange1) ))
(( (coerce :: forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
lineWidthRange0)
, (coerce :: forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
lineWidthRange1) ))
(coerce :: forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
pointSizeGranularity)
(coerce :: forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
lineWidthGranularity)
(Bool32 -> Bool
bool32ToBool Bool32
strictLines)
(Bool32 -> Bool
bool32ToBool Bool32
standardSampleLocations)
DeviceSize
optimalBufferCopyOffsetAlignment
DeviceSize
optimalBufferCopyRowPitchAlignment
DeviceSize
nonCoherentAtomSize
instance Storable PhysicalDeviceLimits where
sizeOf :: PhysicalDeviceLimits -> Int
sizeOf ~PhysicalDeviceLimits
_ = Int
504
alignment :: PhysicalDeviceLimits -> Int
alignment ~PhysicalDeviceLimits
_ = Int
8
peek :: Ptr PhysicalDeviceLimits -> IO PhysicalDeviceLimits
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PhysicalDeviceLimits -> PhysicalDeviceLimits -> IO ()
poke Ptr PhysicalDeviceLimits
ptr PhysicalDeviceLimits
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceLimits
ptr PhysicalDeviceLimits
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDeviceLimits where
zero :: PhysicalDeviceLimits
zero = Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> DeviceSize
-> DeviceSize
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> (Word32, Word32, Word32)
-> Word32
-> (Word32, Word32, Word32)
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Float
-> Float
-> Word32
-> (Word32, Word32)
-> (Float, Float)
-> Word32
-> DeviceSize
-> DeviceSize
-> DeviceSize
-> DeviceSize
-> Int32
-> Word32
-> Int32
-> Word32
-> Float
-> Float
-> Word32
-> Word32
-> Word32
-> Word32
-> SampleCountFlags
-> SampleCountFlags
-> SampleCountFlags
-> SampleCountFlags
-> Word32
-> SampleCountFlags
-> SampleCountFlags
-> SampleCountFlags
-> SampleCountFlags
-> SampleCountFlags
-> Word32
-> Bool
-> Float
-> Word32
-> Word32
-> Word32
-> Word32
-> (Float, Float)
-> (Float, Float)
-> Float
-> Float
-> Bool
-> Bool
-> DeviceSize
-> DeviceSize
-> DeviceSize
-> PhysicalDeviceLimits
PhysicalDeviceLimits
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
(forall a. Zero a => a
zero, forall a. Zero a => a
zero, forall a. Zero a => a
zero)
forall a. Zero a => a
zero
(forall a. Zero a => a
zero, forall a. Zero a => a
zero, forall a. Zero a => a
zero)
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
(forall a. Zero a => a
zero, forall a. Zero a => a
zero)
(forall a. Zero a => a
zero, forall a. Zero a => a
zero)
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
(forall a. Zero a => a
zero, forall a. Zero a => a
zero)
(forall a. Zero a => a
zero, forall a. Zero a => a
zero)
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero