{-# 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(..)
, InstanceCreateFlags(..)
, ImageType(..)
, ImageTiling(..)
, InternalAllocationType(..)
, SystemAllocationScope(..)
, PhysicalDeviceType(..)
, Format(..)
, StructureType(..)
, QueueFlagBits(..)
, QueueFlags
, MemoryPropertyFlagBits(..)
, MemoryPropertyFlags
, MemoryHeapFlagBits(..)
, MemoryHeapFlags
, ImageUsageFlagBits(..)
, ImageUsageFlags
, ImageCreateFlagBits(..)
, ImageCreateFlags
, FormatFeatureFlagBits(..)
, FormatFeatureFlags
, SampleCountFlagBits(..)
, SampleCountFlags
, 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 Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytesAligned)
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 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 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(CFloat))
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.Dynamic (DeviceCmds(pVkGetDeviceProcAddr))
import Vulkan.Core10.FundamentalTypes (DeviceSize)
import Vulkan.Core10.Handles (Device_T)
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.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
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.InstanceCreateFlags (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.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
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.Zero (Zero(..))
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.InstanceCreateFlags (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.StructureType (StructureType(..))
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 :: InstanceCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks) -> io Instance
createInstance createInfo :: InstanceCreateInfo a
createInfo allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO Instance -> io Instance
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Instance -> io Instance)
-> (ContT Instance IO Instance -> IO Instance)
-> ContT Instance IO Instance
-> io Instance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Instance IO Instance -> IO Instance
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Instance IO Instance -> io Instance)
-> ContT Instance IO Instance -> io Instance
forall a b. (a -> b) -> a -> b
$ do
FunPtr
(("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pInstance" ::: Ptr (Ptr Instance_T))
-> IO Result)
vkCreateInstancePtr <- IO
(FunPtr
(("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pInstance" ::: Ptr (Ptr Instance_T))
-> IO Result))
-> ContT
Instance
IO
(FunPtr
(("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pInstance" ::: Ptr (Ptr Instance_T))
-> IO Result))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO
(FunPtr
(("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pInstance" ::: Ptr (Ptr Instance_T))
-> IO Result))
-> ContT
Instance
IO
(FunPtr
(("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pInstance" ::: Ptr (Ptr Instance_T))
-> IO Result)))
-> IO
(FunPtr
(("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pInstance" ::: Ptr (Ptr Instance_T))
-> IO Result))
-> ContT
Instance
IO
(FunPtr
(("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pInstance" ::: Ptr (Ptr Instance_T))
-> IO Result))
forall a b. (a -> b) -> a -> b
$ FunPtr FN_vkVoidFunction
-> FunPtr
(("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pInstance" ::: Ptr (Ptr Instance_T))
-> IO Result)
forall a b. FunPtr a -> FunPtr b
castFunPtr @_ @(("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo)) -> ("pAllocator" ::: Ptr AllocationCallbacks) -> ("pInstance" ::: Ptr (Ptr Instance_T)) -> IO Result) (FunPtr FN_vkVoidFunction
-> FunPtr
(("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pInstance" ::: Ptr (Ptr Instance_T))
-> IO Result))
-> IO (FunPtr FN_vkVoidFunction)
-> IO
(FunPtr
(("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 (FunPtr FN_vkVoidFunction)
getInstanceProcAddr' Ptr Instance_T
forall a. Ptr a
nullPtr (Addr# -> "pName" ::: Ptr CChar
forall a. Addr# -> Ptr a
Ptr "vkCreateInstance"#)
IO () -> ContT Instance IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Instance IO ()) -> IO () -> ContT Instance IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pInstance" ::: Ptr (Ptr Instance_T))
-> IO Result)
vkCreateInstancePtr FunPtr
(("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pInstance" ::: Ptr (Ptr Instance_T))
-> IO Result)
-> FunPtr
(("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pInstance" ::: Ptr (Ptr Instance_T))
-> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pInstance" ::: Ptr (Ptr Instance_T))
-> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkCreateInstance is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
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 <- ((Ptr (InstanceCreateInfo a) -> IO Instance) -> IO Instance)
-> ContT Instance IO (Ptr (InstanceCreateInfo a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (InstanceCreateInfo a) -> IO Instance) -> IO Instance)
-> ContT Instance IO (Ptr (InstanceCreateInfo a)))
-> ((Ptr (InstanceCreateInfo a) -> IO Instance) -> IO Instance)
-> ContT Instance IO (Ptr (InstanceCreateInfo a))
forall a b. (a -> b) -> a -> b
$ InstanceCreateInfo a
-> (Ptr (InstanceCreateInfo a) -> IO Instance) -> IO Instance
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
Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT Instance IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO Instance)
-> IO Instance)
-> ContT Instance IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO Instance)
-> IO Instance)
-> ContT Instance IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO Instance)
-> IO Instance)
-> ContT Instance IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO Instance)
-> IO Instance
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
"pInstance" ::: Ptr (Ptr Instance_T)
pPInstance <- ((("pInstance" ::: Ptr (Ptr Instance_T)) -> IO Instance)
-> IO Instance)
-> ContT Instance IO ("pInstance" ::: Ptr (Ptr Instance_T))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pInstance" ::: Ptr (Ptr Instance_T)) -> IO Instance)
-> IO Instance)
-> ContT Instance IO ("pInstance" ::: Ptr (Ptr Instance_T)))
-> ((("pInstance" ::: Ptr (Ptr Instance_T)) -> IO Instance)
-> IO Instance)
-> ContT Instance IO ("pInstance" ::: Ptr (Ptr Instance_T))
forall a b. (a -> b) -> a -> b
$ IO ("pInstance" ::: Ptr (Ptr Instance_T))
-> (("pInstance" ::: Ptr (Ptr Instance_T)) -> IO ())
-> (("pInstance" ::: Ptr (Ptr Instance_T)) -> IO Instance)
-> IO Instance
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pInstance" ::: Ptr (Ptr Instance_T))
forall a. Int -> IO (Ptr a)
callocBytes @(Ptr Instance_T) 8) ("pInstance" ::: Ptr (Ptr Instance_T)) -> IO ()
forall a. Ptr a -> IO ()
free
Result
r <- IO Result -> ContT Instance IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT Instance IO Result)
-> IO Result -> ContT Instance IO Result
forall a b. (a -> b) -> a -> b
$ ("pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo))
-> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ("pInstance" ::: Ptr (Ptr Instance_T))
-> IO Result
vkCreateInstance' (Ptr (InstanceCreateInfo a)
-> "pCreateInfo" ::: Ptr (SomeStruct InstanceCreateInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (InstanceCreateInfo a)
pCreateInfo) "pAllocator" ::: Ptr AllocationCallbacks
pAllocator ("pInstance" ::: Ptr (Ptr Instance_T)
pPInstance)
IO () -> ContT Instance IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Instance IO ()) -> IO () -> ContT Instance IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
Ptr Instance_T
pInstance <- IO (Ptr Instance_T) -> ContT Instance IO (Ptr Instance_T)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Ptr Instance_T) -> ContT Instance IO (Ptr Instance_T))
-> IO (Ptr Instance_T) -> ContT Instance IO (Ptr Instance_T)
forall a b. (a -> b) -> a -> b
$ ("pInstance" ::: Ptr (Ptr Instance_T)) -> IO (Ptr Instance_T)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Instance_T) "pInstance" ::: Ptr (Ptr Instance_T)
pPInstance
Instance
pInstance' <- IO Instance -> ContT Instance IO Instance
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Instance -> ContT Instance IO Instance)
-> IO Instance -> ContT Instance IO Instance
forall a b. (a -> b) -> a -> b
$ (\h :: Ptr Instance_T
h -> Ptr Instance_T -> InstanceCmds -> Instance
Instance Ptr Instance_T
h (InstanceCmds -> Instance) -> IO InstanceCmds -> IO Instance
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
Instance -> ContT Instance IO Instance
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Instance -> ContT Instance IO Instance)
-> Instance -> ContT Instance IO Instance
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 :: InstanceCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks)
-> (io Instance -> (Instance -> io ()) -> r)
-> r
withInstance pCreateInfo :: InstanceCreateInfo a
pCreateInfo pAllocator :: "allocator" ::: Maybe AllocationCallbacks
pAllocator b :: io Instance -> (Instance -> io ()) -> r
b =
io Instance -> (Instance -> io ()) -> r
b (InstanceCreateInfo a
-> ("allocator" ::: Maybe AllocationCallbacks) -> io Instance
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) -> Instance -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
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 :: Instance -> ("allocator" ::: Maybe AllocationCallbacks) -> io ()
destroyInstance instance' :: Instance
instance' allocator :: "allocator" ::: Maybe AllocationCallbacks
allocator = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
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 (Instance -> InstanceCmds
instanceCmds (Instance
instance' :: Instance))
IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Instance_T
-> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
vkDestroyInstancePtr FunPtr
(Ptr Instance_T
-> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
-> FunPtr
(Ptr Instance_T
-> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr Instance_T
-> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkDestroyInstance is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
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
Nothing -> ("pAllocator" ::: Ptr AllocationCallbacks)
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pAllocator" ::: Ptr AllocationCallbacks
forall a. Ptr a
nullPtr
Just j :: AllocationCallbacks
j -> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks))
-> ((("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ())
-> ContT () IO ("pAllocator" ::: Ptr AllocationCallbacks)
forall a b. (a -> b) -> a -> b
$ AllocationCallbacks
-> (("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()) -> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCallbacks
j)
IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Instance_T
-> ("pAllocator" ::: Ptr AllocationCallbacks) -> IO ()
vkDestroyInstance' (Instance -> Ptr Instance_T
instanceHandle (Instance
instance')) "pAllocator" ::: Ptr AllocationCallbacks
pAllocator
() -> ContT () IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> ContT () IO ()) -> () -> ContT () IO ()
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 :: Instance
-> io (Result, "physicalDevices" ::: Vector PhysicalDevice)
enumeratePhysicalDevices instance' :: Instance
instance' = IO (Result, "physicalDevices" ::: Vector PhysicalDevice)
-> io (Result, "physicalDevices" ::: Vector PhysicalDevice)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, "physicalDevices" ::: Vector PhysicalDevice)
-> io (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> (ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice)
IO
(Result, "physicalDevices" ::: Vector PhysicalDevice)
-> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice)
IO
(Result, "physicalDevices" ::: Vector PhysicalDevice)
-> io (Result, "physicalDevices" ::: Vector PhysicalDevice)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice)
IO
(Result, "physicalDevices" ::: Vector PhysicalDevice)
-> IO (Result, "physicalDevices" ::: Vector PhysicalDevice)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice)
IO
(Result, "physicalDevices" ::: Vector PhysicalDevice)
-> io (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice)
IO
(Result, "physicalDevices" ::: Vector PhysicalDevice)
-> io (Result, "physicalDevices" ::: Vector PhysicalDevice)
forall a b. (a -> b) -> a -> b
$ do
let cmds :: InstanceCmds
cmds = Instance -> InstanceCmds
instanceCmds (Instance
instance' :: Instance)
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
IO ()
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice) IO ())
-> IO ()
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Instance_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> IO Result)
vkEnumeratePhysicalDevicesPtr FunPtr
(Ptr Instance_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> IO Result)
-> FunPtr
(Ptr Instance_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr Instance_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkEnumeratePhysicalDevices is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
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 <- ((("pPhysicalDeviceCount" ::: Ptr Word32)
-> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice)
IO
("pPhysicalDeviceCount" ::: Ptr Word32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pPhysicalDeviceCount" ::: Ptr Word32)
-> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice)
IO
("pPhysicalDeviceCount" ::: Ptr Word32))
-> ((("pPhysicalDeviceCount" ::: Ptr Word32)
-> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice)
IO
("pPhysicalDeviceCount" ::: Ptr Word32)
forall a b. (a -> b) -> a -> b
$ IO ("pPhysicalDeviceCount" ::: Ptr Word32)
-> (("pPhysicalDeviceCount" ::: Ptr Word32) -> IO ())
-> (("pPhysicalDeviceCount" ::: Ptr Word32)
-> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> IO (Result, "physicalDevices" ::: Vector PhysicalDevice)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pPhysicalDeviceCount" ::: Ptr Word32)
forall a. Int -> IO (Ptr a)
callocBytes @Word32 4) ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO ()
forall a. Ptr a -> IO ()
free
Result
r <- IO Result
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice) IO Result)
-> IO Result
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice) IO Result
forall a b. (a -> b) -> a -> b
$ 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)
forall a. Ptr a
nullPtr)
IO ()
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice) IO ())
-> IO ()
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
Word32
pPhysicalDeviceCount <- IO Word32
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice) IO Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice) IO Word32)
-> IO Word32
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice) IO Word32
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPhysicalDeviceCount" ::: Ptr Word32
pPPhysicalDeviceCount
"pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T)
pPPhysicalDevices <- ((("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice)
IO
("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice)
IO
("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T)))
-> ((("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice)
IO
("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
forall a b. (a -> b) -> a -> b
$ IO ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> (("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T)) -> IO ())
-> (("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> IO (Result, "physicalDevices" ::: Vector PhysicalDevice))
-> IO (Result, "physicalDevices" ::: Vector PhysicalDevice)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
forall a. Int -> IO (Ptr a)
callocBytes @(Ptr PhysicalDevice_T) ((Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPhysicalDeviceCount)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8)) ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T)) -> IO ()
forall a. Ptr a -> IO ()
free
Result
r' <- IO Result
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice) IO Result)
-> IO Result
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice) IO Result
forall a b. (a -> b) -> a -> b
$ 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)
IO ()
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice) IO ())
-> IO ()
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r' Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r'))
Word32
pPhysicalDeviceCount' <- IO Word32
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice) IO Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice) IO Word32)
-> IO Word32
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice) IO Word32
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPhysicalDeviceCount" ::: Ptr Word32
pPPhysicalDeviceCount
"physicalDevices" ::: Vector PhysicalDevice
pPhysicalDevices' <- IO ("physicalDevices" ::: Vector PhysicalDevice)
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice)
IO
("physicalDevices" ::: Vector PhysicalDevice)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("physicalDevices" ::: Vector PhysicalDevice)
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice)
IO
("physicalDevices" ::: Vector PhysicalDevice))
-> IO ("physicalDevices" ::: Vector PhysicalDevice)
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice)
IO
("physicalDevices" ::: Vector PhysicalDevice)
forall a b. (a -> b) -> a -> b
$ Int
-> (Int -> IO PhysicalDevice)
-> IO ("physicalDevices" ::: Vector PhysicalDevice)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pPhysicalDeviceCount')) (\i :: Int
i -> do
Ptr PhysicalDevice_T
pPhysicalDevicesElem <- ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> IO (Ptr PhysicalDevice_T)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr PhysicalDevice_T) (("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T)
pPPhysicalDevices ("pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T))
-> Int -> "pPhysicalDevices" ::: Ptr (Ptr PhysicalDevice_T)
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr PhysicalDevice_T)))
PhysicalDevice -> IO PhysicalDevice
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDevice -> IO PhysicalDevice)
-> PhysicalDevice -> IO PhysicalDevice
forall a b. (a -> b) -> a -> b
$ (\h :: Ptr PhysicalDevice_T
h -> Ptr PhysicalDevice_T -> InstanceCmds -> PhysicalDevice
PhysicalDevice Ptr PhysicalDevice_T
h InstanceCmds
cmds ) Ptr PhysicalDevice_T
pPhysicalDevicesElem)
(Result, "physicalDevices" ::: Vector PhysicalDevice)
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice)
IO
(Result, "physicalDevices" ::: Vector PhysicalDevice)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, "physicalDevices" ::: Vector PhysicalDevice)
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice)
IO
(Result, "physicalDevices" ::: Vector PhysicalDevice))
-> (Result, "physicalDevices" ::: Vector PhysicalDevice)
-> ContT
(Result, "physicalDevices" ::: Vector PhysicalDevice)
IO
(Result, "physicalDevices" ::: Vector PhysicalDevice)
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 :: Device -> ("name" ::: ByteString) -> io (FunPtr FN_vkVoidFunction)
getDeviceProcAddr device :: Device
device name :: "name" ::: ByteString
name = IO (FunPtr FN_vkVoidFunction) -> io (FunPtr FN_vkVoidFunction)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FunPtr FN_vkVoidFunction) -> io (FunPtr FN_vkVoidFunction))
-> (ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
-> IO (FunPtr FN_vkVoidFunction))
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
-> io (FunPtr FN_vkVoidFunction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
-> IO (FunPtr FN_vkVoidFunction)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
-> io (FunPtr FN_vkVoidFunction))
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
-> io (FunPtr FN_vkVoidFunction)
forall a b. (a -> b) -> a -> b
$ do
let vkGetDeviceProcAddrPtr :: FunPtr
(Ptr Device_T
-> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
vkGetDeviceProcAddrPtr = DeviceCmds
-> FunPtr
(Ptr Device_T
-> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
pVkGetDeviceProcAddr (Device -> DeviceCmds
deviceCmds (Device
device :: Device))
IO () -> ContT (FunPtr FN_vkVoidFunction) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (FunPtr FN_vkVoidFunction) IO ())
-> IO () -> ContT (FunPtr FN_vkVoidFunction) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Device_T
-> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
vkGetDeviceProcAddrPtr FunPtr
(Ptr Device_T
-> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
-> FunPtr
(Ptr Device_T
-> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr Device_T
-> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkGetDeviceProcAddr is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let vkGetDeviceProcAddr' :: Ptr Device_T
-> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction)
vkGetDeviceProcAddr' = FunPtr
(Ptr Device_T
-> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
-> Ptr Device_T
-> ("pName" ::: Ptr CChar)
-> IO (FunPtr FN_vkVoidFunction)
mkVkGetDeviceProcAddr FunPtr
(Ptr Device_T
-> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
vkGetDeviceProcAddrPtr
"pName" ::: Ptr CChar
pName <- ((("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
-> IO (FunPtr FN_vkVoidFunction))
-> ContT (FunPtr FN_vkVoidFunction) IO ("pName" ::: Ptr CChar)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
-> IO (FunPtr FN_vkVoidFunction))
-> ContT (FunPtr FN_vkVoidFunction) IO ("pName" ::: Ptr CChar))
-> ((("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
-> IO (FunPtr FN_vkVoidFunction))
-> ContT (FunPtr FN_vkVoidFunction) IO ("pName" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
-> IO (FunPtr FN_vkVoidFunction)
forall a.
("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO a) -> IO a
useAsCString ("name" ::: ByteString
name)
FunPtr FN_vkVoidFunction
r <- IO (FunPtr FN_vkVoidFunction)
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (FunPtr FN_vkVoidFunction)
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction))
-> IO (FunPtr FN_vkVoidFunction)
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
forall a b. (a -> b) -> a -> b
$ Ptr Device_T
-> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction)
vkGetDeviceProcAddr' (Device -> Ptr Device_T
deviceHandle (Device
device)) "pName" ::: Ptr CChar
pName
FunPtr FN_vkVoidFunction
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FunPtr FN_vkVoidFunction
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction))
-> FunPtr FN_vkVoidFunction
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
forall a b. (a -> b) -> a -> b
$ (FunPtr FN_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 :: Instance
-> ("name" ::: ByteString) -> io (FunPtr FN_vkVoidFunction)
getInstanceProcAddr instance' :: Instance
instance' name :: "name" ::: ByteString
name = IO (FunPtr FN_vkVoidFunction) -> io (FunPtr FN_vkVoidFunction)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FunPtr FN_vkVoidFunction) -> io (FunPtr FN_vkVoidFunction))
-> (ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
-> IO (FunPtr FN_vkVoidFunction))
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
-> io (FunPtr FN_vkVoidFunction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
-> IO (FunPtr FN_vkVoidFunction)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
-> io (FunPtr FN_vkVoidFunction))
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
-> io (FunPtr FN_vkVoidFunction)
forall a b. (a -> b) -> a -> b
$ do
let vkGetInstanceProcAddrPtr :: FunPtr
(Ptr Instance_T
-> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
vkGetInstanceProcAddrPtr = InstanceCmds
-> FunPtr
(Ptr Instance_T
-> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
pVkGetInstanceProcAddr (Instance -> InstanceCmds
instanceCmds (Instance
instance' :: Instance))
IO () -> ContT (FunPtr FN_vkVoidFunction) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (FunPtr FN_vkVoidFunction) IO ())
-> IO () -> ContT (FunPtr FN_vkVoidFunction) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr Instance_T
-> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
vkGetInstanceProcAddrPtr FunPtr
(Ptr Instance_T
-> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
-> FunPtr
(Ptr Instance_T
-> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr Instance_T
-> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkGetInstanceProcAddr is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let vkGetInstanceProcAddr' :: Ptr Instance_T
-> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction)
vkGetInstanceProcAddr' = FunPtr
(Ptr Instance_T
-> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
-> Ptr Instance_T
-> ("pName" ::: Ptr CChar)
-> IO (FunPtr FN_vkVoidFunction)
mkVkGetInstanceProcAddr FunPtr
(Ptr Instance_T
-> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
vkGetInstanceProcAddrPtr
"pName" ::: Ptr CChar
pName <- ((("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
-> IO (FunPtr FN_vkVoidFunction))
-> ContT (FunPtr FN_vkVoidFunction) IO ("pName" ::: Ptr CChar)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
-> IO (FunPtr FN_vkVoidFunction))
-> ContT (FunPtr FN_vkVoidFunction) IO ("pName" ::: Ptr CChar))
-> ((("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
-> IO (FunPtr FN_vkVoidFunction))
-> ContT (FunPtr FN_vkVoidFunction) IO ("pName" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction))
-> IO (FunPtr FN_vkVoidFunction)
forall a.
("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO a) -> IO a
useAsCString ("name" ::: ByteString
name)
FunPtr FN_vkVoidFunction
r <- IO (FunPtr FN_vkVoidFunction)
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (FunPtr FN_vkVoidFunction)
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction))
-> IO (FunPtr FN_vkVoidFunction)
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
forall a b. (a -> b) -> a -> b
$ Ptr Instance_T
-> ("pName" ::: Ptr CChar) -> IO (FunPtr FN_vkVoidFunction)
vkGetInstanceProcAddr' (Instance -> Ptr Instance_T
instanceHandle (Instance
instance')) "pName" ::: Ptr CChar
pName
FunPtr FN_vkVoidFunction
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FunPtr FN_vkVoidFunction
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction))
-> FunPtr FN_vkVoidFunction
-> ContT (FunPtr FN_vkVoidFunction) IO (FunPtr FN_vkVoidFunction)
forall a b. (a -> b) -> a -> b
$ (FunPtr FN_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 :: PhysicalDevice -> io PhysicalDeviceProperties
getPhysicalDeviceProperties physicalDevice :: PhysicalDevice
physicalDevice = IO PhysicalDeviceProperties -> io PhysicalDeviceProperties
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PhysicalDeviceProperties -> io PhysicalDeviceProperties)
-> (ContT PhysicalDeviceProperties IO PhysicalDeviceProperties
-> IO PhysicalDeviceProperties)
-> ContT PhysicalDeviceProperties IO PhysicalDeviceProperties
-> io PhysicalDeviceProperties
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT PhysicalDeviceProperties IO PhysicalDeviceProperties
-> IO PhysicalDeviceProperties
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT PhysicalDeviceProperties IO PhysicalDeviceProperties
-> io PhysicalDeviceProperties)
-> ContT PhysicalDeviceProperties IO PhysicalDeviceProperties
-> io PhysicalDeviceProperties
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 (PhysicalDevice -> InstanceCmds
instanceCmds (PhysicalDevice
physicalDevice :: PhysicalDevice))
IO () -> ContT PhysicalDeviceProperties IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT PhysicalDeviceProperties IO ())
-> IO () -> ContT PhysicalDeviceProperties IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr PhysicalDevice_T
-> ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO ())
vkGetPhysicalDevicePropertiesPtr FunPtr
(Ptr PhysicalDevice_T
-> ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO ())
-> FunPtr
(Ptr PhysicalDevice_T
-> ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr PhysicalDevice_T
-> ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkGetPhysicalDeviceProperties is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
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 <- ((("pProperties" ::: Ptr PhysicalDeviceProperties)
-> IO PhysicalDeviceProperties)
-> IO PhysicalDeviceProperties)
-> ContT
PhysicalDeviceProperties
IO
("pProperties" ::: Ptr PhysicalDeviceProperties)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct PhysicalDeviceProperties =>
(("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @PhysicalDeviceProperties)
IO () -> ContT PhysicalDeviceProperties IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT PhysicalDeviceProperties IO ())
-> IO () -> ContT PhysicalDeviceProperties IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PhysicalDevice_T
-> ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO ()
vkGetPhysicalDeviceProperties' (PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)) ("pProperties" ::: Ptr PhysicalDeviceProperties
pPProperties)
PhysicalDeviceProperties
pProperties <- IO PhysicalDeviceProperties
-> ContT PhysicalDeviceProperties IO PhysicalDeviceProperties
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO PhysicalDeviceProperties
-> ContT PhysicalDeviceProperties IO PhysicalDeviceProperties)
-> IO PhysicalDeviceProperties
-> ContT PhysicalDeviceProperties IO PhysicalDeviceProperties
forall a b. (a -> b) -> a -> b
$ ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> IO PhysicalDeviceProperties
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PhysicalDeviceProperties "pProperties" ::: Ptr PhysicalDeviceProperties
pPProperties
PhysicalDeviceProperties
-> ContT PhysicalDeviceProperties IO PhysicalDeviceProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceProperties
-> ContT PhysicalDeviceProperties IO PhysicalDeviceProperties)
-> PhysicalDeviceProperties
-> ContT PhysicalDeviceProperties IO PhysicalDeviceProperties
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 :: PhysicalDevice
-> io ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
getPhysicalDeviceQueueFamilyProperties physicalDevice :: PhysicalDevice
physicalDevice = IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
-> io ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
-> io ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> (ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
IO
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
IO
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
-> io ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
IO
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
IO
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
-> io ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
IO
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
-> io ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
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 (PhysicalDevice -> InstanceCmds
instanceCmds (PhysicalDevice
physicalDevice :: PhysicalDevice))
IO ()
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ())
-> IO ()
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr PhysicalDevice_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO ())
vkGetPhysicalDeviceQueueFamilyPropertiesPtr FunPtr
(Ptr PhysicalDevice_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO ())
-> FunPtr
(Ptr PhysicalDevice_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr PhysicalDevice_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkGetPhysicalDeviceQueueFamilyProperties is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
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 <- ((("pPhysicalDeviceCount" ::: Ptr Word32)
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
IO
("pPhysicalDeviceCount" ::: Ptr Word32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pPhysicalDeviceCount" ::: Ptr Word32)
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
IO
("pPhysicalDeviceCount" ::: Ptr Word32))
-> ((("pPhysicalDeviceCount" ::: Ptr Word32)
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
IO
("pPhysicalDeviceCount" ::: Ptr Word32)
forall a b. (a -> b) -> a -> b
$ IO ("pPhysicalDeviceCount" ::: Ptr Word32)
-> (("pPhysicalDeviceCount" ::: Ptr Word32) -> IO ())
-> (("pPhysicalDeviceCount" ::: Ptr Word32)
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pPhysicalDeviceCount" ::: Ptr Word32)
forall a. Int -> IO (Ptr a)
callocBytes @Word32 4) ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO ()
forall a. Ptr a -> IO ()
free
IO ()
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ())
-> IO ()
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PhysicalDevice_T
-> ("pPhysicalDeviceCount" ::: Ptr Word32)
-> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO ()
vkGetPhysicalDeviceQueueFamilyProperties' Ptr PhysicalDevice_T
physicalDevice' ("pPhysicalDeviceCount" ::: Ptr Word32
pPQueueFamilyPropertyCount) ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
forall a. Ptr a
nullPtr)
Word32
pQueueFamilyPropertyCount <- IO Word32
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
IO
Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
IO
Word32)
-> IO Word32
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
IO
Word32
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPhysicalDeviceCount" ::: Ptr Word32
pPQueueFamilyPropertyCount
"pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
pPQueueFamilyProperties <- ((("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
IO
("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
IO
("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties))
-> ((("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
IO
("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
forall a b. (a -> b) -> a -> b
$ IO ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO ())
-> (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
forall a. Int -> IO (Ptr a)
callocBytes @QueueFamilyProperties ((Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pQueueFamilyPropertyCount)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 24)) ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties) -> IO ()
forall a. Ptr a -> IO ()
free
[()]
_ <- (Int
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ())
-> [Int]
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO [()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\i :: Int
i -> ((()
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((()
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ())
-> ((()
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ()
forall a b. (a -> b) -> a -> b
$ ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall a b. ToCStruct a => Ptr a -> IO b -> IO b
pokeZeroCStruct ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
pPQueueFamilyProperties ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> "pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* 24) :: Ptr QueueFamilyProperties) (IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> ((()
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> (()
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((()
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> ()
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall a b. (a -> b) -> a -> b
$ ())) [0..(Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pQueueFamilyPropertyCount)) Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1]
IO ()
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ())
-> IO ()
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties) IO ()
forall a b. (a -> b) -> a -> b
$ 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' <- IO Word32
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
IO
Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Word32
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
IO
Word32)
-> IO Word32
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
IO
Word32
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 "pPhysicalDeviceCount" ::: Ptr Word32
pPQueueFamilyPropertyCount
"queueFamilyProperties" ::: Vector QueueFamilyProperties
pQueueFamilyProperties' <- IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
IO
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
IO
("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
IO
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall a b. (a -> b) -> a -> b
$ Int
-> (Int -> IO QueueFamilyProperties)
-> IO ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
pQueueFamilyPropertyCount')) (\i :: Int
i -> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO QueueFamilyProperties
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @QueueFamilyProperties ((("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
pPQueueFamilyProperties) ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> "pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (24 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr QueueFamilyProperties)))
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
IO
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("queueFamilyProperties" ::: Vector QueueFamilyProperties)
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
IO
("queueFamilyProperties" ::: Vector QueueFamilyProperties))
-> ("queueFamilyProperties" ::: Vector QueueFamilyProperties)
-> ContT
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
IO
("queueFamilyProperties" ::: Vector QueueFamilyProperties)
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 :: PhysicalDevice -> io PhysicalDeviceMemoryProperties
getPhysicalDeviceMemoryProperties physicalDevice :: PhysicalDevice
physicalDevice = IO PhysicalDeviceMemoryProperties
-> io PhysicalDeviceMemoryProperties
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PhysicalDeviceMemoryProperties
-> io PhysicalDeviceMemoryProperties)
-> (ContT
PhysicalDeviceMemoryProperties IO PhysicalDeviceMemoryProperties
-> IO PhysicalDeviceMemoryProperties)
-> ContT
PhysicalDeviceMemoryProperties IO PhysicalDeviceMemoryProperties
-> io PhysicalDeviceMemoryProperties
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
PhysicalDeviceMemoryProperties IO PhysicalDeviceMemoryProperties
-> IO PhysicalDeviceMemoryProperties
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
PhysicalDeviceMemoryProperties IO PhysicalDeviceMemoryProperties
-> io PhysicalDeviceMemoryProperties)
-> ContT
PhysicalDeviceMemoryProperties IO PhysicalDeviceMemoryProperties
-> io PhysicalDeviceMemoryProperties
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 (PhysicalDevice -> InstanceCmds
instanceCmds (PhysicalDevice
physicalDevice :: PhysicalDevice))
IO () -> ContT PhysicalDeviceMemoryProperties IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT PhysicalDeviceMemoryProperties IO ())
-> IO () -> ContT PhysicalDeviceMemoryProperties IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr PhysicalDevice_T
-> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO ())
vkGetPhysicalDeviceMemoryPropertiesPtr FunPtr
(Ptr PhysicalDevice_T
-> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO ())
-> FunPtr
(Ptr PhysicalDevice_T
-> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr PhysicalDevice_T
-> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkGetPhysicalDeviceMemoryProperties is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
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 <- ((("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO PhysicalDeviceMemoryProperties)
-> IO PhysicalDeviceMemoryProperties)
-> ContT
PhysicalDeviceMemoryProperties
IO
("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct PhysicalDeviceMemoryProperties =>
(("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO b)
-> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @PhysicalDeviceMemoryProperties)
IO () -> ContT PhysicalDeviceMemoryProperties IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT PhysicalDeviceMemoryProperties IO ())
-> IO () -> ContT PhysicalDeviceMemoryProperties IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PhysicalDevice_T
-> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO ()
vkGetPhysicalDeviceMemoryProperties' (PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)) ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
pPMemoryProperties)
PhysicalDeviceMemoryProperties
pMemoryProperties <- IO PhysicalDeviceMemoryProperties
-> ContT
PhysicalDeviceMemoryProperties IO PhysicalDeviceMemoryProperties
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO PhysicalDeviceMemoryProperties
-> ContT
PhysicalDeviceMemoryProperties IO PhysicalDeviceMemoryProperties)
-> IO PhysicalDeviceMemoryProperties
-> ContT
PhysicalDeviceMemoryProperties IO PhysicalDeviceMemoryProperties
forall a b. (a -> b) -> a -> b
$ ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO PhysicalDeviceMemoryProperties
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PhysicalDeviceMemoryProperties "pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
pPMemoryProperties
PhysicalDeviceMemoryProperties
-> ContT
PhysicalDeviceMemoryProperties IO PhysicalDeviceMemoryProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceMemoryProperties
-> ContT
PhysicalDeviceMemoryProperties IO PhysicalDeviceMemoryProperties)
-> PhysicalDeviceMemoryProperties
-> ContT
PhysicalDeviceMemoryProperties IO PhysicalDeviceMemoryProperties
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 :: PhysicalDevice -> io PhysicalDeviceFeatures
getPhysicalDeviceFeatures physicalDevice :: PhysicalDevice
physicalDevice = IO PhysicalDeviceFeatures -> io PhysicalDeviceFeatures
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PhysicalDeviceFeatures -> io PhysicalDeviceFeatures)
-> (ContT PhysicalDeviceFeatures IO PhysicalDeviceFeatures
-> IO PhysicalDeviceFeatures)
-> ContT PhysicalDeviceFeatures IO PhysicalDeviceFeatures
-> io PhysicalDeviceFeatures
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT PhysicalDeviceFeatures IO PhysicalDeviceFeatures
-> IO PhysicalDeviceFeatures
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT PhysicalDeviceFeatures IO PhysicalDeviceFeatures
-> io PhysicalDeviceFeatures)
-> ContT PhysicalDeviceFeatures IO PhysicalDeviceFeatures
-> io PhysicalDeviceFeatures
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 (PhysicalDevice -> InstanceCmds
instanceCmds (PhysicalDevice
physicalDevice :: PhysicalDevice))
IO () -> ContT PhysicalDeviceFeatures IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT PhysicalDeviceFeatures IO ())
-> IO () -> ContT PhysicalDeviceFeatures IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr PhysicalDevice_T
-> ("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO ())
vkGetPhysicalDeviceFeaturesPtr FunPtr
(Ptr PhysicalDevice_T
-> ("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO ())
-> FunPtr
(Ptr PhysicalDevice_T
-> ("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr PhysicalDevice_T
-> ("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkGetPhysicalDeviceFeatures is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
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 <- ((("pFeatures" ::: Ptr PhysicalDeviceFeatures)
-> IO PhysicalDeviceFeatures)
-> IO PhysicalDeviceFeatures)
-> ContT
PhysicalDeviceFeatures
IO
("pFeatures" ::: Ptr PhysicalDeviceFeatures)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct PhysicalDeviceFeatures =>
(("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @PhysicalDeviceFeatures)
IO () -> ContT PhysicalDeviceFeatures IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT PhysicalDeviceFeatures IO ())
-> IO () -> ContT PhysicalDeviceFeatures IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PhysicalDevice_T
-> ("pFeatures" ::: Ptr PhysicalDeviceFeatures) -> IO ()
vkGetPhysicalDeviceFeatures' (PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)) ("pFeatures" ::: Ptr PhysicalDeviceFeatures
pPFeatures)
PhysicalDeviceFeatures
pFeatures <- IO PhysicalDeviceFeatures
-> ContT PhysicalDeviceFeatures IO PhysicalDeviceFeatures
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO PhysicalDeviceFeatures
-> ContT PhysicalDeviceFeatures IO PhysicalDeviceFeatures)
-> IO PhysicalDeviceFeatures
-> ContT PhysicalDeviceFeatures IO PhysicalDeviceFeatures
forall a b. (a -> b) -> a -> b
$ ("pFeatures" ::: Ptr PhysicalDeviceFeatures)
-> IO PhysicalDeviceFeatures
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PhysicalDeviceFeatures "pFeatures" ::: Ptr PhysicalDeviceFeatures
pPFeatures
PhysicalDeviceFeatures
-> ContT PhysicalDeviceFeatures IO PhysicalDeviceFeatures
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceFeatures
-> ContT PhysicalDeviceFeatures IO PhysicalDeviceFeatures)
-> PhysicalDeviceFeatures
-> ContT PhysicalDeviceFeatures IO PhysicalDeviceFeatures
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 :: PhysicalDevice -> Format -> io FormatProperties
getPhysicalDeviceFormatProperties physicalDevice :: PhysicalDevice
physicalDevice format :: Format
format = IO FormatProperties -> io FormatProperties
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FormatProperties -> io FormatProperties)
-> (ContT FormatProperties IO FormatProperties
-> IO FormatProperties)
-> ContT FormatProperties IO FormatProperties
-> io FormatProperties
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT FormatProperties IO FormatProperties -> IO FormatProperties
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT FormatProperties IO FormatProperties -> io FormatProperties)
-> ContT FormatProperties IO FormatProperties
-> io FormatProperties
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 (PhysicalDevice -> InstanceCmds
instanceCmds (PhysicalDevice
physicalDevice :: PhysicalDevice))
IO () -> ContT FormatProperties IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT FormatProperties IO ())
-> IO () -> ContT FormatProperties IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr PhysicalDevice_T
-> Format
-> ("pFormatProperties" ::: Ptr FormatProperties)
-> IO ())
vkGetPhysicalDeviceFormatPropertiesPtr FunPtr
(Ptr PhysicalDevice_T
-> Format
-> ("pFormatProperties" ::: Ptr FormatProperties)
-> IO ())
-> FunPtr
(Ptr PhysicalDevice_T
-> Format
-> ("pFormatProperties" ::: Ptr FormatProperties)
-> IO ())
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr PhysicalDevice_T
-> Format
-> ("pFormatProperties" ::: Ptr FormatProperties)
-> IO ())
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkGetPhysicalDeviceFormatProperties is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
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 <- ((("pFormatProperties" ::: Ptr FormatProperties)
-> IO FormatProperties)
-> IO FormatProperties)
-> ContT
FormatProperties IO ("pFormatProperties" ::: Ptr FormatProperties)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct FormatProperties =>
(("pFormatProperties" ::: Ptr FormatProperties) -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @FormatProperties)
IO () -> ContT FormatProperties IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT FormatProperties IO ())
-> IO () -> ContT FormatProperties IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PhysicalDevice_T
-> Format
-> ("pFormatProperties" ::: Ptr FormatProperties)
-> IO ()
vkGetPhysicalDeviceFormatProperties' (PhysicalDevice -> Ptr PhysicalDevice_T
physicalDeviceHandle (PhysicalDevice
physicalDevice)) (Format
format) ("pFormatProperties" ::: Ptr FormatProperties
pPFormatProperties)
FormatProperties
pFormatProperties <- IO FormatProperties -> ContT FormatProperties IO FormatProperties
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO FormatProperties -> ContT FormatProperties IO FormatProperties)
-> IO FormatProperties
-> ContT FormatProperties IO FormatProperties
forall a b. (a -> b) -> a -> b
$ ("pFormatProperties" ::: Ptr FormatProperties)
-> IO FormatProperties
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @FormatProperties "pFormatProperties" ::: Ptr FormatProperties
pPFormatProperties
FormatProperties -> ContT FormatProperties IO FormatProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FormatProperties -> ContT FormatProperties IO FormatProperties)
-> FormatProperties -> ContT FormatProperties IO FormatProperties
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 :: PhysicalDevice
-> Format
-> ImageType
-> ImageTiling
-> ImageUsageFlags
-> ImageCreateFlags
-> io ImageFormatProperties
getPhysicalDeviceImageFormatProperties physicalDevice :: PhysicalDevice
physicalDevice format :: Format
format type' :: ImageType
type' tiling :: ImageTiling
tiling usage :: ImageUsageFlags
usage flags :: ImageCreateFlags
flags = IO ImageFormatProperties -> io ImageFormatProperties
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ImageFormatProperties -> io ImageFormatProperties)
-> (ContT ImageFormatProperties IO ImageFormatProperties
-> IO ImageFormatProperties)
-> ContT ImageFormatProperties IO ImageFormatProperties
-> io ImageFormatProperties
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT ImageFormatProperties IO ImageFormatProperties
-> IO ImageFormatProperties
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT ImageFormatProperties IO ImageFormatProperties
-> io ImageFormatProperties)
-> ContT ImageFormatProperties IO ImageFormatProperties
-> io ImageFormatProperties
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 (PhysicalDevice -> InstanceCmds
instanceCmds (PhysicalDevice
physicalDevice :: PhysicalDevice))
IO () -> ContT ImageFormatProperties IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ImageFormatProperties IO ())
-> IO () -> ContT ImageFormatProperties IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
(Ptr PhysicalDevice_T
-> Format
-> ImageType
-> ImageTiling
-> ImageUsageFlags
-> ImageCreateFlags
-> ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO Result)
vkGetPhysicalDeviceImageFormatPropertiesPtr FunPtr
(Ptr PhysicalDevice_T
-> Format
-> ImageType
-> ImageTiling
-> ImageUsageFlags
-> ImageCreateFlags
-> ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO Result)
-> FunPtr
(Ptr PhysicalDevice_T
-> Format
-> ImageType
-> ImageTiling
-> ImageUsageFlags
-> ImageCreateFlags
-> ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
(Ptr PhysicalDevice_T
-> Format
-> ImageType
-> ImageTiling
-> ImageUsageFlags
-> ImageCreateFlags
-> ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for vkGetPhysicalDeviceImageFormatProperties is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
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 <- ((("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO ImageFormatProperties)
-> IO ImageFormatProperties)
-> ContT
ImageFormatProperties
IO
("pImageFormatProperties" ::: Ptr ImageFormatProperties)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct ImageFormatProperties =>
(("pImageFormatProperties" ::: Ptr ImageFormatProperties) -> IO b)
-> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @ImageFormatProperties)
Result
r <- IO Result -> ContT ImageFormatProperties IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT ImageFormatProperties IO Result)
-> IO Result -> ContT ImageFormatProperties IO Result
forall a b. (a -> b) -> a -> b
$ 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)
IO () -> ContT ImageFormatProperties IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ImageFormatProperties IO ())
-> IO () -> ContT ImageFormatProperties IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (VulkanException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> VulkanException
VulkanException Result
r))
ImageFormatProperties
pImageFormatProperties <- IO ImageFormatProperties
-> ContT ImageFormatProperties IO ImageFormatProperties
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ImageFormatProperties
-> ContT ImageFormatProperties IO ImageFormatProperties)
-> IO ImageFormatProperties
-> ContT ImageFormatProperties IO ImageFormatProperties
forall a b. (a -> b) -> a -> b
$ ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO ImageFormatProperties
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ImageFormatProperties "pImageFormatProperties" ::: Ptr ImageFormatProperties
pPImageFormatProperties
ImageFormatProperties
-> ContT ImageFormatProperties IO ImageFormatProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImageFormatProperties
-> ContT ImageFormatProperties IO ImageFormatProperties)
-> ImageFormatProperties
-> ContT ImageFormatProperties IO ImageFormatProperties
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 :: PhysicalDeviceProperties
-> (("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO b)
-> IO b
withCStruct x :: PhysicalDeviceProperties
x f :: ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO b
f = Int
-> Int
-> (("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 824 8 ((("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO b)
-> IO b)
-> (("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \p :: "pProperties" ::: Ptr PhysicalDeviceProperties
p -> ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> PhysicalDeviceProperties -> IO b -> IO b
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 :: ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> PhysicalDeviceProperties -> IO b -> IO b
pokeCStruct p :: "pProperties" ::: Ptr PhysicalDeviceProperties
p PhysicalDeviceProperties{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32)) (Word32
apiVersion)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32)) (Word32
driverVersion)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Word32)) (Word32
vendorID)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr Word32)) (Word32
deviceID)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PhysicalDeviceType -> PhysicalDeviceType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr PhysicalDeviceType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr PhysicalDeviceType)) (PhysicalDeviceType
deviceType)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (FixedArray MAX_PHYSICAL_DEVICE_NAME_SIZE CChar)
-> ("name" ::: ByteString) -> IO ()
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ("name" ::: ByteString) -> IO ()
pokeFixedLengthNullTerminatedByteString (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr (FixedArray MAX_PHYSICAL_DEVICE_NAME_SIZE CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr (FixedArray MAX_PHYSICAL_DEVICE_NAME_SIZE CChar))) ("name" ::: ByteString
deviceName)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (FixedArray UUID_SIZE Word8)
-> ("name" ::: ByteString) -> IO ()
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> ("name" ::: ByteString) -> IO ()
pokeFixedLengthByteString (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr (FixedArray UUID_SIZE Word8)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 276 :: Ptr (FixedArray UUID_SIZE Word8))) ("name" ::: ByteString
pipelineCacheUUID)
((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PhysicalDeviceLimits -> PhysicalDeviceLimits -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr PhysicalDeviceLimits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 296 :: Ptr PhysicalDeviceLimits)) (PhysicalDeviceLimits
limits) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PhysicalDeviceSparseProperties
-> PhysicalDeviceSparseProperties -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr PhysicalDeviceSparseProperties
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 800 :: Ptr PhysicalDeviceSparseProperties)) (PhysicalDeviceSparseProperties
sparseProperties) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = 824
cStructAlignment :: Int
cStructAlignment = 8
pokeZeroCStruct :: ("pProperties" ::: Ptr PhysicalDeviceProperties) -> IO b -> IO b
pokeZeroCStruct p :: "pProperties" ::: Ptr PhysicalDeviceProperties
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PhysicalDeviceType -> PhysicalDeviceType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr PhysicalDeviceType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr PhysicalDeviceType)) (PhysicalDeviceType
forall a. Zero a => a
zero)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (FixedArray MAX_PHYSICAL_DEVICE_NAME_SIZE CChar)
-> ("name" ::: ByteString) -> IO ()
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ("name" ::: ByteString) -> IO ()
pokeFixedLengthNullTerminatedByteString (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr (FixedArray MAX_PHYSICAL_DEVICE_NAME_SIZE CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr (FixedArray MAX_PHYSICAL_DEVICE_NAME_SIZE CChar))) ("name" ::: ByteString
forall a. Monoid a => a
mempty)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (FixedArray UUID_SIZE Word8)
-> ("name" ::: ByteString) -> IO ()
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> ("name" ::: ByteString) -> IO ()
pokeFixedLengthByteString (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr (FixedArray UUID_SIZE Word8)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 276 :: Ptr (FixedArray UUID_SIZE Word8))) ("name" ::: ByteString
forall a. Monoid a => a
mempty)
((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PhysicalDeviceLimits -> PhysicalDeviceLimits -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr PhysicalDeviceLimits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 296 :: Ptr PhysicalDeviceLimits)) (PhysicalDeviceLimits
forall a. Zero a => a
zero) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr PhysicalDeviceSparseProperties
-> PhysicalDeviceSparseProperties -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr PhysicalDeviceSparseProperties
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 800 :: Ptr PhysicalDeviceSparseProperties)) (PhysicalDeviceSparseProperties
forall a. Zero a => a
zero) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
instance FromCStruct PhysicalDeviceProperties where
peekCStruct :: ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> IO PhysicalDeviceProperties
peekCStruct p :: "pProperties" ::: Ptr PhysicalDeviceProperties
p = do
Word32
apiVersion <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32))
Word32
driverVersion <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32))
Word32
vendorID <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Word32))
Word32
deviceID <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr Word32))
PhysicalDeviceType
deviceType <- Ptr PhysicalDeviceType -> IO PhysicalDeviceType
forall a. Storable a => Ptr a -> IO a
peek @PhysicalDeviceType (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr PhysicalDeviceType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr PhysicalDeviceType))
"name" ::: ByteString
deviceName <- ("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString)
packCString (Ptr (FixedArray MAX_PHYSICAL_DEVICE_NAME_SIZE CChar)
-> "pName" ::: Ptr CChar
forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr (FixedArray MAX_PHYSICAL_DEVICE_NAME_SIZE CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr (FixedArray MAX_PHYSICAL_DEVICE_NAME_SIZE CChar))))
"name" ::: ByteString
pipelineCacheUUID <- Ptr (FixedArray UUID_SIZE Word8) -> IO ("name" ::: ByteString)
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n Word8) -> IO ("name" ::: ByteString)
peekByteStringFromSizedVectorPtr (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr (FixedArray UUID_SIZE Word8)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 276 :: Ptr (FixedArray UUID_SIZE Word8)))
PhysicalDeviceLimits
limits <- Ptr PhysicalDeviceLimits -> IO PhysicalDeviceLimits
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PhysicalDeviceLimits (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr PhysicalDeviceLimits
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 296 :: Ptr PhysicalDeviceLimits))
PhysicalDeviceSparseProperties
sparseProperties <- Ptr PhysicalDeviceSparseProperties
-> IO PhysicalDeviceSparseProperties
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PhysicalDeviceSparseProperties (("pProperties" ::: Ptr PhysicalDeviceProperties
p ("pProperties" ::: Ptr PhysicalDeviceProperties)
-> Int -> Ptr PhysicalDeviceSparseProperties
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 800 :: Ptr PhysicalDeviceSparseProperties))
PhysicalDeviceProperties -> IO PhysicalDeviceProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceProperties -> IO PhysicalDeviceProperties)
-> PhysicalDeviceProperties -> IO PhysicalDeviceProperties
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 Zero PhysicalDeviceProperties where
zero :: PhysicalDeviceProperties
zero = Word32
-> Word32
-> Word32
-> Word32
-> PhysicalDeviceType
-> ("name" ::: ByteString)
-> ("name" ::: ByteString)
-> PhysicalDeviceLimits
-> PhysicalDeviceSparseProperties
-> PhysicalDeviceProperties
PhysicalDeviceProperties
Word32
forall a. Zero a => a
zero
Word32
forall a. Zero a => a
zero
Word32
forall a. Zero a => a
zero
Word32
forall a. Zero a => a
zero
PhysicalDeviceType
forall a. Zero a => a
zero
"name" ::: ByteString
forall a. Monoid a => a
mempty
"name" ::: ByteString
forall a. Monoid a => a
mempty
PhysicalDeviceLimits
forall a. Zero a => a
zero
PhysicalDeviceSparseProperties
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 :: ApplicationInfo -> (Ptr ApplicationInfo -> IO b) -> IO b
withCStruct x :: ApplicationInfo
x f :: Ptr ApplicationInfo -> IO b
f = Int -> Int -> (Ptr ApplicationInfo -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 48 8 ((Ptr ApplicationInfo -> IO b) -> IO b)
-> (Ptr ApplicationInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr ApplicationInfo
p -> Ptr ApplicationInfo -> ApplicationInfo -> IO b -> IO b
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 :: Ptr ApplicationInfo -> ApplicationInfo -> IO b -> IO b
pokeCStruct p :: Ptr ApplicationInfo
p ApplicationInfo{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_APPLICATION_INFO)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
"pName" ::: Ptr CChar
pApplicationName'' <- case (Maybe ("name" ::: ByteString)
applicationName) of
Nothing -> ("pName" ::: Ptr CChar) -> ContT b IO ("pName" ::: Ptr CChar)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pName" ::: Ptr CChar
forall a. Ptr a
nullPtr
Just j :: "name" ::: ByteString
j -> ((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar))
-> ((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO b) -> IO b
forall a.
("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO a) -> IO a
useAsCString ("name" ::: ByteString
j)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ("pName" ::: Ptr CChar) -> ("pName" ::: Ptr CChar) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> Ptr ("pName" ::: Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr (Ptr CChar))) "pName" ::: Ptr CChar
pApplicationName''
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word32)) (Word32
applicationVersion)
"pName" ::: Ptr CChar
pEngineName'' <- case (Maybe ("name" ::: ByteString)
engineName) of
Nothing -> ("pName" ::: Ptr CChar) -> ContT b IO ("pName" ::: Ptr CChar)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "pName" ::: Ptr CChar
forall a. Ptr a
nullPtr
Just j :: "name" ::: ByteString
j -> ((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar))
-> ((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO b) -> IO b
forall a.
("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO a) -> IO a
useAsCString ("name" ::: ByteString
j)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ("pName" ::: Ptr CChar) -> ("pName" ::: Ptr CChar) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> Ptr ("pName" ::: Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr CChar))) "pName" ::: Ptr CChar
pEngineName''
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr Word32)) (Word32
engineVersion)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 44 :: Ptr Word32)) (Word32
apiVersion)
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = 48
cStructAlignment :: Int
cStructAlignment = 8
pokeZeroCStruct :: Ptr ApplicationInfo -> IO b -> IO b
pokeZeroCStruct p :: Ptr ApplicationInfo
p f :: IO b
f = do
Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_APPLICATION_INFO)
Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 44 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
IO b
f
instance FromCStruct ApplicationInfo where
peekCStruct :: Ptr ApplicationInfo -> IO ApplicationInfo
peekCStruct p :: Ptr ApplicationInfo
p = do
"pName" ::: Ptr CChar
pApplicationName <- Ptr ("pName" ::: Ptr CChar) -> IO ("pName" ::: Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr CChar) ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> Ptr ("pName" ::: Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr (Ptr CChar)))
Maybe ("name" ::: ByteString)
pApplicationName' <- (("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString))
-> ("pName" ::: Ptr CChar) -> IO (Maybe ("name" ::: ByteString))
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek (\j :: "pName" ::: Ptr CChar
j -> ("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString)
packCString ("pName" ::: Ptr CChar
j)) "pName" ::: Ptr CChar
pApplicationName
Word32
applicationVersion <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word32))
"pName" ::: Ptr CChar
pEngineName <- Ptr ("pName" ::: Ptr CChar) -> IO ("pName" ::: Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr CChar) ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> Ptr ("pName" ::: Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr CChar)))
Maybe ("name" ::: ByteString)
pEngineName' <- (("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString))
-> ("pName" ::: Ptr CChar) -> IO (Maybe ("name" ::: ByteString))
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek (\j :: "pName" ::: Ptr CChar
j -> ("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString)
packCString ("pName" ::: Ptr CChar
j)) "pName" ::: Ptr CChar
pEngineName
Word32
engineVersion <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr Word32))
Word32
apiVersion <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr ApplicationInfo
p Ptr ApplicationInfo -> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 44 :: Ptr Word32))
ApplicationInfo -> IO ApplicationInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApplicationInfo -> IO ApplicationInfo)
-> ApplicationInfo -> IO ApplicationInfo
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
Maybe ("name" ::: ByteString)
forall a. Maybe a
Nothing
Word32
forall a. Zero a => a
zero
Maybe ("name" ::: ByteString)
forall a. Maybe a
Nothing
Word32
forall a. Zero a => a
zero
Word32
forall a. Zero a => a
zero
data InstanceCreateInfo (es :: [Type]) = InstanceCreateInfo
{
InstanceCreateInfo es -> Chain es
next :: Chain es
,
InstanceCreateInfo es -> InstanceCreateFlags
flags :: InstanceCreateFlags
,
InstanceCreateInfo es -> Maybe ApplicationInfo
applicationInfo :: Maybe ApplicationInfo
,
InstanceCreateInfo es -> Vector ("name" ::: ByteString)
enabledLayerNames :: Vector ByteString
,
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
extensibleType :: StructureType
extensibleType = StructureType
STRUCTURE_TYPE_INSTANCE_CREATE_INFO
setNext :: InstanceCreateInfo ds -> Chain es -> InstanceCreateInfo es
setNext x :: InstanceCreateInfo ds
x next :: Chain es
next = InstanceCreateInfo ds
x{$sel:next:InstanceCreateInfo :: Chain es
next = Chain es
next}
getNext :: InstanceCreateInfo es -> Chain es
getNext InstanceCreateInfo{..} = Chain es
next
extends :: forall e b proxy. Typeable e => proxy e -> (Extends InstanceCreateInfo e => b) -> Maybe b
extends :: proxy e -> (Extends InstanceCreateInfo e => b) -> Maybe b
extends _ f :: Extends InstanceCreateInfo e => b
f
| Just Refl <- (Typeable e, Typeable DebugUtilsMessengerCreateInfoEXT) =>
Maybe (e :~: DebugUtilsMessengerCreateInfoEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @DebugUtilsMessengerCreateInfoEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends InstanceCreateInfo e => b
f
| Just Refl <- (Typeable e, Typeable ValidationFeaturesEXT) =>
Maybe (e :~: ValidationFeaturesEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ValidationFeaturesEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends InstanceCreateInfo e => b
f
| Just Refl <- (Typeable e, Typeable ValidationFlagsEXT) =>
Maybe (e :~: ValidationFlagsEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @ValidationFlagsEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends InstanceCreateInfo e => b
f
| Just Refl <- (Typeable e, Typeable DebugReportCallbackCreateInfoEXT) =>
Maybe (e :~: DebugReportCallbackCreateInfoEXT)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @DebugReportCallbackCreateInfoEXT = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends InstanceCreateInfo e => b
f
| Bool
otherwise = Maybe b
forall a. Maybe a
Nothing
instance (Extendss InstanceCreateInfo es, PokeChain es) => ToCStruct (InstanceCreateInfo es) where
withCStruct :: InstanceCreateInfo es
-> (Ptr (InstanceCreateInfo es) -> IO b) -> IO b
withCStruct x :: InstanceCreateInfo es
x f :: Ptr (InstanceCreateInfo es) -> IO b
f = Int -> Int -> (Ptr (InstanceCreateInfo es) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 64 8 ((Ptr (InstanceCreateInfo es) -> IO b) -> IO b)
-> (Ptr (InstanceCreateInfo es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr (InstanceCreateInfo es)
p -> Ptr (InstanceCreateInfo es)
-> InstanceCreateInfo es -> IO b -> IO b
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 :: Ptr (InstanceCreateInfo es)
-> InstanceCreateInfo es -> IO b -> IO b
pokeCStruct p :: Ptr (InstanceCreateInfo es)
p InstanceCreateInfo{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_INSTANCE_CREATE_INFO)
Ptr ()
pNext'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext''
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr InstanceCreateFlags -> InstanceCreateFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es) -> Int -> Ptr InstanceCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr InstanceCreateFlags)) (InstanceCreateFlags
flags)
Ptr ApplicationInfo
pApplicationInfo'' <- case (Maybe ApplicationInfo
applicationInfo) of
Nothing -> Ptr ApplicationInfo -> ContT b IO (Ptr ApplicationInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr ApplicationInfo
forall a. Ptr a
nullPtr
Just j :: ApplicationInfo
j -> ((Ptr ApplicationInfo -> IO b) -> IO b)
-> ContT b IO (Ptr ApplicationInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ApplicationInfo -> IO b) -> IO b)
-> ContT b IO (Ptr ApplicationInfo))
-> ((Ptr ApplicationInfo -> IO b) -> IO b)
-> ContT b IO (Ptr ApplicationInfo)
forall a b. (a -> b) -> a -> b
$ ApplicationInfo -> (Ptr ApplicationInfo -> IO b) -> IO b
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (ApplicationInfo
j)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ApplicationInfo) -> Ptr ApplicationInfo -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es) -> Int -> Ptr (Ptr ApplicationInfo)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr ApplicationInfo))) Ptr ApplicationInfo
pApplicationInfo''
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector ("name" ::: ByteString) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector ("name" ::: ByteString) -> Int)
-> Vector ("name" ::: ByteString) -> Int
forall a b. (a -> b) -> a -> b
$ (Vector ("name" ::: ByteString)
enabledLayerNames)) :: Word32))
Ptr ("pName" ::: Ptr CChar)
pPpEnabledLayerNames' <- ((Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO (Ptr ("pName" ::: Ptr CChar))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO (Ptr ("pName" ::: Ptr CChar)))
-> ((Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO (Ptr ("pName" ::: Ptr CChar))
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @(Ptr CChar) ((Vector ("name" ::: ByteString) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector ("name" ::: ByteString)
enabledLayerNames)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 8
(Int -> ("name" ::: ByteString) -> ContT b IO ())
-> Vector ("name" ::: ByteString) -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: "name" ::: ByteString
e -> do
"pName" ::: Ptr CChar
ppEnabledLayerNames'' <- ((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar))
-> ((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO b) -> IO b
forall a.
("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO a) -> IO a
useAsCString ("name" ::: ByteString
e)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ("pName" ::: Ptr CChar) -> ("pName" ::: Ptr CChar) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ("pName" ::: Ptr CChar)
pPpEnabledLayerNames' Ptr ("pName" ::: Ptr CChar) -> Int -> Ptr ("pName" ::: Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr CChar)) "pName" ::: Ptr CChar
ppEnabledLayerNames'') (Vector ("name" ::: ByteString)
enabledLayerNames)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ("pName" ::: Ptr CChar))
-> Ptr ("pName" ::: Ptr CChar) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es)
-> Int -> Ptr (Ptr ("pName" ::: Ptr CChar))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr (Ptr (Ptr CChar)))) (Ptr ("pName" ::: Ptr CChar)
pPpEnabledLayerNames')
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr Word32)) ((Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector ("name" ::: ByteString) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector ("name" ::: ByteString) -> Int)
-> Vector ("name" ::: ByteString) -> Int
forall a b. (a -> b) -> a -> b
$ (Vector ("name" ::: ByteString)
enabledExtensionNames)) :: Word32))
Ptr ("pName" ::: Ptr CChar)
pPpEnabledExtensionNames' <- ((Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO (Ptr ("pName" ::: Ptr CChar))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO (Ptr ("pName" ::: Ptr CChar)))
-> ((Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO (Ptr ("pName" ::: Ptr CChar))
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @(Ptr CChar) ((Vector ("name" ::: ByteString) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector ("name" ::: ByteString)
enabledExtensionNames)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 8
(Int -> ("name" ::: ByteString) -> ContT b IO ())
-> Vector ("name" ::: ByteString) -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: "name" ::: ByteString
e -> do
"pName" ::: Ptr CChar
ppEnabledExtensionNames'' <- ((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar))
-> ((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO b) -> IO b
forall a.
("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO a) -> IO a
useAsCString ("name" ::: ByteString
e)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ("pName" ::: Ptr CChar) -> ("pName" ::: Ptr CChar) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ("pName" ::: Ptr CChar)
pPpEnabledExtensionNames' Ptr ("pName" ::: Ptr CChar) -> Int -> Ptr ("pName" ::: Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr CChar)) "pName" ::: Ptr CChar
ppEnabledExtensionNames'') (Vector ("name" ::: ByteString)
enabledExtensionNames)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ("pName" ::: Ptr CChar))
-> Ptr ("pName" ::: Ptr CChar) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es)
-> Int -> Ptr (Ptr ("pName" ::: Ptr CChar))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 56 :: Ptr (Ptr (Ptr CChar)))) (Ptr ("pName" ::: Ptr CChar)
pPpEnabledExtensionNames')
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = 64
cStructAlignment :: Int
cStructAlignment = 8
pokeZeroCStruct :: Ptr (InstanceCreateInfo es) -> IO b -> IO b
pokeZeroCStruct p :: Ptr (InstanceCreateInfo es)
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es) -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_INSTANCE_CREATE_INFO)
Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall a. PokeChain es => (Ptr (Chain es) -> IO a) -> IO a
forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext'
Ptr ("pName" ::: Ptr CChar)
pPpEnabledLayerNames' <- ((Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO (Ptr ("pName" ::: Ptr CChar))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO (Ptr ("pName" ::: Ptr CChar)))
-> ((Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO (Ptr ("pName" ::: Ptr CChar))
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @(Ptr CChar) ((Vector Any -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Any
forall a. Monoid a => a
mempty)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 8
(Int -> ("name" ::: ByteString) -> ContT b IO ())
-> Vector ("name" ::: ByteString) -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: "name" ::: ByteString
e -> do
"pName" ::: Ptr CChar
ppEnabledLayerNames'' <- ((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar))
-> ((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO b) -> IO b
forall a.
("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO a) -> IO a
useAsCString ("name" ::: ByteString
e)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ("pName" ::: Ptr CChar) -> ("pName" ::: Ptr CChar) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ("pName" ::: Ptr CChar)
pPpEnabledLayerNames' Ptr ("pName" ::: Ptr CChar) -> Int -> Ptr ("pName" ::: Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr CChar)) "pName" ::: Ptr CChar
ppEnabledLayerNames'') (Vector ("name" ::: ByteString)
forall a. Monoid a => a
mempty)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ("pName" ::: Ptr CChar))
-> Ptr ("pName" ::: Ptr CChar) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es)
-> Int -> Ptr (Ptr ("pName" ::: Ptr CChar))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr (Ptr (Ptr CChar)))) (Ptr ("pName" ::: Ptr CChar)
pPpEnabledLayerNames')
Ptr ("pName" ::: Ptr CChar)
pPpEnabledExtensionNames' <- ((Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO (Ptr ("pName" ::: Ptr CChar))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO (Ptr ("pName" ::: Ptr CChar)))
-> ((Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO (Ptr ("pName" ::: Ptr CChar))
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr ("pName" ::: Ptr CChar) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @(Ptr CChar) ((Vector Any -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Any
forall a. Monoid a => a
mempty)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 8
(Int -> ("name" ::: ByteString) -> ContT b IO ())
-> Vector ("name" ::: ByteString) -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: "name" ::: ByteString
e -> do
"pName" ::: Ptr CChar
ppEnabledExtensionNames'' <- ((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar))
-> ((("pName" ::: Ptr CChar) -> IO b) -> IO b)
-> ContT b IO ("pName" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO b) -> IO b
forall a.
("name" ::: ByteString)
-> (("pName" ::: Ptr CChar) -> IO a) -> IO a
useAsCString ("name" ::: ByteString
e)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ("pName" ::: Ptr CChar) -> ("pName" ::: Ptr CChar) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ("pName" ::: Ptr CChar)
pPpEnabledExtensionNames' Ptr ("pName" ::: Ptr CChar) -> Int -> Ptr ("pName" ::: Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr CChar)) "pName" ::: Ptr CChar
ppEnabledExtensionNames'') (Vector ("name" ::: ByteString)
forall a. Monoid a => a
mempty)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ("pName" ::: Ptr CChar))
-> Ptr ("pName" ::: Ptr CChar) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es)
-> Int -> Ptr (Ptr ("pName" ::: Ptr CChar))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 56 :: Ptr (Ptr (Ptr CChar)))) (Ptr ("pName" ::: Ptr CChar)
pPpEnabledExtensionNames')
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
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 p :: Ptr (InstanceCreateInfo es)
p = do
Ptr ()
pNext <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ())))
Chain es
next <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pNext)
InstanceCreateFlags
flags <- Ptr InstanceCreateFlags -> IO InstanceCreateFlags
forall a. Storable a => Ptr a -> IO a
peek @InstanceCreateFlags ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es) -> Int -> Ptr InstanceCreateFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr InstanceCreateFlags))
Ptr ApplicationInfo
pApplicationInfo <- Ptr (Ptr ApplicationInfo) -> IO (Ptr ApplicationInfo)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ApplicationInfo) ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es) -> Int -> Ptr (Ptr ApplicationInfo)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr ApplicationInfo)))
Maybe ApplicationInfo
pApplicationInfo' <- (Ptr ApplicationInfo -> IO ApplicationInfo)
-> Ptr ApplicationInfo -> IO (Maybe ApplicationInfo)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek (\j :: Ptr ApplicationInfo
j -> Ptr ApplicationInfo -> IO ApplicationInfo
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ApplicationInfo (Ptr ApplicationInfo
j)) Ptr ApplicationInfo
pApplicationInfo
Word32
enabledLayerCount <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Word32))
Ptr ("pName" ::: Ptr CChar)
ppEnabledLayerNames <- Ptr (Ptr ("pName" ::: Ptr CChar))
-> IO (Ptr ("pName" ::: Ptr CChar))
forall a. Storable a => Ptr a -> IO a
peek @(Ptr (Ptr CChar)) ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es)
-> Int -> Ptr (Ptr ("pName" ::: Ptr CChar))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr (Ptr (Ptr CChar))))
Vector ("name" ::: ByteString)
ppEnabledLayerNames' <- Int
-> (Int -> IO ("name" ::: ByteString))
-> IO (Vector ("name" ::: ByteString))
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
enabledLayerCount) (\i :: Int
i -> ("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString)
packCString (("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString))
-> IO ("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr ("pName" ::: Ptr CChar) -> IO ("pName" ::: Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek ((Ptr ("pName" ::: Ptr CChar)
ppEnabledLayerNames Ptr ("pName" ::: Ptr CChar) -> Int -> Ptr ("pName" ::: Ptr CChar)
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr CChar))))
Word32
enabledExtensionCount <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 48 :: Ptr Word32))
Ptr ("pName" ::: Ptr CChar)
ppEnabledExtensionNames <- Ptr (Ptr ("pName" ::: Ptr CChar))
-> IO (Ptr ("pName" ::: Ptr CChar))
forall a. Storable a => Ptr a -> IO a
peek @(Ptr (Ptr CChar)) ((Ptr (InstanceCreateInfo es)
p Ptr (InstanceCreateInfo es)
-> Int -> Ptr (Ptr ("pName" ::: Ptr CChar))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 56 :: Ptr (Ptr (Ptr CChar))))
Vector ("name" ::: ByteString)
ppEnabledExtensionNames' <- Int
-> (Int -> IO ("name" ::: ByteString))
-> IO (Vector ("name" ::: ByteString))
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
enabledExtensionCount) (\i :: Int
i -> ("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString)
packCString (("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString))
-> IO ("pName" ::: Ptr CChar) -> IO ("name" ::: ByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr ("pName" ::: Ptr CChar) -> IO ("pName" ::: Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek ((Ptr ("pName" ::: Ptr CChar)
ppEnabledExtensionNames Ptr ("pName" ::: Ptr CChar) -> Int -> Ptr ("pName" ::: Ptr CChar)
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr CChar))))
InstanceCreateInfo es -> IO (InstanceCreateInfo es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InstanceCreateInfo es -> IO (InstanceCreateInfo es))
-> InstanceCreateInfo es -> IO (InstanceCreateInfo es)
forall a b. (a -> b) -> a -> b
$ Chain es
-> InstanceCreateFlags
-> Maybe ApplicationInfo
-> Vector ("name" ::: ByteString)
-> Vector ("name" ::: ByteString)
-> InstanceCreateInfo es
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 = Chain es
-> InstanceCreateFlags
-> Maybe ApplicationInfo
-> Vector ("name" ::: ByteString)
-> Vector ("name" ::: ByteString)
-> InstanceCreateInfo es
forall (es :: [*]).
Chain es
-> InstanceCreateFlags
-> Maybe ApplicationInfo
-> Vector ("name" ::: ByteString)
-> Vector ("name" ::: ByteString)
-> InstanceCreateInfo es
InstanceCreateInfo
()
InstanceCreateFlags
forall a. Zero a => a
zero
Maybe ApplicationInfo
forall a. Maybe a
Nothing
Vector ("name" ::: ByteString)
forall a. Monoid a => a
mempty
Vector ("name" ::: ByteString)
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 :: QueueFamilyProperties
-> (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO b)
-> IO b
withCStruct x :: QueueFamilyProperties
x f :: ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties) -> IO b
f = Int
-> Int
-> (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 24 4 ((("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties) -> IO b)
-> IO b)
-> (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \p :: "pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p -> ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> QueueFamilyProperties -> IO b -> IO b
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 :: ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> QueueFamilyProperties -> IO b -> IO b
pokeCStruct p :: "pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p QueueFamilyProperties{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr QueueFlags -> QueueFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> Ptr QueueFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr QueueFlags)) (QueueFlags
queueFlags)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32)) (Word32
queueCount)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Word32)) (Word32
timestampValidBits)
((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Extent3D -> Extent3D -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr Extent3D)) (Extent3D
minImageTransferGranularity) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = 24
cStructAlignment :: Int
cStructAlignment = 4
pokeZeroCStruct :: ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO b -> IO b
pokeZeroCStruct p :: "pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Extent3D -> Extent3D -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr Extent3D)) (Extent3D
forall a. Zero a => a
zero) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
instance FromCStruct QueueFamilyProperties where
peekCStruct :: ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> IO QueueFamilyProperties
peekCStruct p :: "pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p = do
QueueFlags
queueFlags <- Ptr QueueFlags -> IO QueueFlags
forall a. Storable a => Ptr a -> IO a
peek @QueueFlags (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> Ptr QueueFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr QueueFlags))
Word32
queueCount <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32))
Word32
timestampValidBits <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Word32))
Extent3D
minImageTransferGranularity <- Ptr Extent3D -> IO Extent3D
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent3D (("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties
p ("pQueueFamilyProperties" ::: Ptr QueueFamilyProperties)
-> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr Extent3D))
QueueFamilyProperties -> IO QueueFamilyProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QueueFamilyProperties -> IO QueueFamilyProperties)
-> QueueFamilyProperties -> IO QueueFamilyProperties
forall a b. (a -> b) -> a -> b
$ QueueFlags -> Word32 -> Word32 -> Extent3D -> QueueFamilyProperties
QueueFamilyProperties
QueueFlags
queueFlags Word32
queueCount Word32
timestampValidBits Extent3D
minImageTransferGranularity
instance Zero QueueFamilyProperties where
zero :: QueueFamilyProperties
zero = QueueFlags -> Word32 -> Word32 -> Extent3D -> QueueFamilyProperties
QueueFamilyProperties
QueueFlags
forall a. Zero a => a
zero
Word32
forall a. Zero a => a
zero
Word32
forall a. Zero a => a
zero
Extent3D
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 :: PhysicalDeviceMemoryProperties
-> (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO b)
-> IO b
withCStruct x :: PhysicalDeviceMemoryProperties
x f :: ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO b
f = Int
-> Int
-> (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 520 8 ((("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO b)
-> IO b)
-> (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \p :: "pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p -> ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> PhysicalDeviceMemoryProperties -> IO b -> IO b
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 :: ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> PhysicalDeviceMemoryProperties -> IO b -> IO b
pokeCStruct p :: "pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p PhysicalDeviceMemoryProperties{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32)) (Word32
memoryTypeCount)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Vector MemoryType -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector MemoryType -> Int) -> Vector MemoryType -> Int
forall a b. (a -> b) -> a -> b
$ (Vector MemoryType
memoryTypes)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
forall a. Integral a => a
MAX_MEMORY_TYPES) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "memoryTypes is too long, a maximum of MAX_MEMORY_TYPES elements are allowed" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
(Int -> MemoryType -> ContT b IO ())
-> Vector MemoryType -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: MemoryType
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr MemoryType -> MemoryType -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr (FixedArray MAX_MEMORY_TYPES MemoryType) -> Ptr MemoryType
forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> Int -> Ptr (FixedArray MAX_MEMORY_TYPES MemoryType)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr (FixedArray MAX_MEMORY_TYPES MemoryType)))) Ptr MemoryType -> Int -> Ptr MemoryType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MemoryType) (MemoryType
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector MemoryType
memoryTypes)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 260 :: Ptr Word32)) (Word32
memoryHeapCount)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Vector MemoryHeap -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector MemoryHeap -> Int) -> Vector MemoryHeap -> Int
forall a b. (a -> b) -> a -> b
$ (Vector MemoryHeap
memoryHeaps)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
forall a. Integral a => a
MAX_MEMORY_HEAPS) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "memoryHeaps is too long, a maximum of MAX_MEMORY_HEAPS elements are allowed" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
(Int -> MemoryHeap -> ContT b IO ())
-> Vector MemoryHeap -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: MemoryHeap
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr MemoryHeap -> MemoryHeap -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr (FixedArray UUID_SIZE MemoryHeap) -> Ptr MemoryHeap
forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> Int -> Ptr (FixedArray UUID_SIZE MemoryHeap)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 264 :: Ptr (FixedArray MAX_MEMORY_HEAPS MemoryHeap)))) Ptr MemoryHeap -> Int -> Ptr MemoryHeap
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MemoryHeap) (MemoryHeap
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector MemoryHeap
memoryHeaps)
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = 520
cStructAlignment :: Int
cStructAlignment = 8
pokeZeroCStruct :: ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO b -> IO b
pokeZeroCStruct p :: "pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Vector Any -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Any -> Int) -> Vector Any -> Int
forall a b. (a -> b) -> a -> b
$ (Vector Any
forall a. Monoid a => a
mempty)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
forall a. Integral a => a
MAX_MEMORY_TYPES) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "memoryTypes is too long, a maximum of MAX_MEMORY_TYPES elements are allowed" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
(Int -> MemoryType -> ContT b IO ())
-> Vector MemoryType -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: MemoryType
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr MemoryType -> MemoryType -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr (FixedArray MAX_MEMORY_TYPES MemoryType) -> Ptr MemoryType
forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> Int -> Ptr (FixedArray MAX_MEMORY_TYPES MemoryType)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr (FixedArray MAX_MEMORY_TYPES MemoryType)))) Ptr MemoryType -> Int -> Ptr MemoryType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MemoryType) (MemoryType
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector MemoryType
forall a. Monoid a => a
mempty)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 260 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Vector Any -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Any -> Int) -> Vector Any -> Int
forall a b. (a -> b) -> a -> b
$ (Vector Any
forall a. Monoid a => a
mempty)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
forall a. Integral a => a
MAX_MEMORY_HEAPS) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "memoryHeaps is too long, a maximum of MAX_MEMORY_HEAPS elements are allowed" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
(Int -> MemoryHeap -> ContT b IO ())
-> Vector MemoryHeap -> ContT b IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: MemoryHeap
e -> ((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr MemoryHeap -> MemoryHeap -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct ((Ptr (FixedArray UUID_SIZE MemoryHeap) -> Ptr MemoryHeap
forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> Int -> Ptr (FixedArray UUID_SIZE MemoryHeap)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 264 :: Ptr (FixedArray MAX_MEMORY_HEAPS MemoryHeap)))) Ptr MemoryHeap -> Int -> Ptr MemoryHeap
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MemoryHeap) (MemoryHeap
e) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())) (Vector MemoryHeap
forall a. Monoid a => a
mempty)
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
instance FromCStruct PhysicalDeviceMemoryProperties where
peekCStruct :: ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> IO PhysicalDeviceMemoryProperties
peekCStruct p :: "pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p = do
Word32
memoryTypeCount <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Word32))
Vector MemoryType
memoryTypes <- Int -> (Int -> IO MemoryType) -> IO (Vector MemoryType)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Int
forall a. Integral a => a
MAX_MEMORY_TYPES) (\i :: Int
i -> Ptr MemoryType -> IO MemoryType
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @MemoryType (((Ptr (FixedArray MAX_MEMORY_TYPES MemoryType) -> Ptr MemoryType
forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr @MemoryType (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> Int -> Ptr (FixedArray MAX_MEMORY_TYPES MemoryType)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr (FixedArray MAX_MEMORY_TYPES MemoryType)))) Ptr MemoryType -> Int -> Ptr MemoryType
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MemoryType)))
Word32
memoryHeapCount <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 260 :: Ptr Word32))
Vector MemoryHeap
memoryHeaps <- Int -> (Int -> IO MemoryHeap) -> IO (Vector MemoryHeap)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (Int
forall a. Integral a => a
MAX_MEMORY_HEAPS) (\i :: Int
i -> Ptr MemoryHeap -> IO MemoryHeap
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @MemoryHeap (((Ptr (FixedArray UUID_SIZE MemoryHeap) -> Ptr MemoryHeap
forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr @MemoryHeap (("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties
p ("pMemoryProperties" ::: Ptr PhysicalDeviceMemoryProperties)
-> Int -> Ptr (FixedArray UUID_SIZE MemoryHeap)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 264 :: Ptr (FixedArray MAX_MEMORY_HEAPS MemoryHeap)))) Ptr MemoryHeap -> Int -> Ptr MemoryHeap
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MemoryHeap)))
PhysicalDeviceMemoryProperties -> IO PhysicalDeviceMemoryProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PhysicalDeviceMemoryProperties
-> IO PhysicalDeviceMemoryProperties)
-> PhysicalDeviceMemoryProperties
-> IO PhysicalDeviceMemoryProperties
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 Zero PhysicalDeviceMemoryProperties where
zero :: PhysicalDeviceMemoryProperties
zero = Word32
-> Vector MemoryType
-> Word32
-> Vector MemoryHeap
-> PhysicalDeviceMemoryProperties
PhysicalDeviceMemoryProperties
Word32
forall a. Zero a => a
zero
Vector MemoryType
forall a. Monoid a => a
mempty
Word32
forall a. Zero a => a
zero
Vector MemoryHeap
forall a. Monoid a => a
mempty
data MemoryType = MemoryType
{
MemoryType -> MemoryPropertyFlags
propertyFlags :: MemoryPropertyFlags
,
MemoryType -> Word32
heapIndex :: Word32
}
deriving (Typeable, MemoryType -> MemoryType -> Bool
(MemoryType -> MemoryType -> Bool)
-> (MemoryType -> MemoryType -> Bool) -> Eq MemoryType
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 :: MemoryType -> (Ptr MemoryType -> IO b) -> IO b
withCStruct x :: MemoryType
x f :: Ptr MemoryType -> IO b
f = Int -> Int -> (Ptr MemoryType -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 8 4 ((Ptr MemoryType -> IO b) -> IO b)
-> (Ptr MemoryType -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr MemoryType
p -> Ptr MemoryType -> MemoryType -> IO b -> IO b
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 :: Ptr MemoryType -> MemoryType -> IO b -> IO b
pokeCStruct p :: Ptr MemoryType
p MemoryType{..} f :: IO b
f = do
Ptr MemoryPropertyFlags -> MemoryPropertyFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryType
p Ptr MemoryType -> Int -> Ptr MemoryPropertyFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr MemoryPropertyFlags)) (MemoryPropertyFlags
propertyFlags)
("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryType
p Ptr MemoryType -> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32)) (Word32
heapIndex)
IO b
f
cStructSize :: Int
cStructSize = 8
cStructAlignment :: Int
cStructAlignment = 4
pokeZeroCStruct :: Ptr MemoryType -> IO b -> IO b
pokeZeroCStruct p :: Ptr MemoryType
p f :: IO b
f = do
("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryType
p Ptr MemoryType -> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
IO b
f
instance FromCStruct MemoryType where
peekCStruct :: Ptr MemoryType -> IO MemoryType
peekCStruct p :: Ptr MemoryType
p = do
MemoryPropertyFlags
propertyFlags <- Ptr MemoryPropertyFlags -> IO MemoryPropertyFlags
forall a. Storable a => Ptr a -> IO a
peek @MemoryPropertyFlags ((Ptr MemoryType
p Ptr MemoryType -> Int -> Ptr MemoryPropertyFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr MemoryPropertyFlags))
Word32
heapIndex <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr MemoryType
p Ptr MemoryType -> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr Word32))
MemoryType -> IO MemoryType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MemoryType -> IO MemoryType) -> MemoryType -> IO MemoryType
forall a b. (a -> b) -> a -> b
$ MemoryPropertyFlags -> Word32 -> MemoryType
MemoryType
MemoryPropertyFlags
propertyFlags Word32
heapIndex
instance Storable MemoryType where
sizeOf :: MemoryType -> Int
sizeOf ~MemoryType
_ = 8
alignment :: MemoryType -> Int
alignment ~MemoryType
_ = 4
peek :: Ptr MemoryType -> IO MemoryType
peek = Ptr MemoryType -> IO MemoryType
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr MemoryType -> MemoryType -> IO ()
poke ptr :: Ptr MemoryType
ptr poked :: MemoryType
poked = Ptr MemoryType -> MemoryType -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr MemoryType
ptr MemoryType
poked (FN_vkVoidFunction
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero MemoryType where
zero :: MemoryType
zero = MemoryPropertyFlags -> Word32 -> MemoryType
MemoryType
MemoryPropertyFlags
forall a. Zero a => a
zero
Word32
forall a. Zero a => a
zero
data MemoryHeap = MemoryHeap
{
MemoryHeap -> DeviceSize
size :: DeviceSize
,
MemoryHeap -> MemoryHeapFlags
flags :: MemoryHeapFlags
}
deriving (Typeable, MemoryHeap -> MemoryHeap -> Bool
(MemoryHeap -> MemoryHeap -> Bool)
-> (MemoryHeap -> MemoryHeap -> Bool) -> Eq MemoryHeap
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 :: MemoryHeap -> (Ptr MemoryHeap -> IO b) -> IO b
withCStruct x :: MemoryHeap
x f :: Ptr MemoryHeap -> IO b
f = Int -> Int -> (Ptr MemoryHeap -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 16 8 ((Ptr MemoryHeap -> IO b) -> IO b)
-> (Ptr MemoryHeap -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr MemoryHeap
p -> Ptr MemoryHeap -> MemoryHeap -> IO b -> IO b
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 :: Ptr MemoryHeap -> MemoryHeap -> IO b -> IO b
pokeCStruct p :: Ptr MemoryHeap
p MemoryHeap{..} f :: IO b
f = do
Ptr DeviceSize -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryHeap
p Ptr MemoryHeap -> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr DeviceSize)) (DeviceSize
size)
Ptr MemoryHeapFlags -> MemoryHeapFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryHeap
p Ptr MemoryHeap -> Int -> Ptr MemoryHeapFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr MemoryHeapFlags)) (MemoryHeapFlags
flags)
IO b
f
cStructSize :: Int
cStructSize = 16
cStructAlignment :: Int
cStructAlignment = 8
pokeZeroCStruct :: Ptr MemoryHeap -> IO b -> IO b
pokeZeroCStruct p :: Ptr MemoryHeap
p f :: IO b
f = do
Ptr DeviceSize -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr MemoryHeap
p Ptr MemoryHeap -> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr DeviceSize)) (DeviceSize
forall a. Zero a => a
zero)
IO b
f
instance FromCStruct MemoryHeap where
peekCStruct :: Ptr MemoryHeap -> IO MemoryHeap
peekCStruct p :: Ptr MemoryHeap
p = do
DeviceSize
size <- Ptr DeviceSize -> IO DeviceSize
forall a. Storable a => Ptr a -> IO a
peek @DeviceSize ((Ptr MemoryHeap
p Ptr MemoryHeap -> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr DeviceSize))
MemoryHeapFlags
flags <- Ptr MemoryHeapFlags -> IO MemoryHeapFlags
forall a. Storable a => Ptr a -> IO a
peek @MemoryHeapFlags ((Ptr MemoryHeap
p Ptr MemoryHeap -> Int -> Ptr MemoryHeapFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr MemoryHeapFlags))
MemoryHeap -> IO MemoryHeap
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MemoryHeap -> IO MemoryHeap) -> MemoryHeap -> IO MemoryHeap
forall a b. (a -> b) -> a -> b
$ DeviceSize -> MemoryHeapFlags -> MemoryHeap
MemoryHeap
DeviceSize
size MemoryHeapFlags
flags
instance Storable MemoryHeap where
sizeOf :: MemoryHeap -> Int
sizeOf ~MemoryHeap
_ = 16
alignment :: MemoryHeap -> Int
alignment ~MemoryHeap
_ = 8
peek :: Ptr MemoryHeap -> IO MemoryHeap
peek = Ptr MemoryHeap -> IO MemoryHeap
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr MemoryHeap -> MemoryHeap -> IO ()
poke ptr :: Ptr MemoryHeap
ptr poked :: MemoryHeap
poked = Ptr MemoryHeap -> MemoryHeap -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr MemoryHeap
ptr MemoryHeap
poked (FN_vkVoidFunction
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero MemoryHeap where
zero :: MemoryHeap
zero = DeviceSize -> MemoryHeapFlags -> MemoryHeap
MemoryHeap
DeviceSize
forall a. Zero a => a
zero
MemoryHeapFlags
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
(FormatProperties -> FormatProperties -> Bool)
-> (FormatProperties -> FormatProperties -> Bool)
-> Eq FormatProperties
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 :: FormatProperties
-> (("pFormatProperties" ::: Ptr FormatProperties) -> IO b) -> IO b
withCStruct x :: FormatProperties
x f :: ("pFormatProperties" ::: Ptr FormatProperties) -> IO b
f = Int
-> Int
-> (("pFormatProperties" ::: Ptr FormatProperties) -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 12 4 ((("pFormatProperties" ::: Ptr FormatProperties) -> IO b) -> IO b)
-> (("pFormatProperties" ::: Ptr FormatProperties) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: "pFormatProperties" ::: Ptr FormatProperties
p -> ("pFormatProperties" ::: Ptr FormatProperties)
-> FormatProperties -> IO b -> IO b
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 :: ("pFormatProperties" ::: Ptr FormatProperties)
-> FormatProperties -> IO b -> IO b
pokeCStruct p :: "pFormatProperties" ::: Ptr FormatProperties
p FormatProperties{..} f :: IO b
f = do
Ptr FormatFeatureFlags -> FormatFeatureFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFormatProperties" ::: Ptr FormatProperties
p ("pFormatProperties" ::: Ptr FormatProperties)
-> Int -> Ptr FormatFeatureFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr FormatFeatureFlags)) (FormatFeatureFlags
linearTilingFeatures)
Ptr FormatFeatureFlags -> FormatFeatureFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFormatProperties" ::: Ptr FormatProperties
p ("pFormatProperties" ::: Ptr FormatProperties)
-> Int -> Ptr FormatFeatureFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr FormatFeatureFlags)) (FormatFeatureFlags
optimalTilingFeatures)
Ptr FormatFeatureFlags -> FormatFeatureFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pFormatProperties" ::: Ptr FormatProperties
p ("pFormatProperties" ::: Ptr FormatProperties)
-> Int -> Ptr FormatFeatureFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr FormatFeatureFlags)) (FormatFeatureFlags
bufferFeatures)
IO b
f
cStructSize :: Int
cStructSize = 12
cStructAlignment :: Int
cStructAlignment = 4
pokeZeroCStruct :: ("pFormatProperties" ::: Ptr FormatProperties) -> IO b -> IO b
pokeZeroCStruct _ f :: IO b
f = IO b
f
instance FromCStruct FormatProperties where
peekCStruct :: ("pFormatProperties" ::: Ptr FormatProperties)
-> IO FormatProperties
peekCStruct p :: "pFormatProperties" ::: Ptr FormatProperties
p = do
FormatFeatureFlags
linearTilingFeatures <- Ptr FormatFeatureFlags -> IO FormatFeatureFlags
forall a. Storable a => Ptr a -> IO a
peek @FormatFeatureFlags (("pFormatProperties" ::: Ptr FormatProperties
p ("pFormatProperties" ::: Ptr FormatProperties)
-> Int -> Ptr FormatFeatureFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr FormatFeatureFlags))
FormatFeatureFlags
optimalTilingFeatures <- Ptr FormatFeatureFlags -> IO FormatFeatureFlags
forall a. Storable a => Ptr a -> IO a
peek @FormatFeatureFlags (("pFormatProperties" ::: Ptr FormatProperties
p ("pFormatProperties" ::: Ptr FormatProperties)
-> Int -> Ptr FormatFeatureFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr FormatFeatureFlags))
FormatFeatureFlags
bufferFeatures <- Ptr FormatFeatureFlags -> IO FormatFeatureFlags
forall a. Storable a => Ptr a -> IO a
peek @FormatFeatureFlags (("pFormatProperties" ::: Ptr FormatProperties
p ("pFormatProperties" ::: Ptr FormatProperties)
-> Int -> Ptr FormatFeatureFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr FormatFeatureFlags))
FormatProperties -> IO FormatProperties
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FormatProperties -> IO FormatProperties)
-> FormatProperties -> IO FormatProperties
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
_ = 12
alignment :: FormatProperties -> Int
alignment ~FormatProperties
_ = 4
peek :: ("pFormatProperties" ::: Ptr FormatProperties)
-> IO FormatProperties
peek = ("pFormatProperties" ::: Ptr FormatProperties)
-> IO FormatProperties
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: ("pFormatProperties" ::: Ptr FormatProperties)
-> FormatProperties -> IO ()
poke ptr :: "pFormatProperties" ::: Ptr FormatProperties
ptr poked :: FormatProperties
poked = ("pFormatProperties" ::: Ptr FormatProperties)
-> FormatProperties -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct "pFormatProperties" ::: Ptr FormatProperties
ptr FormatProperties
poked (FN_vkVoidFunction
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero FormatProperties where
zero :: FormatProperties
zero = FormatFeatureFlags
-> FormatFeatureFlags -> FormatFeatureFlags -> FormatProperties
FormatProperties
FormatFeatureFlags
forall a. Zero a => a
zero
FormatFeatureFlags
forall a. Zero a => a
zero
FormatFeatureFlags
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 :: ImageFormatProperties
-> (("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO b)
-> IO b
withCStruct x :: ImageFormatProperties
x f :: ("pImageFormatProperties" ::: Ptr ImageFormatProperties) -> IO b
f = Int
-> Int
-> (("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((("pImageFormatProperties" ::: Ptr ImageFormatProperties) -> IO b)
-> IO b)
-> (("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO b)
-> IO b
forall a b. (a -> b) -> a -> b
$ \p :: "pImageFormatProperties" ::: Ptr ImageFormatProperties
p -> ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> ImageFormatProperties -> IO b -> IO b
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 :: ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> ImageFormatProperties -> IO b -> IO b
pokeCStruct p :: "pImageFormatProperties" ::: Ptr ImageFormatProperties
p ImageFormatProperties{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Extent3D -> Extent3D -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Extent3D)) (Extent3D
maxExtent) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr Word32)) (Word32
maxMipLevels)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32)) (Word32
maxArrayLayers)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SampleCountFlags -> SampleCountFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> Int -> Ptr SampleCountFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr SampleCountFlags)) (SampleCountFlags
sampleCounts)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr DeviceSize -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr DeviceSize)) (DeviceSize
maxResourceSize)
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = 32
cStructAlignment :: Int
cStructAlignment = 8
pokeZeroCStruct :: ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO b -> IO b
pokeZeroCStruct p :: "pImageFormatProperties" ::: Ptr ImageFormatProperties
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
((() -> IO b) -> IO b) -> ContT b IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO b) -> IO b) -> ContT b IO ())
-> ((() -> IO b) -> IO b) -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Extent3D -> Extent3D -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Extent3D)) (Extent3D
forall a. Zero a => a
zero) (IO b -> IO b) -> ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO b) -> () -> IO b
forall a b. (a -> b) -> a -> b
$ ())
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 12 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("pPhysicalDeviceCount" ::: Ptr Word32) -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> Int -> "pPhysicalDeviceCount" ::: Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32)) (Word32
forall a. Zero a => a
zero)
IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr DeviceSize -> DeviceSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> Int -> Ptr DeviceSize
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr DeviceSize)) (DeviceSize
forall a. Zero a => a
zero)
IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
instance FromCStruct ImageFormatProperties where
peekCStruct :: ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> IO ImageFormatProperties
peekCStruct p :: "pImageFormatProperties" ::: Ptr ImageFormatProperties
p = do
Extent3D
maxExtent <- Ptr Extent3D -> IO Extent3D
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Extent3D (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p ("pImageFormatProperties" ::: Ptr ImageFormatProperties)
-> Int -> Ptr Extent3D
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr Extent3D))
Word32
maxMipLevels <- ("pPhysicalDeviceCount" ::: Ptr Word32) -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek @Word32 (("pImageFormatProperties" ::: Ptr ImageFormatProperties
p