{-# language CPP #-}
module VulkanMemoryAllocator ( createAllocator
, withAllocator
, destroyAllocator
, getAllocatorInfo
, getPhysicalDeviceProperties
, getMemoryProperties
, getMemoryTypeProperties
, setCurrentFrameIndex
, calculateStats
, getBudget
, buildStatsString
, freeStatsString
, findMemoryTypeIndex
, findMemoryTypeIndexForBufferInfo
, findMemoryTypeIndexForImageInfo
, createPool
, withPool
, destroyPool
, getPoolStats
, makePoolAllocationsLost
, checkPoolCorruption
, getPoolName
, setPoolName
, allocateMemory
, withMemory
, allocateMemoryPages
, withMemoryPages
, allocateMemoryForBuffer
, withMemoryForBuffer
, allocateMemoryForImage
, withMemoryForImage
, freeMemory
, freeMemoryPages
, resizeAllocation
, getAllocationInfo
, touchAllocation
, setAllocationUserData
, createLostAllocation
, withLostAllocation
, mapMemory
, withMappedMemory
, unmapMemory
, flushAllocation
, invalidateAllocation
, flushAllocations
, invalidateAllocations
, checkCorruption
, defragmentationBegin
, withDefragmentation
, defragmentationEnd
, beginDefragmentationPass
, useDefragmentationPass
, endDefragmentationPass
, defragment
, bindBufferMemory
, bindBufferMemory2
, bindImageMemory
, bindImageMemory2
, createBuffer
, withBuffer
, destroyBuffer
, createImage
, withImage
, destroyImage
, Allocator(..)
, PFN_vmaAllocateDeviceMemoryFunction
, FN_vmaAllocateDeviceMemoryFunction
, PFN_vmaFreeDeviceMemoryFunction
, FN_vmaFreeDeviceMemoryFunction
, DeviceMemoryCallbacks(..)
, AllocatorCreateFlagBits( ALLOCATOR_CREATE_EXTERNALLY_SYNCHRONIZED_BIT
, ALLOCATOR_CREATE_KHR_DEDICATED_ALLOCATION_BIT
, ALLOCATOR_CREATE_KHR_BIND_MEMORY2_BIT
, ALLOCATOR_CREATE_EXT_MEMORY_BUDGET_BIT
, ALLOCATOR_CREATE_AMD_DEVICE_COHERENT_MEMORY_BIT
, ALLOCATOR_CREATE_BUFFER_DEVICE_ADDRESS_BIT
, ..
)
, AllocatorCreateFlags
, VulkanFunctions(..)
, RecordFlagBits( RECORD_FLUSH_AFTER_CALL_BIT
, ..
)
, RecordFlags
, RecordSettings(..)
, AllocatorCreateInfo(..)
, AllocatorInfo(..)
, StatInfo(..)
, Stats(..)
, Budget(..)
, Pool(..)
, MemoryUsage( MEMORY_USAGE_UNKNOWN
, MEMORY_USAGE_GPU_ONLY
, MEMORY_USAGE_CPU_ONLY
, MEMORY_USAGE_CPU_TO_GPU
, MEMORY_USAGE_GPU_TO_CPU
, MEMORY_USAGE_CPU_COPY
, MEMORY_USAGE_GPU_LAZILY_ALLOCATED
, ..
)
, AllocationCreateFlagBits( ALLOCATION_CREATE_DEDICATED_MEMORY_BIT
, ALLOCATION_CREATE_NEVER_ALLOCATE_BIT
, ALLOCATION_CREATE_MAPPED_BIT
, ALLOCATION_CREATE_CAN_BECOME_LOST_BIT
, ALLOCATION_CREATE_CAN_MAKE_OTHER_LOST_BIT
, ALLOCATION_CREATE_USER_DATA_COPY_STRING_BIT
, ALLOCATION_CREATE_UPPER_ADDRESS_BIT
, ALLOCATION_CREATE_DONT_BIND_BIT
, ALLOCATION_CREATE_WITHIN_BUDGET_BIT
, ALLOCATION_CREATE_STRATEGY_BEST_FIT_BIT
, ALLOCATION_CREATE_STRATEGY_WORST_FIT_BIT
, ALLOCATION_CREATE_STRATEGY_FIRST_FIT_BIT
, ALLOCATION_CREATE_STRATEGY_MIN_MEMORY_BIT
, ALLOCATION_CREATE_STRATEGY_MIN_TIME_BIT
, ALLOCATION_CREATE_STRATEGY_MIN_FRAGMENTATION_BIT
, ALLOCATION_CREATE_STRATEGY_MASK
, ..
)
, AllocationCreateFlags
, AllocationCreateInfo(..)
, PoolCreateFlagBits( POOL_CREATE_IGNORE_BUFFER_IMAGE_GRANULARITY_BIT
, POOL_CREATE_LINEAR_ALGORITHM_BIT
, POOL_CREATE_BUDDY_ALGORITHM_BIT
, POOL_CREATE_ALGORITHM_MASK
, ..
)
, PoolCreateFlags
, PoolCreateInfo(..)
, PoolStats(..)
, Allocation(..)
, AllocationInfo(..)
, DefragmentationContext(..)
, DefragmentationFlagBits( DEFRAGMENTATION_FLAG_INCREMENTAL
, ..
)
, DefragmentationFlags
, DefragmentationInfo2(..)
, DefragmentationPassMoveInfo(..)
, DefragmentationPassInfo(..)
, DefragmentationInfo(..)
, DefragmentationStats(..)
) where
import Vulkan (AllocationCallbacks)
import Vulkan (BindBufferMemoryInfo)
import Vulkan (BindImageMemoryInfo)
import Vulkan (Bool32)
import Vulkan (Buffer)
import Vulkan (BufferCopy)
import Vulkan (BufferCreateInfo)
import Vulkan (BufferMemoryRequirementsInfo2)
import Vulkan (CommandBuffer_T)
import Vulkan (DeviceMemory)
import Vulkan (DeviceSize)
import Vulkan (Device_T)
import Vulkan (Flags)
import Vulkan (Image)
import Vulkan (ImageCreateInfo)
import Vulkan (ImageMemoryRequirementsInfo2)
import Vulkan (Instance_T)
import Vulkan (MappedMemoryRange)
import Vulkan (MemoryAllocateInfo)
import Vulkan (MemoryMapFlags)
import Vulkan (MemoryPropertyFlags)
import Vulkan (MemoryRequirements)
import Vulkan (MemoryRequirements2)
import Vulkan (PhysicalDeviceMemoryProperties)
import Vulkan (PhysicalDeviceMemoryProperties2)
import Vulkan (PhysicalDeviceProperties)
import Vulkan (PhysicalDevice_T)
import Vulkan (Result)
import Vulkan.CStruct.Utils (FixedArray)
import Vulkan.CStruct.Extends (forgetExtensions)
import Vulkan.CStruct.Utils (advancePtrBytes)
import Vulkan.CStruct.Utils (lowerArrayPtr)
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
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 (nullPtr)
import Foreign.Ptr (plusPtr)
import GHC.Read (choose)
import GHC.Read (expectP)
import GHC.Read (parens)
import GHC.Show (showParen)
import GHC.Show (showString)
import GHC.Show (showsPrec)
import Numeric (showHex)
import Text.ParserCombinators.ReadPrec ((+++))
import Text.ParserCombinators.ReadPrec (prec)
import Text.ParserCombinators.ReadPrec (step)
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 qualified Data.Vector (null)
import Vulkan.Core10.APIConstants (pattern MAX_MEMORY_HEAPS)
import Vulkan.Core10.APIConstants (pattern MAX_MEMORY_TYPES)
import Vulkan.Core10.Enums.Result (pattern SUCCESS)
import Foreign.C.Types (CChar(..))
import Foreign.C.Types (CSize(..))
import Vulkan (Bool32(..))
import Vulkan (Buffer(..))
import Vulkan (Image(..))
import Vulkan (MemoryPropertyFlagBits(..))
import Vulkan (Result(..))
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.CStruct.Extends (Extendss)
import Vulkan.CStruct.Extends (PokeChain)
import Vulkan.CStruct.Extends (SomeStruct)
import Vulkan.Core10.APIConstants (IsHandle)
import Vulkan.Core10.APIConstants (MAX_MEMORY_HEAPS)
import Vulkan.Core10.APIConstants (MAX_MEMORY_TYPES)
import Vulkan.Exception (VulkanException(..))
import Vulkan.NamedType ((:::))
import Vulkan.Zero (Zero)
import Vulkan.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.Bits (Bits)
import Data.Typeable (Typeable)
import Foreign.C.Types (CChar)
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.Read (Read(readPrec))
import Data.Word (Word32)
import Data.Word (Word64)
import Text.Read.Lex (Lexeme(Ident))
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaCreateAllocator" ffiVmaCreateAllocator
:: Ptr AllocatorCreateInfo -> Ptr Allocator -> IO Result
createAllocator :: forall io
. (MonadIO io)
=>
AllocatorCreateInfo
-> io (Allocator)
createAllocator :: AllocatorCreateInfo -> io Allocator
createAllocator createInfo :: AllocatorCreateInfo
createInfo = IO Allocator -> io Allocator
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Allocator -> io Allocator)
-> (ContT Allocator IO Allocator -> IO Allocator)
-> ContT Allocator IO Allocator
-> io Allocator
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Allocator IO Allocator -> IO Allocator
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Allocator IO Allocator -> io Allocator)
-> ContT Allocator IO Allocator -> io Allocator
forall a b. (a -> b) -> a -> b
$ do
Ptr AllocatorCreateInfo
pCreateInfo <- ((Ptr AllocatorCreateInfo -> IO Allocator) -> IO Allocator)
-> ContT Allocator IO (Ptr AllocatorCreateInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr AllocatorCreateInfo -> IO Allocator) -> IO Allocator)
-> ContT Allocator IO (Ptr AllocatorCreateInfo))
-> ((Ptr AllocatorCreateInfo -> IO Allocator) -> IO Allocator)
-> ContT Allocator IO (Ptr AllocatorCreateInfo)
forall a b. (a -> b) -> a -> b
$ AllocatorCreateInfo
-> (Ptr AllocatorCreateInfo -> IO Allocator) -> IO Allocator
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocatorCreateInfo
createInfo)
Ptr Allocator
pPAllocator <- ((Ptr Allocator -> IO Allocator) -> IO Allocator)
-> ContT Allocator IO (Ptr Allocator)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Allocator -> IO Allocator) -> IO Allocator)
-> ContT Allocator IO (Ptr Allocator))
-> ((Ptr Allocator -> IO Allocator) -> IO Allocator)
-> ContT Allocator IO (Ptr Allocator)
forall a b. (a -> b) -> a -> b
$ IO (Ptr Allocator)
-> (Ptr Allocator -> IO ())
-> (Ptr Allocator -> IO Allocator)
-> IO Allocator
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr Allocator)
forall a. Int -> IO (Ptr a)
callocBytes @Allocator 8) Ptr Allocator -> IO ()
forall a. Ptr a -> IO ()
free
Result
r <- IO Result -> ContT Allocator IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT Allocator IO Result)
-> IO Result -> ContT Allocator IO Result
forall a b. (a -> b) -> a -> b
$ (Ptr AllocatorCreateInfo -> Ptr Allocator -> IO Result
ffiVmaCreateAllocator) Ptr AllocatorCreateInfo
pCreateInfo (Ptr Allocator
pPAllocator)
IO () -> ContT Allocator IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Allocator IO ()) -> IO () -> ContT Allocator 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))
Allocator
pAllocator <- IO Allocator -> ContT Allocator IO Allocator
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Allocator -> ContT Allocator IO Allocator)
-> IO Allocator -> ContT Allocator IO Allocator
forall a b. (a -> b) -> a -> b
$ Ptr Allocator -> IO Allocator
forall a. Storable a => Ptr a -> IO a
peek @Allocator Ptr Allocator
pPAllocator
Allocator -> ContT Allocator IO Allocator
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Allocator -> ContT Allocator IO Allocator)
-> Allocator -> ContT Allocator IO Allocator
forall a b. (a -> b) -> a -> b
$ (Allocator
pAllocator)
withAllocator :: forall io r . MonadIO io => AllocatorCreateInfo -> (io (Allocator) -> ((Allocator) -> io ()) -> r) -> r
withAllocator :: AllocatorCreateInfo
-> (io Allocator -> (Allocator -> io ()) -> r) -> r
withAllocator pCreateInfo :: AllocatorCreateInfo
pCreateInfo b :: io Allocator -> (Allocator -> io ()) -> r
b =
io Allocator -> (Allocator -> io ()) -> r
b (AllocatorCreateInfo -> io Allocator
forall (io :: * -> *).
MonadIO io =>
AllocatorCreateInfo -> io Allocator
createAllocator AllocatorCreateInfo
pCreateInfo)
(\(Allocator
o0) -> Allocator -> io ()
forall (io :: * -> *). MonadIO io => Allocator -> io ()
destroyAllocator Allocator
o0)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaDestroyAllocator" ffiVmaDestroyAllocator
:: Allocator -> IO ()
destroyAllocator :: forall io
. (MonadIO io)
=>
Allocator
-> io ()
destroyAllocator :: Allocator -> io ()
destroyAllocator allocator :: Allocator
allocator = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
(Allocator -> IO ()
ffiVmaDestroyAllocator) (Allocator
allocator)
() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ ()
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaGetAllocatorInfo" ffiVmaGetAllocatorInfo
:: Allocator -> Ptr AllocatorInfo -> IO ()
getAllocatorInfo :: forall io
. (MonadIO io)
=>
Allocator
-> io (AllocatorInfo)
getAllocatorInfo :: Allocator -> io AllocatorInfo
getAllocatorInfo allocator :: Allocator
allocator = IO AllocatorInfo -> io AllocatorInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AllocatorInfo -> io AllocatorInfo)
-> (ContT AllocatorInfo IO AllocatorInfo -> IO AllocatorInfo)
-> ContT AllocatorInfo IO AllocatorInfo
-> io AllocatorInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT AllocatorInfo IO AllocatorInfo -> IO AllocatorInfo
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT AllocatorInfo IO AllocatorInfo -> io AllocatorInfo)
-> ContT AllocatorInfo IO AllocatorInfo -> io AllocatorInfo
forall a b. (a -> b) -> a -> b
$ do
Ptr AllocatorInfo
pPAllocatorInfo <- ((Ptr AllocatorInfo -> IO AllocatorInfo) -> IO AllocatorInfo)
-> ContT AllocatorInfo IO (Ptr AllocatorInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct AllocatorInfo =>
(Ptr AllocatorInfo -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @AllocatorInfo)
IO () -> ContT AllocatorInfo IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT AllocatorInfo IO ())
-> IO () -> ContT AllocatorInfo IO ()
forall a b. (a -> b) -> a -> b
$ (Allocator -> Ptr AllocatorInfo -> IO ()
ffiVmaGetAllocatorInfo) (Allocator
allocator) (Ptr AllocatorInfo
pPAllocatorInfo)
AllocatorInfo
pAllocatorInfo <- IO AllocatorInfo -> ContT AllocatorInfo IO AllocatorInfo
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO AllocatorInfo -> ContT AllocatorInfo IO AllocatorInfo)
-> IO AllocatorInfo -> ContT AllocatorInfo IO AllocatorInfo
forall a b. (a -> b) -> a -> b
$ Ptr AllocatorInfo -> IO AllocatorInfo
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @AllocatorInfo Ptr AllocatorInfo
pPAllocatorInfo
AllocatorInfo -> ContT AllocatorInfo IO AllocatorInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AllocatorInfo -> ContT AllocatorInfo IO AllocatorInfo)
-> AllocatorInfo -> ContT AllocatorInfo IO AllocatorInfo
forall a b. (a -> b) -> a -> b
$ (AllocatorInfo
pAllocatorInfo)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaGetPhysicalDeviceProperties" ffiVmaGetPhysicalDeviceProperties
:: Allocator -> Ptr (Ptr PhysicalDeviceProperties) -> IO ()
getPhysicalDeviceProperties :: forall io
. (MonadIO io)
=>
Allocator
-> io (Ptr PhysicalDeviceProperties)
getPhysicalDeviceProperties :: Allocator -> io (Ptr PhysicalDeviceProperties)
getPhysicalDeviceProperties allocator :: Allocator
allocator = IO (Ptr PhysicalDeviceProperties)
-> io (Ptr PhysicalDeviceProperties)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr PhysicalDeviceProperties)
-> io (Ptr PhysicalDeviceProperties))
-> (ContT
(Ptr PhysicalDeviceProperties) IO (Ptr PhysicalDeviceProperties)
-> IO (Ptr PhysicalDeviceProperties))
-> ContT
(Ptr PhysicalDeviceProperties) IO (Ptr PhysicalDeviceProperties)
-> io (Ptr PhysicalDeviceProperties)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
(Ptr PhysicalDeviceProperties) IO (Ptr PhysicalDeviceProperties)
-> IO (Ptr PhysicalDeviceProperties)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
(Ptr PhysicalDeviceProperties) IO (Ptr PhysicalDeviceProperties)
-> io (Ptr PhysicalDeviceProperties))
-> ContT
(Ptr PhysicalDeviceProperties) IO (Ptr PhysicalDeviceProperties)
-> io (Ptr PhysicalDeviceProperties)
forall a b. (a -> b) -> a -> b
$ do
Ptr (Ptr PhysicalDeviceProperties)
pPpPhysicalDeviceProperties <- ((Ptr (Ptr PhysicalDeviceProperties)
-> IO (Ptr PhysicalDeviceProperties))
-> IO (Ptr PhysicalDeviceProperties))
-> ContT
(Ptr PhysicalDeviceProperties)
IO
(Ptr (Ptr PhysicalDeviceProperties))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Ptr PhysicalDeviceProperties)
-> IO (Ptr PhysicalDeviceProperties))
-> IO (Ptr PhysicalDeviceProperties))
-> ContT
(Ptr PhysicalDeviceProperties)
IO
(Ptr (Ptr PhysicalDeviceProperties)))
-> ((Ptr (Ptr PhysicalDeviceProperties)
-> IO (Ptr PhysicalDeviceProperties))
-> IO (Ptr PhysicalDeviceProperties))
-> ContT
(Ptr PhysicalDeviceProperties)
IO
(Ptr (Ptr PhysicalDeviceProperties))
forall a b. (a -> b) -> a -> b
$ IO (Ptr (Ptr PhysicalDeviceProperties))
-> (Ptr (Ptr PhysicalDeviceProperties) -> IO ())
-> (Ptr (Ptr PhysicalDeviceProperties)
-> IO (Ptr PhysicalDeviceProperties))
-> IO (Ptr PhysicalDeviceProperties)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr (Ptr PhysicalDeviceProperties))
forall a. Int -> IO (Ptr a)
callocBytes @(Ptr PhysicalDeviceProperties) 8) Ptr (Ptr PhysicalDeviceProperties) -> IO ()
forall a. Ptr a -> IO ()
free
IO () -> ContT (Ptr PhysicalDeviceProperties) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Ptr PhysicalDeviceProperties) IO ())
-> IO () -> ContT (Ptr PhysicalDeviceProperties) IO ()
forall a b. (a -> b) -> a -> b
$ (Allocator -> Ptr (Ptr PhysicalDeviceProperties) -> IO ()
ffiVmaGetPhysicalDeviceProperties) (Allocator
allocator) (Ptr (Ptr PhysicalDeviceProperties)
pPpPhysicalDeviceProperties)
Ptr PhysicalDeviceProperties
ppPhysicalDeviceProperties <- IO (Ptr PhysicalDeviceProperties)
-> ContT
(Ptr PhysicalDeviceProperties) IO (Ptr PhysicalDeviceProperties)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Ptr PhysicalDeviceProperties)
-> ContT
(Ptr PhysicalDeviceProperties) IO (Ptr PhysicalDeviceProperties))
-> IO (Ptr PhysicalDeviceProperties)
-> ContT
(Ptr PhysicalDeviceProperties) IO (Ptr PhysicalDeviceProperties)
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr PhysicalDeviceProperties)
-> IO (Ptr PhysicalDeviceProperties)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr PhysicalDeviceProperties) Ptr (Ptr PhysicalDeviceProperties)
pPpPhysicalDeviceProperties
Ptr PhysicalDeviceProperties
-> ContT
(Ptr PhysicalDeviceProperties) IO (Ptr PhysicalDeviceProperties)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr PhysicalDeviceProperties
-> ContT
(Ptr PhysicalDeviceProperties) IO (Ptr PhysicalDeviceProperties))
-> Ptr PhysicalDeviceProperties
-> ContT
(Ptr PhysicalDeviceProperties) IO (Ptr PhysicalDeviceProperties)
forall a b. (a -> b) -> a -> b
$ (Ptr PhysicalDeviceProperties
ppPhysicalDeviceProperties)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaGetMemoryProperties" ffiVmaGetMemoryProperties
:: Allocator -> Ptr (Ptr PhysicalDeviceMemoryProperties) -> IO ()
getMemoryProperties :: forall io
. (MonadIO io)
=>
Allocator
-> io (Ptr PhysicalDeviceMemoryProperties)
getMemoryProperties :: Allocator -> io (Ptr PhysicalDeviceMemoryProperties)
getMemoryProperties allocator :: Allocator
allocator = IO (Ptr PhysicalDeviceMemoryProperties)
-> io (Ptr PhysicalDeviceMemoryProperties)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr PhysicalDeviceMemoryProperties)
-> io (Ptr PhysicalDeviceMemoryProperties))
-> (ContT
(Ptr PhysicalDeviceMemoryProperties)
IO
(Ptr PhysicalDeviceMemoryProperties)
-> IO (Ptr PhysicalDeviceMemoryProperties))
-> ContT
(Ptr PhysicalDeviceMemoryProperties)
IO
(Ptr PhysicalDeviceMemoryProperties)
-> io (Ptr PhysicalDeviceMemoryProperties)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
(Ptr PhysicalDeviceMemoryProperties)
IO
(Ptr PhysicalDeviceMemoryProperties)
-> IO (Ptr PhysicalDeviceMemoryProperties)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
(Ptr PhysicalDeviceMemoryProperties)
IO
(Ptr PhysicalDeviceMemoryProperties)
-> io (Ptr PhysicalDeviceMemoryProperties))
-> ContT
(Ptr PhysicalDeviceMemoryProperties)
IO
(Ptr PhysicalDeviceMemoryProperties)
-> io (Ptr PhysicalDeviceMemoryProperties)
forall a b. (a -> b) -> a -> b
$ do
Ptr (Ptr PhysicalDeviceMemoryProperties)
pPpPhysicalDeviceMemoryProperties <- ((Ptr (Ptr PhysicalDeviceMemoryProperties)
-> IO (Ptr PhysicalDeviceMemoryProperties))
-> IO (Ptr PhysicalDeviceMemoryProperties))
-> ContT
(Ptr PhysicalDeviceMemoryProperties)
IO
(Ptr (Ptr PhysicalDeviceMemoryProperties))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Ptr PhysicalDeviceMemoryProperties)
-> IO (Ptr PhysicalDeviceMemoryProperties))
-> IO (Ptr PhysicalDeviceMemoryProperties))
-> ContT
(Ptr PhysicalDeviceMemoryProperties)
IO
(Ptr (Ptr PhysicalDeviceMemoryProperties)))
-> ((Ptr (Ptr PhysicalDeviceMemoryProperties)
-> IO (Ptr PhysicalDeviceMemoryProperties))
-> IO (Ptr PhysicalDeviceMemoryProperties))
-> ContT
(Ptr PhysicalDeviceMemoryProperties)
IO
(Ptr (Ptr PhysicalDeviceMemoryProperties))
forall a b. (a -> b) -> a -> b
$ IO (Ptr (Ptr PhysicalDeviceMemoryProperties))
-> (Ptr (Ptr PhysicalDeviceMemoryProperties) -> IO ())
-> (Ptr (Ptr PhysicalDeviceMemoryProperties)
-> IO (Ptr PhysicalDeviceMemoryProperties))
-> IO (Ptr PhysicalDeviceMemoryProperties)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr (Ptr PhysicalDeviceMemoryProperties))
forall a. Int -> IO (Ptr a)
callocBytes @(Ptr PhysicalDeviceMemoryProperties) 8) Ptr (Ptr PhysicalDeviceMemoryProperties) -> IO ()
forall a. Ptr a -> IO ()
free
IO () -> ContT (Ptr PhysicalDeviceMemoryProperties) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Ptr PhysicalDeviceMemoryProperties) IO ())
-> IO () -> ContT (Ptr PhysicalDeviceMemoryProperties) IO ()
forall a b. (a -> b) -> a -> b
$ (Allocator -> Ptr (Ptr PhysicalDeviceMemoryProperties) -> IO ()
ffiVmaGetMemoryProperties) (Allocator
allocator) (Ptr (Ptr PhysicalDeviceMemoryProperties)
pPpPhysicalDeviceMemoryProperties)
Ptr PhysicalDeviceMemoryProperties
ppPhysicalDeviceMemoryProperties <- IO (Ptr PhysicalDeviceMemoryProperties)
-> ContT
(Ptr PhysicalDeviceMemoryProperties)
IO
(Ptr PhysicalDeviceMemoryProperties)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Ptr PhysicalDeviceMemoryProperties)
-> ContT
(Ptr PhysicalDeviceMemoryProperties)
IO
(Ptr PhysicalDeviceMemoryProperties))
-> IO (Ptr PhysicalDeviceMemoryProperties)
-> ContT
(Ptr PhysicalDeviceMemoryProperties)
IO
(Ptr PhysicalDeviceMemoryProperties)
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr PhysicalDeviceMemoryProperties)
-> IO (Ptr PhysicalDeviceMemoryProperties)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr PhysicalDeviceMemoryProperties) Ptr (Ptr PhysicalDeviceMemoryProperties)
pPpPhysicalDeviceMemoryProperties
Ptr PhysicalDeviceMemoryProperties
-> ContT
(Ptr PhysicalDeviceMemoryProperties)
IO
(Ptr PhysicalDeviceMemoryProperties)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr PhysicalDeviceMemoryProperties
-> ContT
(Ptr PhysicalDeviceMemoryProperties)
IO
(Ptr PhysicalDeviceMemoryProperties))
-> Ptr PhysicalDeviceMemoryProperties
-> ContT
(Ptr PhysicalDeviceMemoryProperties)
IO
(Ptr PhysicalDeviceMemoryProperties)
forall a b. (a -> b) -> a -> b
$ (Ptr PhysicalDeviceMemoryProperties
ppPhysicalDeviceMemoryProperties)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaGetMemoryTypeProperties" ffiVmaGetMemoryTypeProperties
:: Allocator -> Word32 -> Ptr MemoryPropertyFlags -> IO ()
getMemoryTypeProperties :: forall io
. (MonadIO io)
=>
Allocator
->
("memoryTypeIndex" ::: Word32)
-> io (MemoryPropertyFlags)
getMemoryTypeProperties :: Allocator
-> ("memoryTypeIndex" ::: Word32) -> io MemoryPropertyFlags
getMemoryTypeProperties allocator :: Allocator
allocator memoryTypeIndex :: "memoryTypeIndex" ::: Word32
memoryTypeIndex = IO MemoryPropertyFlags -> io MemoryPropertyFlags
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MemoryPropertyFlags -> io MemoryPropertyFlags)
-> (ContT MemoryPropertyFlags IO MemoryPropertyFlags
-> IO MemoryPropertyFlags)
-> ContT MemoryPropertyFlags IO MemoryPropertyFlags
-> io MemoryPropertyFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT MemoryPropertyFlags IO MemoryPropertyFlags
-> IO MemoryPropertyFlags
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT MemoryPropertyFlags IO MemoryPropertyFlags
-> io MemoryPropertyFlags)
-> ContT MemoryPropertyFlags IO MemoryPropertyFlags
-> io MemoryPropertyFlags
forall a b. (a -> b) -> a -> b
$ do
Ptr MemoryPropertyFlags
pPFlags <- ((Ptr MemoryPropertyFlags -> IO MemoryPropertyFlags)
-> IO MemoryPropertyFlags)
-> ContT MemoryPropertyFlags IO (Ptr MemoryPropertyFlags)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr MemoryPropertyFlags -> IO MemoryPropertyFlags)
-> IO MemoryPropertyFlags)
-> ContT MemoryPropertyFlags IO (Ptr MemoryPropertyFlags))
-> ((Ptr MemoryPropertyFlags -> IO MemoryPropertyFlags)
-> IO MemoryPropertyFlags)
-> ContT MemoryPropertyFlags IO (Ptr MemoryPropertyFlags)
forall a b. (a -> b) -> a -> b
$ IO (Ptr MemoryPropertyFlags)
-> (Ptr MemoryPropertyFlags -> IO ())
-> (Ptr MemoryPropertyFlags -> IO MemoryPropertyFlags)
-> IO MemoryPropertyFlags
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr MemoryPropertyFlags)
forall a. Int -> IO (Ptr a)
callocBytes @MemoryPropertyFlags 4) Ptr MemoryPropertyFlags -> IO ()
forall a. Ptr a -> IO ()
free
IO () -> ContT MemoryPropertyFlags IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT MemoryPropertyFlags IO ())
-> IO () -> ContT MemoryPropertyFlags IO ()
forall a b. (a -> b) -> a -> b
$ (Allocator
-> ("memoryTypeIndex" ::: Word32)
-> Ptr MemoryPropertyFlags
-> IO ()
ffiVmaGetMemoryTypeProperties) (Allocator
allocator) ("memoryTypeIndex" ::: Word32
memoryTypeIndex) (Ptr MemoryPropertyFlags
pPFlags)
MemoryPropertyFlags
pFlags <- IO MemoryPropertyFlags
-> ContT MemoryPropertyFlags IO MemoryPropertyFlags
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO MemoryPropertyFlags
-> ContT MemoryPropertyFlags IO MemoryPropertyFlags)
-> IO MemoryPropertyFlags
-> ContT MemoryPropertyFlags IO MemoryPropertyFlags
forall a b. (a -> b) -> a -> b
$ Ptr MemoryPropertyFlags -> IO MemoryPropertyFlags
forall a. Storable a => Ptr a -> IO a
peek @MemoryPropertyFlags Ptr MemoryPropertyFlags
pPFlags
MemoryPropertyFlags
-> ContT MemoryPropertyFlags IO MemoryPropertyFlags
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MemoryPropertyFlags
-> ContT MemoryPropertyFlags IO MemoryPropertyFlags)
-> MemoryPropertyFlags
-> ContT MemoryPropertyFlags IO MemoryPropertyFlags
forall a b. (a -> b) -> a -> b
$ (MemoryPropertyFlags
pFlags)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaSetCurrentFrameIndex" ffiVmaSetCurrentFrameIndex
:: Allocator -> Word32 -> IO ()
setCurrentFrameIndex :: forall io
. (MonadIO io)
=>
Allocator
->
("frameIndex" ::: Word32)
-> io ()
setCurrentFrameIndex :: Allocator -> ("memoryTypeIndex" ::: Word32) -> io ()
setCurrentFrameIndex allocator :: Allocator
allocator frameIndex :: "memoryTypeIndex" ::: Word32
frameIndex = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
(Allocator -> ("memoryTypeIndex" ::: Word32) -> IO ()
ffiVmaSetCurrentFrameIndex) (Allocator
allocator) ("memoryTypeIndex" ::: Word32
frameIndex)
() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ ()
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaCalculateStats" ffiVmaCalculateStats
:: Allocator -> Ptr Stats -> IO ()
calculateStats :: forall io
. (MonadIO io)
=>
Allocator
-> io (Stats)
calculateStats :: Allocator -> io Stats
calculateStats allocator :: Allocator
allocator = IO Stats -> io Stats
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Stats -> io Stats)
-> (ContT Stats IO Stats -> IO Stats)
-> ContT Stats IO Stats
-> io Stats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Stats IO Stats -> IO Stats
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Stats IO Stats -> io Stats)
-> ContT Stats IO Stats -> io Stats
forall a b. (a -> b) -> a -> b
$ do
Ptr Stats
pPStats <- ((Ptr Stats -> IO Stats) -> IO Stats) -> ContT Stats IO (Ptr Stats)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b. ToCStruct Stats => (Ptr Stats -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @Stats)
IO () -> ContT Stats IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Stats IO ()) -> IO () -> ContT Stats IO ()
forall a b. (a -> b) -> a -> b
$ (Allocator -> Ptr Stats -> IO ()
ffiVmaCalculateStats) (Allocator
allocator) (Ptr Stats
pPStats)
Stats
pStats <- IO Stats -> ContT Stats IO Stats
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Stats -> ContT Stats IO Stats)
-> IO Stats -> ContT Stats IO Stats
forall a b. (a -> b) -> a -> b
$ Ptr Stats -> IO Stats
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Stats Ptr Stats
pPStats
Stats -> ContT Stats IO Stats
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stats -> ContT Stats IO Stats) -> Stats -> ContT Stats IO Stats
forall a b. (a -> b) -> a -> b
$ (Stats
pStats)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaGetBudget" ffiVmaGetBudget
:: Allocator -> Ptr Budget -> IO ()
getBudget :: forall io
. (MonadIO io)
=>
Allocator
-> io (("budget" ::: Vector Budget))
getBudget :: Allocator -> io ("budget" ::: Vector Budget)
getBudget allocator :: Allocator
allocator = IO ("budget" ::: Vector Budget) -> io ("budget" ::: Vector Budget)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ("budget" ::: Vector Budget)
-> io ("budget" ::: Vector Budget))
-> (ContT
("budget" ::: Vector Budget) IO ("budget" ::: Vector Budget)
-> IO ("budget" ::: Vector Budget))
-> ContT
("budget" ::: Vector Budget) IO ("budget" ::: Vector Budget)
-> io ("budget" ::: Vector Budget)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT ("budget" ::: Vector Budget) IO ("budget" ::: Vector Budget)
-> IO ("budget" ::: Vector Budget)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT ("budget" ::: Vector Budget) IO ("budget" ::: Vector Budget)
-> io ("budget" ::: Vector Budget))
-> ContT
("budget" ::: Vector Budget) IO ("budget" ::: Vector Budget)
-> io ("budget" ::: Vector Budget)
forall a b. (a -> b) -> a -> b
$ do
Ptr Budget
pPBudget <- ((Ptr Budget -> IO ("budget" ::: Vector Budget))
-> IO ("budget" ::: Vector Budget))
-> ContT ("budget" ::: Vector Budget) IO (Ptr Budget)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Budget -> IO ("budget" ::: Vector Budget))
-> IO ("budget" ::: Vector Budget))
-> ContT ("budget" ::: Vector Budget) IO (Ptr Budget))
-> ((Ptr Budget -> IO ("budget" ::: Vector Budget))
-> IO ("budget" ::: Vector Budget))
-> ContT ("budget" ::: Vector Budget) IO (Ptr Budget)
forall a b. (a -> b) -> a -> b
$ IO (Ptr Budget)
-> (Ptr Budget -> IO ())
-> (Ptr Budget -> IO ("budget" ::: Vector Budget))
-> IO ("budget" ::: Vector Budget)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr Budget)
forall a. Int -> IO (Ptr a)
callocBytes @Budget ((Int
forall a. Integral a => a
MAX_MEMORY_HEAPS) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 32)) Ptr Budget -> IO ()
forall a. Ptr a -> IO ()
free
[()]
_ <- (Int -> ContT ("budget" ::: Vector Budget) IO ())
-> [Int] -> ContT ("budget" ::: Vector Budget) IO [()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\i :: Int
i -> ((() -> IO ("budget" ::: Vector Budget))
-> IO ("budget" ::: Vector Budget))
-> ContT ("budget" ::: Vector Budget) IO ()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((() -> IO ("budget" ::: Vector Budget))
-> IO ("budget" ::: Vector Budget))
-> ContT ("budget" ::: Vector Budget) IO ())
-> ((() -> IO ("budget" ::: Vector Budget))
-> IO ("budget" ::: Vector Budget))
-> ContT ("budget" ::: Vector Budget) IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Budget
-> IO ("budget" ::: Vector Budget)
-> IO ("budget" ::: Vector Budget)
forall a b. ToCStruct a => Ptr a -> IO b -> IO b
pokeZeroCStruct (Ptr Budget
pPBudget Ptr Budget -> Int -> Ptr Budget
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* 32) :: Ptr Budget) (IO ("budget" ::: Vector Budget)
-> IO ("budget" ::: Vector Budget))
-> ((() -> IO ("budget" ::: Vector Budget))
-> IO ("budget" ::: Vector Budget))
-> (() -> IO ("budget" ::: Vector Budget))
-> IO ("budget" ::: Vector Budget)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((() -> IO ("budget" ::: Vector Budget))
-> () -> IO ("budget" ::: Vector Budget)
forall a b. (a -> b) -> a -> b
$ ())) [0..(Int
forall a. Integral a => a
MAX_MEMORY_HEAPS) Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1]
IO () -> ContT ("budget" ::: Vector Budget) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ("budget" ::: Vector Budget) IO ())
-> IO () -> ContT ("budget" ::: Vector Budget) IO ()
forall a b. (a -> b) -> a -> b
$ (Allocator -> Ptr Budget -> IO ()
ffiVmaGetBudget) (Allocator
allocator) ((Ptr Budget
pPBudget))
"budget" ::: Vector Budget
pBudget <- IO ("budget" ::: Vector Budget)
-> ContT
("budget" ::: Vector Budget) IO ("budget" ::: Vector Budget)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("budget" ::: Vector Budget)
-> ContT
("budget" ::: Vector Budget) IO ("budget" ::: Vector Budget))
-> IO ("budget" ::: Vector Budget)
-> ContT
("budget" ::: Vector Budget) IO ("budget" ::: Vector Budget)
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> IO Budget) -> IO ("budget" ::: Vector Budget)
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 Budget -> IO Budget
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Budget (((Ptr Budget
pPBudget) Ptr Budget -> Int -> Ptr Budget
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (32 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Budget)))
("budget" ::: Vector Budget)
-> ContT
("budget" ::: Vector Budget) IO ("budget" ::: Vector Budget)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("budget" ::: Vector Budget)
-> ContT
("budget" ::: Vector Budget) IO ("budget" ::: Vector Budget))
-> ("budget" ::: Vector Budget)
-> ContT
("budget" ::: Vector Budget) IO ("budget" ::: Vector Budget)
forall a b. (a -> b) -> a -> b
$ ("budget" ::: Vector Budget
pBudget)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaBuildStatsString" ffiVmaBuildStatsString
:: Allocator -> Ptr (Ptr CChar) -> Bool32 -> IO ()
buildStatsString :: forall io
. (MonadIO io)
=>
Allocator
->
("detailedMap" ::: Bool)
-> io (("statsString" ::: Ptr CChar))
buildStatsString :: Allocator -> Bool -> io ("statsString" ::: Ptr CChar)
buildStatsString allocator :: Allocator
allocator detailedMap :: Bool
detailedMap = IO ("statsString" ::: Ptr CChar)
-> io ("statsString" ::: Ptr CChar)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ("statsString" ::: Ptr CChar)
-> io ("statsString" ::: Ptr CChar))
-> (ContT
("statsString" ::: Ptr CChar) IO ("statsString" ::: Ptr CChar)
-> IO ("statsString" ::: Ptr CChar))
-> ContT
("statsString" ::: Ptr CChar) IO ("statsString" ::: Ptr CChar)
-> io ("statsString" ::: Ptr CChar)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
("statsString" ::: Ptr CChar) IO ("statsString" ::: Ptr CChar)
-> IO ("statsString" ::: Ptr CChar)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
("statsString" ::: Ptr CChar) IO ("statsString" ::: Ptr CChar)
-> io ("statsString" ::: Ptr CChar))
-> ContT
("statsString" ::: Ptr CChar) IO ("statsString" ::: Ptr CChar)
-> io ("statsString" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ do
Ptr ("statsString" ::: Ptr CChar)
pPpStatsString <- ((Ptr ("statsString" ::: Ptr CChar)
-> IO ("statsString" ::: Ptr CChar))
-> IO ("statsString" ::: Ptr CChar))
-> ContT
("statsString" ::: Ptr CChar)
IO
(Ptr ("statsString" ::: Ptr CChar))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ("statsString" ::: Ptr CChar)
-> IO ("statsString" ::: Ptr CChar))
-> IO ("statsString" ::: Ptr CChar))
-> ContT
("statsString" ::: Ptr CChar)
IO
(Ptr ("statsString" ::: Ptr CChar)))
-> ((Ptr ("statsString" ::: Ptr CChar)
-> IO ("statsString" ::: Ptr CChar))
-> IO ("statsString" ::: Ptr CChar))
-> ContT
("statsString" ::: Ptr CChar)
IO
(Ptr ("statsString" ::: Ptr CChar))
forall a b. (a -> b) -> a -> b
$ IO (Ptr ("statsString" ::: Ptr CChar))
-> (Ptr ("statsString" ::: Ptr CChar) -> IO ())
-> (Ptr ("statsString" ::: Ptr CChar)
-> IO ("statsString" ::: Ptr CChar))
-> IO ("statsString" ::: Ptr CChar)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr ("statsString" ::: Ptr CChar))
forall a. Int -> IO (Ptr a)
callocBytes @(Ptr CChar) 8) Ptr ("statsString" ::: Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
free
IO () -> ContT ("statsString" ::: Ptr CChar) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ("statsString" ::: Ptr CChar) IO ())
-> IO () -> ContT ("statsString" ::: Ptr CChar) IO ()
forall a b. (a -> b) -> a -> b
$ (Allocator -> Ptr ("statsString" ::: Ptr CChar) -> Bool32 -> IO ()
ffiVmaBuildStatsString) (Allocator
allocator) (Ptr ("statsString" ::: Ptr CChar)
pPpStatsString) (Bool -> Bool32
boolToBool32 (Bool
detailedMap))
"statsString" ::: Ptr CChar
ppStatsString <- IO ("statsString" ::: Ptr CChar)
-> ContT
("statsString" ::: Ptr CChar) IO ("statsString" ::: Ptr CChar)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("statsString" ::: Ptr CChar)
-> ContT
("statsString" ::: Ptr CChar) IO ("statsString" ::: Ptr CChar))
-> IO ("statsString" ::: Ptr CChar)
-> ContT
("statsString" ::: Ptr CChar) IO ("statsString" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Ptr ("statsString" ::: Ptr CChar)
-> IO ("statsString" ::: Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr CChar) Ptr ("statsString" ::: Ptr CChar)
pPpStatsString
("statsString" ::: Ptr CChar)
-> ContT
("statsString" ::: Ptr CChar) IO ("statsString" ::: Ptr CChar)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("statsString" ::: Ptr CChar)
-> ContT
("statsString" ::: Ptr CChar) IO ("statsString" ::: Ptr CChar))
-> ("statsString" ::: Ptr CChar)
-> ContT
("statsString" ::: Ptr CChar) IO ("statsString" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ("statsString" ::: Ptr CChar
ppStatsString)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaFreeStatsString" ffiVmaFreeStatsString
:: Allocator -> Ptr CChar -> IO ()
freeStatsString :: forall io
. (MonadIO io)
=>
Allocator
->
("statsString" ::: Ptr CChar)
-> io ()
freeStatsString :: Allocator -> ("statsString" ::: Ptr CChar) -> io ()
freeStatsString allocator :: Allocator
allocator statsString :: "statsString" ::: Ptr CChar
statsString = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
(Allocator -> ("statsString" ::: Ptr CChar) -> IO ()
ffiVmaFreeStatsString) (Allocator
allocator) ("statsString" ::: Ptr CChar
statsString)
() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ ()
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaFindMemoryTypeIndex" ffiVmaFindMemoryTypeIndex
:: Allocator -> Word32 -> Ptr AllocationCreateInfo -> Ptr Word32 -> IO Result
findMemoryTypeIndex :: forall io
. (MonadIO io)
=>
Allocator
->
("memoryTypeBits" ::: Word32)
->
AllocationCreateInfo
-> io (("memoryTypeIndex" ::: Word32))
findMemoryTypeIndex :: Allocator
-> ("memoryTypeIndex" ::: Word32)
-> AllocationCreateInfo
-> io ("memoryTypeIndex" ::: Word32)
findMemoryTypeIndex allocator :: Allocator
allocator memoryTypeBits :: "memoryTypeIndex" ::: Word32
memoryTypeBits allocationCreateInfo :: AllocationCreateInfo
allocationCreateInfo = IO ("memoryTypeIndex" ::: Word32)
-> io ("memoryTypeIndex" ::: Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ("memoryTypeIndex" ::: Word32)
-> io ("memoryTypeIndex" ::: Word32))
-> (ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
-> io ("memoryTypeIndex" ::: Word32)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
-> IO ("memoryTypeIndex" ::: Word32)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
-> io ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
-> io ("memoryTypeIndex" ::: Word32)
forall a b. (a -> b) -> a -> b
$ do
Ptr AllocationCreateInfo
pAllocationCreateInfo <- ((Ptr AllocationCreateInfo -> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32) IO (Ptr AllocationCreateInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr AllocationCreateInfo -> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32) IO (Ptr AllocationCreateInfo))
-> ((Ptr AllocationCreateInfo -> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32) IO (Ptr AllocationCreateInfo)
forall a b. (a -> b) -> a -> b
$ AllocationCreateInfo
-> (Ptr AllocationCreateInfo -> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCreateInfo
allocationCreateInfo)
Ptr ("memoryTypeIndex" ::: Word32)
pPMemoryTypeIndex <- ((Ptr ("memoryTypeIndex" ::: Word32)
-> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32)
IO
(Ptr ("memoryTypeIndex" ::: Word32))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ("memoryTypeIndex" ::: Word32)
-> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32)
IO
(Ptr ("memoryTypeIndex" ::: Word32)))
-> ((Ptr ("memoryTypeIndex" ::: Word32)
-> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32)
IO
(Ptr ("memoryTypeIndex" ::: Word32))
forall a b. (a -> b) -> a -> b
$ IO (Ptr ("memoryTypeIndex" ::: Word32))
-> (Ptr ("memoryTypeIndex" ::: Word32) -> IO ())
-> (Ptr ("memoryTypeIndex" ::: Word32)
-> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr ("memoryTypeIndex" ::: Word32))
forall a. Int -> IO (Ptr a)
callocBytes @Word32 4) Ptr ("memoryTypeIndex" ::: Word32) -> IO ()
forall a. Ptr a -> IO ()
free
Result
r <- IO Result -> ContT ("memoryTypeIndex" ::: Word32) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT ("memoryTypeIndex" ::: Word32) IO Result)
-> IO Result -> ContT ("memoryTypeIndex" ::: Word32) IO Result
forall a b. (a -> b) -> a -> b
$ (Allocator
-> ("memoryTypeIndex" ::: Word32)
-> Ptr AllocationCreateInfo
-> Ptr ("memoryTypeIndex" ::: Word32)
-> IO Result
ffiVmaFindMemoryTypeIndex) (Allocator
allocator) ("memoryTypeIndex" ::: Word32
memoryTypeBits) Ptr AllocationCreateInfo
pAllocationCreateInfo (Ptr ("memoryTypeIndex" ::: Word32)
pPMemoryTypeIndex)
IO () -> ContT ("memoryTypeIndex" ::: Word32) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ("memoryTypeIndex" ::: Word32) IO ())
-> IO () -> ContT ("memoryTypeIndex" ::: Word32) 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))
"memoryTypeIndex" ::: Word32
pMemoryTypeIndex <- IO ("memoryTypeIndex" ::: Word32)
-> ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("memoryTypeIndex" ::: Word32)
-> ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32)
-> ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
forall a b. (a -> b) -> a -> b
$ Ptr ("memoryTypeIndex" ::: Word32)
-> IO ("memoryTypeIndex" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 Ptr ("memoryTypeIndex" ::: Word32)
pPMemoryTypeIndex
("memoryTypeIndex" ::: Word32)
-> ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("memoryTypeIndex" ::: Word32)
-> ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32))
-> ("memoryTypeIndex" ::: Word32)
-> ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
forall a b. (a -> b) -> a -> b
$ ("memoryTypeIndex" ::: Word32
pMemoryTypeIndex)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaFindMemoryTypeIndexForBufferInfo" ffiVmaFindMemoryTypeIndexForBufferInfo
:: Allocator -> Ptr (SomeStruct BufferCreateInfo) -> Ptr AllocationCreateInfo -> Ptr Word32 -> IO Result
findMemoryTypeIndexForBufferInfo :: forall a io
. (Extendss BufferCreateInfo a, PokeChain a, MonadIO io)
=>
Allocator
->
(BufferCreateInfo a)
->
AllocationCreateInfo
-> io (("memoryTypeIndex" ::: Word32))
findMemoryTypeIndexForBufferInfo :: Allocator
-> BufferCreateInfo a
-> AllocationCreateInfo
-> io ("memoryTypeIndex" ::: Word32)
findMemoryTypeIndexForBufferInfo allocator :: Allocator
allocator bufferCreateInfo :: BufferCreateInfo a
bufferCreateInfo allocationCreateInfo :: AllocationCreateInfo
allocationCreateInfo = IO ("memoryTypeIndex" ::: Word32)
-> io ("memoryTypeIndex" ::: Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ("memoryTypeIndex" ::: Word32)
-> io ("memoryTypeIndex" ::: Word32))
-> (ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
-> io ("memoryTypeIndex" ::: Word32)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
-> IO ("memoryTypeIndex" ::: Word32)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
-> io ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
-> io ("memoryTypeIndex" ::: Word32)
forall a b. (a -> b) -> a -> b
$ do
Ptr (BufferCreateInfo a)
pBufferCreateInfo <- ((Ptr (BufferCreateInfo a) -> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32) IO (Ptr (BufferCreateInfo a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (BufferCreateInfo a) -> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32) IO (Ptr (BufferCreateInfo a)))
-> ((Ptr (BufferCreateInfo a) -> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32) IO (Ptr (BufferCreateInfo a))
forall a b. (a -> b) -> a -> b
$ BufferCreateInfo a
-> (Ptr (BufferCreateInfo a) -> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (BufferCreateInfo a
bufferCreateInfo)
Ptr AllocationCreateInfo
pAllocationCreateInfo <- ((Ptr AllocationCreateInfo -> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32) IO (Ptr AllocationCreateInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr AllocationCreateInfo -> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32) IO (Ptr AllocationCreateInfo))
-> ((Ptr AllocationCreateInfo -> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32) IO (Ptr AllocationCreateInfo)
forall a b. (a -> b) -> a -> b
$ AllocationCreateInfo
-> (Ptr AllocationCreateInfo -> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCreateInfo
allocationCreateInfo)
Ptr ("memoryTypeIndex" ::: Word32)
pPMemoryTypeIndex <- ((Ptr ("memoryTypeIndex" ::: Word32)
-> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32)
IO
(Ptr ("memoryTypeIndex" ::: Word32))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ("memoryTypeIndex" ::: Word32)
-> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32)
IO
(Ptr ("memoryTypeIndex" ::: Word32)))
-> ((Ptr ("memoryTypeIndex" ::: Word32)
-> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32)
IO
(Ptr ("memoryTypeIndex" ::: Word32))
forall a b. (a -> b) -> a -> b
$ IO (Ptr ("memoryTypeIndex" ::: Word32))
-> (Ptr ("memoryTypeIndex" ::: Word32) -> IO ())
-> (Ptr ("memoryTypeIndex" ::: Word32)
-> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr ("memoryTypeIndex" ::: Word32))
forall a. Int -> IO (Ptr a)
callocBytes @Word32 4) Ptr ("memoryTypeIndex" ::: Word32) -> IO ()
forall a. Ptr a -> IO ()
free
Result
r <- IO Result -> ContT ("memoryTypeIndex" ::: Word32) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT ("memoryTypeIndex" ::: Word32) IO Result)
-> IO Result -> ContT ("memoryTypeIndex" ::: Word32) IO Result
forall a b. (a -> b) -> a -> b
$ (Allocator
-> Ptr (SomeStruct BufferCreateInfo)
-> Ptr AllocationCreateInfo
-> Ptr ("memoryTypeIndex" ::: Word32)
-> IO Result
ffiVmaFindMemoryTypeIndexForBufferInfo) (Allocator
allocator) (Ptr (BufferCreateInfo a) -> Ptr (SomeStruct BufferCreateInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (BufferCreateInfo a)
pBufferCreateInfo) Ptr AllocationCreateInfo
pAllocationCreateInfo (Ptr ("memoryTypeIndex" ::: Word32)
pPMemoryTypeIndex)
IO () -> ContT ("memoryTypeIndex" ::: Word32) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ("memoryTypeIndex" ::: Word32) IO ())
-> IO () -> ContT ("memoryTypeIndex" ::: Word32) 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))
"memoryTypeIndex" ::: Word32
pMemoryTypeIndex <- IO ("memoryTypeIndex" ::: Word32)
-> ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("memoryTypeIndex" ::: Word32)
-> ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32)
-> ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
forall a b. (a -> b) -> a -> b
$ Ptr ("memoryTypeIndex" ::: Word32)
-> IO ("memoryTypeIndex" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 Ptr ("memoryTypeIndex" ::: Word32)
pPMemoryTypeIndex
("memoryTypeIndex" ::: Word32)
-> ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("memoryTypeIndex" ::: Word32)
-> ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32))
-> ("memoryTypeIndex" ::: Word32)
-> ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
forall a b. (a -> b) -> a -> b
$ ("memoryTypeIndex" ::: Word32
pMemoryTypeIndex)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaFindMemoryTypeIndexForImageInfo" ffiVmaFindMemoryTypeIndexForImageInfo
:: Allocator -> Ptr (SomeStruct ImageCreateInfo) -> Ptr AllocationCreateInfo -> Ptr Word32 -> IO Result
findMemoryTypeIndexForImageInfo :: forall a io
. (Extendss ImageCreateInfo a, PokeChain a, MonadIO io)
=>
Allocator
->
(ImageCreateInfo a)
->
AllocationCreateInfo
-> io (("memoryTypeIndex" ::: Word32))
findMemoryTypeIndexForImageInfo :: Allocator
-> ImageCreateInfo a
-> AllocationCreateInfo
-> io ("memoryTypeIndex" ::: Word32)
findMemoryTypeIndexForImageInfo allocator :: Allocator
allocator imageCreateInfo :: ImageCreateInfo a
imageCreateInfo allocationCreateInfo :: AllocationCreateInfo
allocationCreateInfo = IO ("memoryTypeIndex" ::: Word32)
-> io ("memoryTypeIndex" ::: Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ("memoryTypeIndex" ::: Word32)
-> io ("memoryTypeIndex" ::: Word32))
-> (ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
-> io ("memoryTypeIndex" ::: Word32)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
-> IO ("memoryTypeIndex" ::: Word32)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
-> io ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
-> io ("memoryTypeIndex" ::: Word32)
forall a b. (a -> b) -> a -> b
$ do
Ptr (ImageCreateInfo a)
pImageCreateInfo <- ((Ptr (ImageCreateInfo a) -> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32) IO (Ptr (ImageCreateInfo a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (ImageCreateInfo a) -> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32) IO (Ptr (ImageCreateInfo a)))
-> ((Ptr (ImageCreateInfo a) -> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32) IO (Ptr (ImageCreateInfo a))
forall a b. (a -> b) -> a -> b
$ ImageCreateInfo a
-> (Ptr (ImageCreateInfo a) -> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (ImageCreateInfo a
imageCreateInfo)
Ptr AllocationCreateInfo
pAllocationCreateInfo <- ((Ptr AllocationCreateInfo -> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32) IO (Ptr AllocationCreateInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr AllocationCreateInfo -> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32) IO (Ptr AllocationCreateInfo))
-> ((Ptr AllocationCreateInfo -> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32) IO (Ptr AllocationCreateInfo)
forall a b. (a -> b) -> a -> b
$ AllocationCreateInfo
-> (Ptr AllocationCreateInfo -> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCreateInfo
allocationCreateInfo)
Ptr ("memoryTypeIndex" ::: Word32)
pPMemoryTypeIndex <- ((Ptr ("memoryTypeIndex" ::: Word32)
-> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32)
IO
(Ptr ("memoryTypeIndex" ::: Word32))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ("memoryTypeIndex" ::: Word32)
-> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32)
IO
(Ptr ("memoryTypeIndex" ::: Word32)))
-> ((Ptr ("memoryTypeIndex" ::: Word32)
-> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32))
-> ContT
("memoryTypeIndex" ::: Word32)
IO
(Ptr ("memoryTypeIndex" ::: Word32))
forall a b. (a -> b) -> a -> b
$ IO (Ptr ("memoryTypeIndex" ::: Word32))
-> (Ptr ("memoryTypeIndex" ::: Word32) -> IO ())
-> (Ptr ("memoryTypeIndex" ::: Word32)
-> IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr ("memoryTypeIndex" ::: Word32))
forall a. Int -> IO (Ptr a)
callocBytes @Word32 4) Ptr ("memoryTypeIndex" ::: Word32) -> IO ()
forall a. Ptr a -> IO ()
free
Result
r <- IO Result -> ContT ("memoryTypeIndex" ::: Word32) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT ("memoryTypeIndex" ::: Word32) IO Result)
-> IO Result -> ContT ("memoryTypeIndex" ::: Word32) IO Result
forall a b. (a -> b) -> a -> b
$ (Allocator
-> Ptr (SomeStruct ImageCreateInfo)
-> Ptr AllocationCreateInfo
-> Ptr ("memoryTypeIndex" ::: Word32)
-> IO Result
ffiVmaFindMemoryTypeIndexForImageInfo) (Allocator
allocator) (Ptr (ImageCreateInfo a) -> Ptr (SomeStruct ImageCreateInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (ImageCreateInfo a)
pImageCreateInfo) Ptr AllocationCreateInfo
pAllocationCreateInfo (Ptr ("memoryTypeIndex" ::: Word32)
pPMemoryTypeIndex)
IO () -> ContT ("memoryTypeIndex" ::: Word32) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ("memoryTypeIndex" ::: Word32) IO ())
-> IO () -> ContT ("memoryTypeIndex" ::: Word32) 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))
"memoryTypeIndex" ::: Word32
pMemoryTypeIndex <- IO ("memoryTypeIndex" ::: Word32)
-> ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("memoryTypeIndex" ::: Word32)
-> ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32))
-> IO ("memoryTypeIndex" ::: Word32)
-> ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
forall a b. (a -> b) -> a -> b
$ Ptr ("memoryTypeIndex" ::: Word32)
-> IO ("memoryTypeIndex" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 Ptr ("memoryTypeIndex" ::: Word32)
pPMemoryTypeIndex
("memoryTypeIndex" ::: Word32)
-> ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("memoryTypeIndex" ::: Word32)
-> ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32))
-> ("memoryTypeIndex" ::: Word32)
-> ContT
("memoryTypeIndex" ::: Word32) IO ("memoryTypeIndex" ::: Word32)
forall a b. (a -> b) -> a -> b
$ ("memoryTypeIndex" ::: Word32
pMemoryTypeIndex)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaCreatePool" ffiVmaCreatePool
:: Allocator -> Ptr PoolCreateInfo -> Ptr Pool -> IO Result
createPool :: forall io
. (MonadIO io)
=>
Allocator
->
PoolCreateInfo
-> io (Pool)
createPool :: Allocator -> PoolCreateInfo -> io Pool
createPool allocator :: Allocator
allocator createInfo :: PoolCreateInfo
createInfo = IO Pool -> io Pool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Pool -> io Pool)
-> (ContT Pool IO Pool -> IO Pool) -> ContT Pool IO Pool -> io Pool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Pool IO Pool -> IO Pool
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Pool IO Pool -> io Pool) -> ContT Pool IO Pool -> io Pool
forall a b. (a -> b) -> a -> b
$ do
Ptr PoolCreateInfo
pCreateInfo <- ((Ptr PoolCreateInfo -> IO Pool) -> IO Pool)
-> ContT Pool IO (Ptr PoolCreateInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr PoolCreateInfo -> IO Pool) -> IO Pool)
-> ContT Pool IO (Ptr PoolCreateInfo))
-> ((Ptr PoolCreateInfo -> IO Pool) -> IO Pool)
-> ContT Pool IO (Ptr PoolCreateInfo)
forall a b. (a -> b) -> a -> b
$ PoolCreateInfo -> (Ptr PoolCreateInfo -> IO Pool) -> IO Pool
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (PoolCreateInfo
createInfo)
Ptr Pool
pPPool <- ((Ptr Pool -> IO Pool) -> IO Pool) -> ContT Pool IO (Ptr Pool)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Pool -> IO Pool) -> IO Pool) -> ContT Pool IO (Ptr Pool))
-> ((Ptr Pool -> IO Pool) -> IO Pool) -> ContT Pool IO (Ptr Pool)
forall a b. (a -> b) -> a -> b
$ IO (Ptr Pool)
-> (Ptr Pool -> IO ()) -> (Ptr Pool -> IO Pool) -> IO Pool
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr Pool)
forall a. Int -> IO (Ptr a)
callocBytes @Pool 8) Ptr Pool -> IO ()
forall a. Ptr a -> IO ()
free
Result
r <- IO Result -> ContT Pool IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT Pool IO Result)
-> IO Result -> ContT Pool IO Result
forall a b. (a -> b) -> a -> b
$ (Allocator -> Ptr PoolCreateInfo -> Ptr Pool -> IO Result
ffiVmaCreatePool) (Allocator
allocator) Ptr PoolCreateInfo
pCreateInfo (Ptr Pool
pPPool)
IO () -> ContT Pool IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Pool IO ()) -> IO () -> ContT Pool 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))
Pool
pPool <- IO Pool -> ContT Pool IO Pool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Pool -> ContT Pool IO Pool) -> IO Pool -> ContT Pool IO Pool
forall a b. (a -> b) -> a -> b
$ Ptr Pool -> IO Pool
forall a. Storable a => Ptr a -> IO a
peek @Pool Ptr Pool
pPPool
Pool -> ContT Pool IO Pool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pool -> ContT Pool IO Pool) -> Pool -> ContT Pool IO Pool
forall a b. (a -> b) -> a -> b
$ (Pool
pPool)
withPool :: forall io r . MonadIO io => Allocator -> PoolCreateInfo -> (io (Pool) -> ((Pool) -> io ()) -> r) -> r
withPool :: Allocator
-> PoolCreateInfo -> (io Pool -> (Pool -> io ()) -> r) -> r
withPool allocator :: Allocator
allocator pCreateInfo :: PoolCreateInfo
pCreateInfo b :: io Pool -> (Pool -> io ()) -> r
b =
io Pool -> (Pool -> io ()) -> r
b (Allocator -> PoolCreateInfo -> io Pool
forall (io :: * -> *).
MonadIO io =>
Allocator -> PoolCreateInfo -> io Pool
createPool Allocator
allocator PoolCreateInfo
pCreateInfo)
(\(Pool
o0) -> Allocator -> Pool -> io ()
forall (io :: * -> *). MonadIO io => Allocator -> Pool -> io ()
destroyPool Allocator
allocator Pool
o0)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaDestroyPool" ffiVmaDestroyPool
:: Allocator -> Pool -> IO ()
destroyPool :: forall io
. (MonadIO io)
=>
Allocator
->
Pool
-> io ()
destroyPool :: Allocator -> Pool -> io ()
destroyPool allocator :: Allocator
allocator pool :: Pool
pool = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
(Allocator -> Pool -> IO ()
ffiVmaDestroyPool) (Allocator
allocator) (Pool
pool)
() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ ()
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaGetPoolStats" ffiVmaGetPoolStats
:: Allocator -> Pool -> Ptr PoolStats -> IO ()
getPoolStats :: forall io
. (MonadIO io)
=>
Allocator
->
Pool
-> io (PoolStats)
getPoolStats :: Allocator -> Pool -> io PoolStats
getPoolStats allocator :: Allocator
allocator pool :: Pool
pool = IO PoolStats -> io PoolStats
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PoolStats -> io PoolStats)
-> (ContT PoolStats IO PoolStats -> IO PoolStats)
-> ContT PoolStats IO PoolStats
-> io PoolStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT PoolStats IO PoolStats -> IO PoolStats
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT PoolStats IO PoolStats -> io PoolStats)
-> ContT PoolStats IO PoolStats -> io PoolStats
forall a b. (a -> b) -> a -> b
$ do
Ptr PoolStats
pPPoolStats <- ((Ptr PoolStats -> IO PoolStats) -> IO PoolStats)
-> ContT PoolStats IO (Ptr PoolStats)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b. ToCStruct PoolStats => (Ptr PoolStats -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @PoolStats)
IO () -> ContT PoolStats IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT PoolStats IO ()) -> IO () -> ContT PoolStats IO ()
forall a b. (a -> b) -> a -> b
$ (Allocator -> Pool -> Ptr PoolStats -> IO ()
ffiVmaGetPoolStats) (Allocator
allocator) (Pool
pool) (Ptr PoolStats
pPPoolStats)
PoolStats
pPoolStats <- IO PoolStats -> ContT PoolStats IO PoolStats
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO PoolStats -> ContT PoolStats IO PoolStats)
-> IO PoolStats -> ContT PoolStats IO PoolStats
forall a b. (a -> b) -> a -> b
$ Ptr PoolStats -> IO PoolStats
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @PoolStats Ptr PoolStats
pPPoolStats
PoolStats -> ContT PoolStats IO PoolStats
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PoolStats -> ContT PoolStats IO PoolStats)
-> PoolStats -> ContT PoolStats IO PoolStats
forall a b. (a -> b) -> a -> b
$ (PoolStats
pPoolStats)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaMakePoolAllocationsLost" ffiVmaMakePoolAllocationsLost
:: Allocator -> Pool -> Ptr CSize -> IO ()
makePoolAllocationsLost :: forall io
. (MonadIO io)
=>
Allocator
->
Pool
-> io (("lostAllocationCount" ::: Word64))
makePoolAllocationsLost :: Allocator -> Pool -> io ("lostAllocationCount" ::: Word64)
makePoolAllocationsLost allocator :: Allocator
allocator pool :: Pool
pool = IO ("lostAllocationCount" ::: Word64)
-> io ("lostAllocationCount" ::: Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ("lostAllocationCount" ::: Word64)
-> io ("lostAllocationCount" ::: Word64))
-> (ContT
("lostAllocationCount" ::: Word64)
IO
("lostAllocationCount" ::: Word64)
-> IO ("lostAllocationCount" ::: Word64))
-> ContT
("lostAllocationCount" ::: Word64)
IO
("lostAllocationCount" ::: Word64)
-> io ("lostAllocationCount" ::: Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
("lostAllocationCount" ::: Word64)
IO
("lostAllocationCount" ::: Word64)
-> IO ("lostAllocationCount" ::: Word64)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
("lostAllocationCount" ::: Word64)
IO
("lostAllocationCount" ::: Word64)
-> io ("lostAllocationCount" ::: Word64))
-> ContT
("lostAllocationCount" ::: Word64)
IO
("lostAllocationCount" ::: Word64)
-> io ("lostAllocationCount" ::: Word64)
forall a b. (a -> b) -> a -> b
$ do
Ptr CSize
pPLostAllocationCount <- ((Ptr CSize -> IO ("lostAllocationCount" ::: Word64))
-> IO ("lostAllocationCount" ::: Word64))
-> ContT ("lostAllocationCount" ::: Word64) IO (Ptr CSize)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr CSize -> IO ("lostAllocationCount" ::: Word64))
-> IO ("lostAllocationCount" ::: Word64))
-> ContT ("lostAllocationCount" ::: Word64) IO (Ptr CSize))
-> ((Ptr CSize -> IO ("lostAllocationCount" ::: Word64))
-> IO ("lostAllocationCount" ::: Word64))
-> ContT ("lostAllocationCount" ::: Word64) IO (Ptr CSize)
forall a b. (a -> b) -> a -> b
$ IO (Ptr CSize)
-> (Ptr CSize -> IO ())
-> (Ptr CSize -> IO ("lostAllocationCount" ::: Word64))
-> IO ("lostAllocationCount" ::: Word64)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr CSize)
forall a. Int -> IO (Ptr a)
callocBytes @CSize 8) Ptr CSize -> IO ()
forall a. Ptr a -> IO ()
free
IO () -> ContT ("lostAllocationCount" ::: Word64) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ("lostAllocationCount" ::: Word64) IO ())
-> IO () -> ContT ("lostAllocationCount" ::: Word64) IO ()
forall a b. (a -> b) -> a -> b
$ (Allocator -> Pool -> Ptr CSize -> IO ()
ffiVmaMakePoolAllocationsLost) (Allocator
allocator) (Pool
pool) (Ptr CSize
pPLostAllocationCount)
CSize
pLostAllocationCount <- IO CSize -> ContT ("lostAllocationCount" ::: Word64) IO CSize
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO CSize -> ContT ("lostAllocationCount" ::: Word64) IO CSize)
-> IO CSize -> ContT ("lostAllocationCount" ::: Word64) IO CSize
forall a b. (a -> b) -> a -> b
$ Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek @CSize Ptr CSize
pPLostAllocationCount
("lostAllocationCount" ::: Word64)
-> ContT
("lostAllocationCount" ::: Word64)
IO
("lostAllocationCount" ::: Word64)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("lostAllocationCount" ::: Word64)
-> ContT
("lostAllocationCount" ::: Word64)
IO
("lostAllocationCount" ::: Word64))
-> ("lostAllocationCount" ::: Word64)
-> ContT
("lostAllocationCount" ::: Word64)
IO
("lostAllocationCount" ::: Word64)
forall a b. (a -> b) -> a -> b
$ (((\(CSize a :: "lostAllocationCount" ::: Word64
a) -> "lostAllocationCount" ::: Word64
a) CSize
pLostAllocationCount))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaCheckPoolCorruption" ffiVmaCheckPoolCorruption
:: Allocator -> Pool -> IO Result
checkPoolCorruption :: forall io
. (MonadIO io)
=>
Allocator
->
Pool
-> io ()
checkPoolCorruption :: Allocator -> Pool -> io ()
checkPoolCorruption allocator :: Allocator
allocator pool :: Pool
pool = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
Result
r <- (Allocator -> Pool -> IO Result
ffiVmaCheckPoolCorruption) (Allocator
allocator) (Pool
pool)
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))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaGetPoolName" ffiVmaGetPoolName
:: Allocator -> Pool -> Ptr (Ptr CChar) -> IO ()
getPoolName :: forall io
. (MonadIO io)
=>
Allocator
->
Pool
-> io (("name" ::: Ptr CChar))
getPoolName :: Allocator -> Pool -> io ("statsString" ::: Ptr CChar)
getPoolName allocator :: Allocator
allocator pool :: Pool
pool = IO ("statsString" ::: Ptr CChar)
-> io ("statsString" ::: Ptr CChar)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ("statsString" ::: Ptr CChar)
-> io ("statsString" ::: Ptr CChar))
-> (ContT
("statsString" ::: Ptr CChar) IO ("statsString" ::: Ptr CChar)
-> IO ("statsString" ::: Ptr CChar))
-> ContT
("statsString" ::: Ptr CChar) IO ("statsString" ::: Ptr CChar)
-> io ("statsString" ::: Ptr CChar)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
("statsString" ::: Ptr CChar) IO ("statsString" ::: Ptr CChar)
-> IO ("statsString" ::: Ptr CChar)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
("statsString" ::: Ptr CChar) IO ("statsString" ::: Ptr CChar)
-> io ("statsString" ::: Ptr CChar))
-> ContT
("statsString" ::: Ptr CChar) IO ("statsString" ::: Ptr CChar)
-> io ("statsString" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ do
Ptr ("statsString" ::: Ptr CChar)
pPpName <- ((Ptr ("statsString" ::: Ptr CChar)
-> IO ("statsString" ::: Ptr CChar))
-> IO ("statsString" ::: Ptr CChar))
-> ContT
("statsString" ::: Ptr CChar)
IO
(Ptr ("statsString" ::: Ptr CChar))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ("statsString" ::: Ptr CChar)
-> IO ("statsString" ::: Ptr CChar))
-> IO ("statsString" ::: Ptr CChar))
-> ContT
("statsString" ::: Ptr CChar)
IO
(Ptr ("statsString" ::: Ptr CChar)))
-> ((Ptr ("statsString" ::: Ptr CChar)
-> IO ("statsString" ::: Ptr CChar))
-> IO ("statsString" ::: Ptr CChar))
-> ContT
("statsString" ::: Ptr CChar)
IO
(Ptr ("statsString" ::: Ptr CChar))
forall a b. (a -> b) -> a -> b
$ IO (Ptr ("statsString" ::: Ptr CChar))
-> (Ptr ("statsString" ::: Ptr CChar) -> IO ())
-> (Ptr ("statsString" ::: Ptr CChar)
-> IO ("statsString" ::: Ptr CChar))
-> IO ("statsString" ::: Ptr CChar)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr ("statsString" ::: Ptr CChar))
forall a. Int -> IO (Ptr a)
callocBytes @(Ptr CChar) 8) Ptr ("statsString" ::: Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
free
IO () -> ContT ("statsString" ::: Ptr CChar) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ("statsString" ::: Ptr CChar) IO ())
-> IO () -> ContT ("statsString" ::: Ptr CChar) IO ()
forall a b. (a -> b) -> a -> b
$ (Allocator -> Pool -> Ptr ("statsString" ::: Ptr CChar) -> IO ()
ffiVmaGetPoolName) (Allocator
allocator) (Pool
pool) (Ptr ("statsString" ::: Ptr CChar)
pPpName)
"statsString" ::: Ptr CChar
ppName <- IO ("statsString" ::: Ptr CChar)
-> ContT
("statsString" ::: Ptr CChar) IO ("statsString" ::: Ptr CChar)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("statsString" ::: Ptr CChar)
-> ContT
("statsString" ::: Ptr CChar) IO ("statsString" ::: Ptr CChar))
-> IO ("statsString" ::: Ptr CChar)
-> ContT
("statsString" ::: Ptr CChar) IO ("statsString" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Ptr ("statsString" ::: Ptr CChar)
-> IO ("statsString" ::: Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr CChar) Ptr ("statsString" ::: Ptr CChar)
pPpName
("statsString" ::: Ptr CChar)
-> ContT
("statsString" ::: Ptr CChar) IO ("statsString" ::: Ptr CChar)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("statsString" ::: Ptr CChar)
-> ContT
("statsString" ::: Ptr CChar) IO ("statsString" ::: Ptr CChar))
-> ("statsString" ::: Ptr CChar)
-> ContT
("statsString" ::: Ptr CChar) IO ("statsString" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ("statsString" ::: Ptr CChar
ppName)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaSetPoolName" ffiVmaSetPoolName
:: Allocator -> Pool -> Ptr CChar -> IO ()
setPoolName :: forall io
. (MonadIO io)
=>
Allocator
->
Pool
->
("name" ::: Maybe ByteString)
-> io ()
setPoolName :: Allocator -> Pool -> ("name" ::: Maybe ByteString) -> io ()
setPoolName allocator :: Allocator
allocator pool :: Pool
pool name :: "name" ::: Maybe ByteString
name = 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
"statsString" ::: Ptr CChar
pName <- case ("name" ::: Maybe ByteString
name) of
Nothing -> ("statsString" ::: Ptr CChar)
-> ContT () IO ("statsString" ::: Ptr CChar)
forall (f :: * -> *) a. Applicative f => a -> f a
pure "statsString" ::: Ptr CChar
forall a. Ptr a
nullPtr
Just j :: ByteString
j -> ((("statsString" ::: Ptr CChar) -> IO ()) -> IO ())
-> ContT () IO ("statsString" ::: Ptr CChar)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("statsString" ::: Ptr CChar) -> IO ()) -> IO ())
-> ContT () IO ("statsString" ::: Ptr CChar))
-> ((("statsString" ::: Ptr CChar) -> IO ()) -> IO ())
-> ContT () IO ("statsString" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ByteString -> (("statsString" ::: Ptr CChar) -> IO ()) -> IO ()
forall a.
ByteString -> (("statsString" ::: Ptr CChar) -> IO a) -> IO a
useAsCString (ByteString
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
$ (Allocator -> Pool -> ("statsString" ::: Ptr CChar) -> IO ()
ffiVmaSetPoolName) (Allocator
allocator) (Pool
pool) "statsString" ::: Ptr CChar
pName
() -> 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
"vmaAllocateMemory" ffiVmaAllocateMemory
:: Allocator -> Ptr MemoryRequirements -> Ptr AllocationCreateInfo -> Ptr Allocation -> Ptr AllocationInfo -> IO Result
allocateMemory :: forall io
. (MonadIO io)
=>
Allocator
->
("vkMemoryRequirements" ::: MemoryRequirements)
->
AllocationCreateInfo
-> io (Allocation, AllocationInfo)
allocateMemory :: Allocator
-> ("vkMemoryRequirements" ::: MemoryRequirements)
-> AllocationCreateInfo
-> io (Allocation, AllocationInfo)
allocateMemory allocator :: Allocator
allocator vkMemoryRequirements :: "vkMemoryRequirements" ::: MemoryRequirements
vkMemoryRequirements createInfo :: AllocationCreateInfo
createInfo = IO (Allocation, AllocationInfo) -> io (Allocation, AllocationInfo)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Allocation, AllocationInfo)
-> io (Allocation, AllocationInfo))
-> (ContT
(Allocation, AllocationInfo) IO (Allocation, AllocationInfo)
-> IO (Allocation, AllocationInfo))
-> ContT
(Allocation, AllocationInfo) IO (Allocation, AllocationInfo)
-> io (Allocation, AllocationInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT (Allocation, AllocationInfo) IO (Allocation, AllocationInfo)
-> IO (Allocation, AllocationInfo)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT (Allocation, AllocationInfo) IO (Allocation, AllocationInfo)
-> io (Allocation, AllocationInfo))
-> ContT
(Allocation, AllocationInfo) IO (Allocation, AllocationInfo)
-> io (Allocation, AllocationInfo)
forall a b. (a -> b) -> a -> b
$ do
Ptr ("vkMemoryRequirements" ::: MemoryRequirements)
pVkMemoryRequirements <- ((Ptr ("vkMemoryRequirements" ::: MemoryRequirements)
-> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo))
-> ContT
(Allocation, AllocationInfo)
IO
(Ptr ("vkMemoryRequirements" ::: MemoryRequirements))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ("vkMemoryRequirements" ::: MemoryRequirements)
-> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo))
-> ContT
(Allocation, AllocationInfo)
IO
(Ptr ("vkMemoryRequirements" ::: MemoryRequirements)))
-> ((Ptr ("vkMemoryRequirements" ::: MemoryRequirements)
-> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo))
-> ContT
(Allocation, AllocationInfo)
IO
(Ptr ("vkMemoryRequirements" ::: MemoryRequirements))
forall a b. (a -> b) -> a -> b
$ ("vkMemoryRequirements" ::: MemoryRequirements)
-> (Ptr ("vkMemoryRequirements" ::: MemoryRequirements)
-> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct ("vkMemoryRequirements" ::: MemoryRequirements
vkMemoryRequirements)
Ptr AllocationCreateInfo
pCreateInfo <- ((Ptr AllocationCreateInfo -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo))
-> ContT (Allocation, AllocationInfo) IO (Ptr AllocationCreateInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr AllocationCreateInfo -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo))
-> ContT
(Allocation, AllocationInfo) IO (Ptr AllocationCreateInfo))
-> ((Ptr AllocationCreateInfo -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo))
-> ContT (Allocation, AllocationInfo) IO (Ptr AllocationCreateInfo)
forall a b. (a -> b) -> a -> b
$ AllocationCreateInfo
-> (Ptr AllocationCreateInfo -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCreateInfo
createInfo)
Ptr Allocation
pPAllocation <- ((Ptr Allocation -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo))
-> ContT (Allocation, AllocationInfo) IO (Ptr Allocation)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Allocation -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo))
-> ContT (Allocation, AllocationInfo) IO (Ptr Allocation))
-> ((Ptr Allocation -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo))
-> ContT (Allocation, AllocationInfo) IO (Ptr Allocation)
forall a b. (a -> b) -> a -> b
$ IO (Ptr Allocation)
-> (Ptr Allocation -> IO ())
-> (Ptr Allocation -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr Allocation)
forall a. Int -> IO (Ptr a)
callocBytes @Allocation 8) Ptr Allocation -> IO ()
forall a. Ptr a -> IO ()
free
Ptr AllocationInfo
pPAllocationInfo <- ((Ptr AllocationInfo -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo))
-> ContT (Allocation, AllocationInfo) IO (Ptr AllocationInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct AllocationInfo =>
(Ptr AllocationInfo -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @AllocationInfo)
Result
r <- IO Result -> ContT (Allocation, AllocationInfo) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT (Allocation, AllocationInfo) IO Result)
-> IO Result -> ContT (Allocation, AllocationInfo) IO Result
forall a b. (a -> b) -> a -> b
$ (Allocator
-> Ptr ("vkMemoryRequirements" ::: MemoryRequirements)
-> Ptr AllocationCreateInfo
-> Ptr Allocation
-> Ptr AllocationInfo
-> IO Result
ffiVmaAllocateMemory) (Allocator
allocator) Ptr ("vkMemoryRequirements" ::: MemoryRequirements)
pVkMemoryRequirements Ptr AllocationCreateInfo
pCreateInfo (Ptr Allocation
pPAllocation) (Ptr AllocationInfo
pPAllocationInfo)
IO () -> ContT (Allocation, AllocationInfo) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Allocation, AllocationInfo) IO ())
-> IO () -> ContT (Allocation, AllocationInfo) 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))
Allocation
pAllocation <- IO Allocation -> ContT (Allocation, AllocationInfo) IO Allocation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Allocation -> ContT (Allocation, AllocationInfo) IO Allocation)
-> IO Allocation
-> ContT (Allocation, AllocationInfo) IO Allocation
forall a b. (a -> b) -> a -> b
$ Ptr Allocation -> IO Allocation
forall a. Storable a => Ptr a -> IO a
peek @Allocation Ptr Allocation
pPAllocation
AllocationInfo
pAllocationInfo <- IO AllocationInfo
-> ContT (Allocation, AllocationInfo) IO AllocationInfo
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO AllocationInfo
-> ContT (Allocation, AllocationInfo) IO AllocationInfo)
-> IO AllocationInfo
-> ContT (Allocation, AllocationInfo) IO AllocationInfo
forall a b. (a -> b) -> a -> b
$ Ptr AllocationInfo -> IO AllocationInfo
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @AllocationInfo Ptr AllocationInfo
pPAllocationInfo
(Allocation, AllocationInfo)
-> ContT
(Allocation, AllocationInfo) IO (Allocation, AllocationInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Allocation, AllocationInfo)
-> ContT
(Allocation, AllocationInfo) IO (Allocation, AllocationInfo))
-> (Allocation, AllocationInfo)
-> ContT
(Allocation, AllocationInfo) IO (Allocation, AllocationInfo)
forall a b. (a -> b) -> a -> b
$ (Allocation
pAllocation, AllocationInfo
pAllocationInfo)
withMemory :: forall io r . MonadIO io => Allocator -> MemoryRequirements -> AllocationCreateInfo -> (io (Allocation, AllocationInfo) -> ((Allocation, AllocationInfo) -> io ()) -> r) -> r
withMemory :: Allocator
-> ("vkMemoryRequirements" ::: MemoryRequirements)
-> AllocationCreateInfo
-> (io (Allocation, AllocationInfo)
-> ((Allocation, AllocationInfo) -> io ()) -> r)
-> r
withMemory allocator :: Allocator
allocator pVkMemoryRequirements :: "vkMemoryRequirements" ::: MemoryRequirements
pVkMemoryRequirements pCreateInfo :: AllocationCreateInfo
pCreateInfo b :: io (Allocation, AllocationInfo)
-> ((Allocation, AllocationInfo) -> io ()) -> r
b =
io (Allocation, AllocationInfo)
-> ((Allocation, AllocationInfo) -> io ()) -> r
b (Allocator
-> ("vkMemoryRequirements" ::: MemoryRequirements)
-> AllocationCreateInfo
-> io (Allocation, AllocationInfo)
forall (io :: * -> *).
MonadIO io =>
Allocator
-> ("vkMemoryRequirements" ::: MemoryRequirements)
-> AllocationCreateInfo
-> io (Allocation, AllocationInfo)
allocateMemory Allocator
allocator "vkMemoryRequirements" ::: MemoryRequirements
pVkMemoryRequirements AllocationCreateInfo
pCreateInfo)
(\(o0 :: Allocation
o0, _) -> Allocator -> Allocation -> io ()
forall (io :: * -> *).
MonadIO io =>
Allocator -> Allocation -> io ()
freeMemory Allocator
allocator Allocation
o0)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaAllocateMemoryPages" ffiVmaAllocateMemoryPages
:: Allocator -> Ptr MemoryRequirements -> Ptr AllocationCreateInfo -> CSize -> Ptr Allocation -> Ptr AllocationInfo -> IO Result
allocateMemoryPages :: forall io
. (MonadIO io)
=>
Allocator
->
("vkMemoryRequirements" ::: Vector MemoryRequirements)
->
("createInfo" ::: Vector AllocationCreateInfo)
-> io (("allocations" ::: Vector Allocation), ("allocationInfo" ::: Vector AllocationInfo))
allocateMemoryPages :: Allocator
-> ("vkMemoryRequirements"
::: Vector ("vkMemoryRequirements" ::: MemoryRequirements))
-> ("createInfo" ::: Vector AllocationCreateInfo)
-> io
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
allocateMemoryPages allocator :: Allocator
allocator vkMemoryRequirements :: "vkMemoryRequirements"
::: Vector ("vkMemoryRequirements" ::: MemoryRequirements)
vkMemoryRequirements createInfo :: "createInfo" ::: Vector AllocationCreateInfo
createInfo = IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
-> io
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
-> io
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> (ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
-> io
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
-> io
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
-> io
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
forall a b. (a -> b) -> a -> b
$ do
Ptr ("vkMemoryRequirements" ::: MemoryRequirements)
pPVkMemoryRequirements <- ((Ptr ("vkMemoryRequirements" ::: MemoryRequirements)
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
(Ptr ("vkMemoryRequirements" ::: MemoryRequirements))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ("vkMemoryRequirements" ::: MemoryRequirements)
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
(Ptr ("vkMemoryRequirements" ::: MemoryRequirements)))
-> ((Ptr ("vkMemoryRequirements" ::: MemoryRequirements)
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
(Ptr ("vkMemoryRequirements" ::: MemoryRequirements))
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> (Ptr ("vkMemoryRequirements" ::: MemoryRequirements)
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @MemoryRequirements ((("vkMemoryRequirements"
::: Vector ("vkMemoryRequirements" ::: MemoryRequirements))
-> Int
forall a. Vector a -> Int
Data.Vector.length ("vkMemoryRequirements"
::: Vector ("vkMemoryRequirements" ::: MemoryRequirements)
vkMemoryRequirements)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 24) 8
(Int
-> ("vkMemoryRequirements" ::: MemoryRequirements)
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
())
-> ("vkMemoryRequirements"
::: Vector ("vkMemoryRequirements" ::: MemoryRequirements))
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: "vkMemoryRequirements" ::: MemoryRequirements
e -> ((()
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((()
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
())
-> ((()
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
()
forall a b. (a -> b) -> a -> b
$ Ptr ("vkMemoryRequirements" ::: MemoryRequirements)
-> ("vkMemoryRequirements" ::: MemoryRequirements)
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (Ptr ("vkMemoryRequirements" ::: MemoryRequirements)
pPVkMemoryRequirements Ptr ("vkMemoryRequirements" ::: MemoryRequirements)
-> Int -> Ptr ("vkMemoryRequirements" ::: MemoryRequirements)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (24 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr MemoryRequirements) ("vkMemoryRequirements" ::: MemoryRequirements
e) (IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> ((()
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> (()
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((()
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> ()
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
forall a b. (a -> b) -> a -> b
$ ())) ("vkMemoryRequirements"
::: Vector ("vkMemoryRequirements" ::: MemoryRequirements)
vkMemoryRequirements)
Ptr AllocationCreateInfo
pPCreateInfo <- ((Ptr AllocationCreateInfo
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
(Ptr AllocationCreateInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr AllocationCreateInfo
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
(Ptr AllocationCreateInfo))
-> ((Ptr AllocationCreateInfo
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
(Ptr AllocationCreateInfo)
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> (Ptr AllocationCreateInfo
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @AllocationCreateInfo ((("createInfo" ::: Vector AllocationCreateInfo) -> Int
forall a. Vector a -> Int
Data.Vector.length ("createInfo" ::: Vector AllocationCreateInfo
createInfo)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 40) 8
IO ()
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
())
-> IO ()
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
()
forall a b. (a -> b) -> a -> b
$ (Int -> AllocationCreateInfo -> IO ())
-> ("createInfo" ::: Vector AllocationCreateInfo) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: AllocationCreateInfo
e -> Ptr AllocationCreateInfo -> AllocationCreateInfo -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr AllocationCreateInfo
pPCreateInfo Ptr AllocationCreateInfo -> Int -> Ptr AllocationCreateInfo
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (40 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr AllocationCreateInfo) (AllocationCreateInfo
e)) ("createInfo" ::: Vector AllocationCreateInfo
createInfo)
let pVkMemoryRequirementsLength :: Int
pVkMemoryRequirementsLength = ("vkMemoryRequirements"
::: Vector ("vkMemoryRequirements" ::: MemoryRequirements))
-> Int
forall a. Vector a -> Int
Data.Vector.length (("vkMemoryRequirements"
::: Vector ("vkMemoryRequirements" ::: MemoryRequirements))
-> Int)
-> ("vkMemoryRequirements"
::: Vector ("vkMemoryRequirements" ::: MemoryRequirements))
-> Int
forall a b. (a -> b) -> a -> b
$ ("vkMemoryRequirements"
::: Vector ("vkMemoryRequirements" ::: MemoryRequirements)
vkMemoryRequirements)
IO ()
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
())
-> IO ()
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((("createInfo" ::: Vector AllocationCreateInfo) -> Int
forall a. Vector a -> Int
Data.Vector.length (("createInfo" ::: Vector AllocationCreateInfo) -> Int)
-> ("createInfo" ::: Vector AllocationCreateInfo) -> Int
forall a b. (a -> b) -> a -> b
$ ("createInfo" ::: Vector AllocationCreateInfo
createInfo)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
pVkMemoryRequirementsLength) (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 "" "pCreateInfo and pVkMemoryRequirements must have the same length" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
Ptr Allocation
pPAllocations <- ((Ptr Allocation
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
(Ptr Allocation)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Allocation
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
(Ptr Allocation))
-> ((Ptr Allocation
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
(Ptr Allocation)
forall a b. (a -> b) -> a -> b
$ IO (Ptr Allocation)
-> (Ptr Allocation -> IO ())
-> (Ptr Allocation
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr Allocation)
forall a. Int -> IO (Ptr a)
callocBytes @Allocation ((CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pVkMemoryRequirementsLength :: CSize))) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8)) Ptr Allocation -> IO ()
forall a. Ptr a -> IO ()
free
Ptr AllocationInfo
pPAllocationInfo <- ((Ptr AllocationInfo
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
(Ptr AllocationInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr AllocationInfo
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
(Ptr AllocationInfo))
-> ((Ptr AllocationInfo
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
(Ptr AllocationInfo)
forall a b. (a -> b) -> a -> b
$ IO (Ptr AllocationInfo)
-> (Ptr AllocationInfo -> IO ())
-> (Ptr AllocationInfo
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr AllocationInfo)
forall a. Int -> IO (Ptr a)
callocBytes @AllocationInfo ((CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pVkMemoryRequirementsLength :: CSize))) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 48)) Ptr AllocationInfo -> IO ()
forall a. Ptr a -> IO ()
free
[()]
_ <- (Int
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
())
-> [Int]
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
[()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\i :: Int
i -> ((()
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
()
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((()
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
())
-> ((()
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
()
forall a b. (a -> b) -> a -> b
$ Ptr AllocationInfo
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
forall a b. ToCStruct a => Ptr a -> IO b -> IO b
pokeZeroCStruct (Ptr AllocationInfo
pPAllocationInfo Ptr AllocationInfo -> Int -> Ptr AllocationInfo
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* 48) :: Ptr AllocationInfo) (IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> ((()
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> (()
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((()
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> ()
-> IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
forall a b. (a -> b) -> a -> b
$ ())) [0..(CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pVkMemoryRequirementsLength :: CSize))) Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1]
Result
r <- IO Result
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
Result)
-> IO Result
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
Result
forall a b. (a -> b) -> a -> b
$ (Allocator
-> Ptr ("vkMemoryRequirements" ::: MemoryRequirements)
-> Ptr AllocationCreateInfo
-> CSize
-> Ptr Allocation
-> Ptr AllocationInfo
-> IO Result
ffiVmaAllocateMemoryPages) (Allocator
allocator) (Ptr ("vkMemoryRequirements" ::: MemoryRequirements)
pPVkMemoryRequirements) (Ptr AllocationCreateInfo
pPCreateInfo) ((Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pVkMemoryRequirementsLength :: CSize)) (Ptr Allocation
pPAllocations) ((Ptr AllocationInfo
pPAllocationInfo))
IO ()
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
())
-> IO ()
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
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))
"allocations" ::: Vector Allocation
pAllocations <- IO ("allocations" ::: Vector Allocation)
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
("allocations" ::: Vector Allocation)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("allocations" ::: Vector Allocation)
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
("allocations" ::: Vector Allocation))
-> IO ("allocations" ::: Vector Allocation)
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
("allocations" ::: Vector Allocation)
forall a b. (a -> b) -> a -> b
$ Int
-> (Int -> IO Allocation)
-> IO ("allocations" ::: Vector Allocation)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pVkMemoryRequirementsLength :: CSize))) (\i :: Int
i -> Ptr Allocation -> IO Allocation
forall a. Storable a => Ptr a -> IO a
peek @Allocation ((Ptr Allocation
pPAllocations Ptr Allocation -> Int -> Ptr Allocation
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Allocation)))
"allocationInfo" ::: Vector AllocationInfo
pAllocationInfo <- IO ("allocationInfo" ::: Vector AllocationInfo)
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
("allocationInfo" ::: Vector AllocationInfo)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("allocationInfo" ::: Vector AllocationInfo)
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
("allocationInfo" ::: Vector AllocationInfo))
-> IO ("allocationInfo" ::: Vector AllocationInfo)
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
("allocationInfo" ::: Vector AllocationInfo)
forall a b. (a -> b) -> a -> b
$ Int
-> (Int -> IO AllocationInfo)
-> IO ("allocationInfo" ::: Vector AllocationInfo)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pVkMemoryRequirementsLength :: CSize))) (\i :: Int
i -> Ptr AllocationInfo -> IO AllocationInfo
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @AllocationInfo (((Ptr AllocationInfo
pPAllocationInfo) Ptr AllocationInfo -> Int -> Ptr AllocationInfo
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (48 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr AllocationInfo)))
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo))
-> ("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
-> ContT
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
IO
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
forall a b. (a -> b) -> a -> b
$ ("allocations" ::: Vector Allocation
pAllocations, "allocationInfo" ::: Vector AllocationInfo
pAllocationInfo)
withMemoryPages :: forall io r . MonadIO io => Allocator -> Vector MemoryRequirements -> Vector AllocationCreateInfo -> (io (Vector Allocation, Vector AllocationInfo) -> ((Vector Allocation, Vector AllocationInfo) -> io ()) -> r) -> r
withMemoryPages :: Allocator
-> ("vkMemoryRequirements"
::: Vector ("vkMemoryRequirements" ::: MemoryRequirements))
-> ("createInfo" ::: Vector AllocationCreateInfo)
-> (io
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
-> (("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
-> io ())
-> r)
-> r
withMemoryPages allocator :: Allocator
allocator pVkMemoryRequirements :: "vkMemoryRequirements"
::: Vector ("vkMemoryRequirements" ::: MemoryRequirements)
pVkMemoryRequirements pCreateInfo :: "createInfo" ::: Vector AllocationCreateInfo
pCreateInfo b :: io
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
-> (("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
-> io ())
-> r
b =
io
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
-> (("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
-> io ())
-> r
b (Allocator
-> ("vkMemoryRequirements"
::: Vector ("vkMemoryRequirements" ::: MemoryRequirements))
-> ("createInfo" ::: Vector AllocationCreateInfo)
-> io
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
forall (io :: * -> *).
MonadIO io =>
Allocator
-> ("vkMemoryRequirements"
::: Vector ("vkMemoryRequirements" ::: MemoryRequirements))
-> ("createInfo" ::: Vector AllocationCreateInfo)
-> io
("allocations" ::: Vector Allocation,
"allocationInfo" ::: Vector AllocationInfo)
allocateMemoryPages Allocator
allocator "vkMemoryRequirements"
::: Vector ("vkMemoryRequirements" ::: MemoryRequirements)
pVkMemoryRequirements "createInfo" ::: Vector AllocationCreateInfo
pCreateInfo)
(\(o0 :: "allocations" ::: Vector Allocation
o0, _) -> Allocator -> ("allocations" ::: Vector Allocation) -> io ()
forall (io :: * -> *).
MonadIO io =>
Allocator -> ("allocations" ::: Vector Allocation) -> io ()
freeMemoryPages Allocator
allocator "allocations" ::: Vector Allocation
o0)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaAllocateMemoryForBuffer" ffiVmaAllocateMemoryForBuffer
:: Allocator -> Buffer -> Ptr AllocationCreateInfo -> Ptr Allocation -> Ptr AllocationInfo -> IO Result
allocateMemoryForBuffer :: forall io
. (MonadIO io)
=>
Allocator
->
Buffer
->
AllocationCreateInfo
-> io (Allocation, AllocationInfo)
allocateMemoryForBuffer :: Allocator
-> Buffer
-> AllocationCreateInfo
-> io (Allocation, AllocationInfo)
allocateMemoryForBuffer allocator :: Allocator
allocator buffer :: Buffer
buffer createInfo :: AllocationCreateInfo
createInfo = IO (Allocation, AllocationInfo) -> io (Allocation, AllocationInfo)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Allocation, AllocationInfo)
-> io (Allocation, AllocationInfo))
-> (ContT
(Allocation, AllocationInfo) IO (Allocation, AllocationInfo)
-> IO (Allocation, AllocationInfo))
-> ContT
(Allocation, AllocationInfo) IO (Allocation, AllocationInfo)
-> io (Allocation, AllocationInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT (Allocation, AllocationInfo) IO (Allocation, AllocationInfo)
-> IO (Allocation, AllocationInfo)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT (Allocation, AllocationInfo) IO (Allocation, AllocationInfo)
-> io (Allocation, AllocationInfo))
-> ContT
(Allocation, AllocationInfo) IO (Allocation, AllocationInfo)
-> io (Allocation, AllocationInfo)
forall a b. (a -> b) -> a -> b
$ do
Ptr AllocationCreateInfo
pCreateInfo <- ((Ptr AllocationCreateInfo -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo))
-> ContT (Allocation, AllocationInfo) IO (Ptr AllocationCreateInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr AllocationCreateInfo -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo))
-> ContT
(Allocation, AllocationInfo) IO (Ptr AllocationCreateInfo))
-> ((Ptr AllocationCreateInfo -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo))
-> ContT (Allocation, AllocationInfo) IO (Ptr AllocationCreateInfo)
forall a b. (a -> b) -> a -> b
$ AllocationCreateInfo
-> (Ptr AllocationCreateInfo -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCreateInfo
createInfo)
Ptr Allocation
pPAllocation <- ((Ptr Allocation -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo))
-> ContT (Allocation, AllocationInfo) IO (Ptr Allocation)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Allocation -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo))
-> ContT (Allocation, AllocationInfo) IO (Ptr Allocation))
-> ((Ptr Allocation -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo))
-> ContT (Allocation, AllocationInfo) IO (Ptr Allocation)
forall a b. (a -> b) -> a -> b
$ IO (Ptr Allocation)
-> (Ptr Allocation -> IO ())
-> (Ptr Allocation -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr Allocation)
forall a. Int -> IO (Ptr a)
callocBytes @Allocation 8) Ptr Allocation -> IO ()
forall a. Ptr a -> IO ()
free
Ptr AllocationInfo
pPAllocationInfo <- ((Ptr AllocationInfo -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo))
-> ContT (Allocation, AllocationInfo) IO (Ptr AllocationInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct AllocationInfo =>
(Ptr AllocationInfo -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @AllocationInfo)
Result
r <- IO Result -> ContT (Allocation, AllocationInfo) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT (Allocation, AllocationInfo) IO Result)
-> IO Result -> ContT (Allocation, AllocationInfo) IO Result
forall a b. (a -> b) -> a -> b
$ (Allocator
-> Buffer
-> Ptr AllocationCreateInfo
-> Ptr Allocation
-> Ptr AllocationInfo
-> IO Result
ffiVmaAllocateMemoryForBuffer) (Allocator
allocator) (Buffer
buffer) Ptr AllocationCreateInfo
pCreateInfo (Ptr Allocation
pPAllocation) (Ptr AllocationInfo
pPAllocationInfo)
IO () -> ContT (Allocation, AllocationInfo) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Allocation, AllocationInfo) IO ())
-> IO () -> ContT (Allocation, AllocationInfo) 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))
Allocation
pAllocation <- IO Allocation -> ContT (Allocation, AllocationInfo) IO Allocation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Allocation -> ContT (Allocation, AllocationInfo) IO Allocation)
-> IO Allocation
-> ContT (Allocation, AllocationInfo) IO Allocation
forall a b. (a -> b) -> a -> b
$ Ptr Allocation -> IO Allocation
forall a. Storable a => Ptr a -> IO a
peek @Allocation Ptr Allocation
pPAllocation
AllocationInfo
pAllocationInfo <- IO AllocationInfo
-> ContT (Allocation, AllocationInfo) IO AllocationInfo
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO AllocationInfo
-> ContT (Allocation, AllocationInfo) IO AllocationInfo)
-> IO AllocationInfo
-> ContT (Allocation, AllocationInfo) IO AllocationInfo
forall a b. (a -> b) -> a -> b
$ Ptr AllocationInfo -> IO AllocationInfo
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @AllocationInfo Ptr AllocationInfo
pPAllocationInfo
(Allocation, AllocationInfo)
-> ContT
(Allocation, AllocationInfo) IO (Allocation, AllocationInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Allocation, AllocationInfo)
-> ContT
(Allocation, AllocationInfo) IO (Allocation, AllocationInfo))
-> (Allocation, AllocationInfo)
-> ContT
(Allocation, AllocationInfo) IO (Allocation, AllocationInfo)
forall a b. (a -> b) -> a -> b
$ (Allocation
pAllocation, AllocationInfo
pAllocationInfo)
withMemoryForBuffer :: forall io r . MonadIO io => Allocator -> Buffer -> AllocationCreateInfo -> (io (Allocation, AllocationInfo) -> ((Allocation, AllocationInfo) -> io ()) -> r) -> r
withMemoryForBuffer :: Allocator
-> Buffer
-> AllocationCreateInfo
-> (io (Allocation, AllocationInfo)
-> ((Allocation, AllocationInfo) -> io ()) -> r)
-> r
withMemoryForBuffer allocator :: Allocator
allocator buffer :: Buffer
buffer pCreateInfo :: AllocationCreateInfo
pCreateInfo b :: io (Allocation, AllocationInfo)
-> ((Allocation, AllocationInfo) -> io ()) -> r
b =
io (Allocation, AllocationInfo)
-> ((Allocation, AllocationInfo) -> io ()) -> r
b (Allocator
-> Buffer
-> AllocationCreateInfo
-> io (Allocation, AllocationInfo)
forall (io :: * -> *).
MonadIO io =>
Allocator
-> Buffer
-> AllocationCreateInfo
-> io (Allocation, AllocationInfo)
allocateMemoryForBuffer Allocator
allocator Buffer
buffer AllocationCreateInfo
pCreateInfo)
(\(o0 :: Allocation
o0, _) -> Allocator -> Allocation -> io ()
forall (io :: * -> *).
MonadIO io =>
Allocator -> Allocation -> io ()
freeMemory Allocator
allocator Allocation
o0)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaAllocateMemoryForImage" ffiVmaAllocateMemoryForImage
:: Allocator -> Image -> Ptr AllocationCreateInfo -> Ptr Allocation -> Ptr AllocationInfo -> IO Result
allocateMemoryForImage :: forall io
. (MonadIO io)
=>
Allocator
->
Image
->
AllocationCreateInfo
-> io (Allocation, AllocationInfo)
allocateMemoryForImage :: Allocator
-> Image -> AllocationCreateInfo -> io (Allocation, AllocationInfo)
allocateMemoryForImage allocator :: Allocator
allocator image :: Image
image createInfo :: AllocationCreateInfo
createInfo = IO (Allocation, AllocationInfo) -> io (Allocation, AllocationInfo)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Allocation, AllocationInfo)
-> io (Allocation, AllocationInfo))
-> (ContT
(Allocation, AllocationInfo) IO (Allocation, AllocationInfo)
-> IO (Allocation, AllocationInfo))
-> ContT
(Allocation, AllocationInfo) IO (Allocation, AllocationInfo)
-> io (Allocation, AllocationInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT (Allocation, AllocationInfo) IO (Allocation, AllocationInfo)
-> IO (Allocation, AllocationInfo)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT (Allocation, AllocationInfo) IO (Allocation, AllocationInfo)
-> io (Allocation, AllocationInfo))
-> ContT
(Allocation, AllocationInfo) IO (Allocation, AllocationInfo)
-> io (Allocation, AllocationInfo)
forall a b. (a -> b) -> a -> b
$ do
Ptr AllocationCreateInfo
pCreateInfo <- ((Ptr AllocationCreateInfo -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo))
-> ContT (Allocation, AllocationInfo) IO (Ptr AllocationCreateInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr AllocationCreateInfo -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo))
-> ContT
(Allocation, AllocationInfo) IO (Ptr AllocationCreateInfo))
-> ((Ptr AllocationCreateInfo -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo))
-> ContT (Allocation, AllocationInfo) IO (Ptr AllocationCreateInfo)
forall a b. (a -> b) -> a -> b
$ AllocationCreateInfo
-> (Ptr AllocationCreateInfo -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCreateInfo
createInfo)
Ptr Allocation
pPAllocation <- ((Ptr Allocation -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo))
-> ContT (Allocation, AllocationInfo) IO (Ptr Allocation)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Allocation -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo))
-> ContT (Allocation, AllocationInfo) IO (Ptr Allocation))
-> ((Ptr Allocation -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo))
-> ContT (Allocation, AllocationInfo) IO (Ptr Allocation)
forall a b. (a -> b) -> a -> b
$ IO (Ptr Allocation)
-> (Ptr Allocation -> IO ())
-> (Ptr Allocation -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr Allocation)
forall a. Int -> IO (Ptr a)
callocBytes @Allocation 8) Ptr Allocation -> IO ()
forall a. Ptr a -> IO ()
free
Ptr AllocationInfo
pPAllocationInfo <- ((Ptr AllocationInfo -> IO (Allocation, AllocationInfo))
-> IO (Allocation, AllocationInfo))
-> ContT (Allocation, AllocationInfo) IO (Ptr AllocationInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct AllocationInfo =>
(Ptr AllocationInfo -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @AllocationInfo)
Result
r <- IO Result -> ContT (Allocation, AllocationInfo) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT (Allocation, AllocationInfo) IO Result)
-> IO Result -> ContT (Allocation, AllocationInfo) IO Result
forall a b. (a -> b) -> a -> b
$ (Allocator
-> Image
-> Ptr AllocationCreateInfo
-> Ptr Allocation
-> Ptr AllocationInfo
-> IO Result
ffiVmaAllocateMemoryForImage) (Allocator
allocator) (Image
image) Ptr AllocationCreateInfo
pCreateInfo (Ptr Allocation
pPAllocation) (Ptr AllocationInfo
pPAllocationInfo)
IO () -> ContT (Allocation, AllocationInfo) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Allocation, AllocationInfo) IO ())
-> IO () -> ContT (Allocation, AllocationInfo) 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))
Allocation
pAllocation <- IO Allocation -> ContT (Allocation, AllocationInfo) IO Allocation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Allocation -> ContT (Allocation, AllocationInfo) IO Allocation)
-> IO Allocation
-> ContT (Allocation, AllocationInfo) IO Allocation
forall a b. (a -> b) -> a -> b
$ Ptr Allocation -> IO Allocation
forall a. Storable a => Ptr a -> IO a
peek @Allocation Ptr Allocation
pPAllocation
AllocationInfo
pAllocationInfo <- IO AllocationInfo
-> ContT (Allocation, AllocationInfo) IO AllocationInfo
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO AllocationInfo
-> ContT (Allocation, AllocationInfo) IO AllocationInfo)
-> IO AllocationInfo
-> ContT (Allocation, AllocationInfo) IO AllocationInfo
forall a b. (a -> b) -> a -> b
$ Ptr AllocationInfo -> IO AllocationInfo
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @AllocationInfo Ptr AllocationInfo
pPAllocationInfo
(Allocation, AllocationInfo)
-> ContT
(Allocation, AllocationInfo) IO (Allocation, AllocationInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Allocation, AllocationInfo)
-> ContT
(Allocation, AllocationInfo) IO (Allocation, AllocationInfo))
-> (Allocation, AllocationInfo)
-> ContT
(Allocation, AllocationInfo) IO (Allocation, AllocationInfo)
forall a b. (a -> b) -> a -> b
$ (Allocation
pAllocation, AllocationInfo
pAllocationInfo)
withMemoryForImage :: forall io r . MonadIO io => Allocator -> Image -> AllocationCreateInfo -> (io (Allocation, AllocationInfo) -> ((Allocation, AllocationInfo) -> io ()) -> r) -> r
withMemoryForImage :: Allocator
-> Image
-> AllocationCreateInfo
-> (io (Allocation, AllocationInfo)
-> ((Allocation, AllocationInfo) -> io ()) -> r)
-> r
withMemoryForImage allocator :: Allocator
allocator image :: Image
image pCreateInfo :: AllocationCreateInfo
pCreateInfo b :: io (Allocation, AllocationInfo)
-> ((Allocation, AllocationInfo) -> io ()) -> r
b =
io (Allocation, AllocationInfo)
-> ((Allocation, AllocationInfo) -> io ()) -> r
b (Allocator
-> Image -> AllocationCreateInfo -> io (Allocation, AllocationInfo)
forall (io :: * -> *).
MonadIO io =>
Allocator
-> Image -> AllocationCreateInfo -> io (Allocation, AllocationInfo)
allocateMemoryForImage Allocator
allocator Image
image AllocationCreateInfo
pCreateInfo)
(\(o0 :: Allocation
o0, _) -> Allocator -> Allocation -> io ()
forall (io :: * -> *).
MonadIO io =>
Allocator -> Allocation -> io ()
freeMemory Allocator
allocator Allocation
o0)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaFreeMemory" ffiVmaFreeMemory
:: Allocator -> Allocation -> IO ()
freeMemory :: forall io
. (MonadIO io)
=>
Allocator
->
Allocation
-> io ()
freeMemory :: Allocator -> Allocation -> io ()
freeMemory allocator :: Allocator
allocator allocation :: Allocation
allocation = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
(Allocator -> Allocation -> IO ()
ffiVmaFreeMemory) (Allocator
allocator) (Allocation
allocation)
() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ ()
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaFreeMemoryPages" ffiVmaFreeMemoryPages
:: Allocator -> CSize -> Ptr Allocation -> IO ()
freeMemoryPages :: forall io
. (MonadIO io)
=>
Allocator
->
("allocations" ::: Vector Allocation)
-> io ()
freeMemoryPages :: Allocator -> ("allocations" ::: Vector Allocation) -> io ()
freeMemoryPages allocator :: Allocator
allocator allocations :: "allocations" ::: Vector Allocation
allocations = 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
Ptr Allocation
pPAllocations <- ((Ptr Allocation -> IO ()) -> IO ())
-> ContT () IO (Ptr Allocation)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Allocation -> IO ()) -> IO ())
-> ContT () IO (Ptr Allocation))
-> ((Ptr Allocation -> IO ()) -> IO ())
-> ContT () IO (Ptr Allocation)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Allocation -> IO ()) -> IO ()
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Allocation ((("allocations" ::: Vector Allocation) -> Int
forall a. Vector a -> Int
Data.Vector.length ("allocations" ::: Vector Allocation
allocations)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 8
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
$ (Int -> Allocation -> IO ())
-> ("allocations" ::: Vector Allocation) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Allocation
e -> Ptr Allocation -> Allocation -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Allocation
pPAllocations Ptr Allocation -> Int -> Ptr Allocation
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Allocation) (Allocation
e)) ("allocations" ::: Vector Allocation
allocations)
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
$ (Allocator -> CSize -> Ptr Allocation -> IO ()
ffiVmaFreeMemoryPages) (Allocator
allocator) ((Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("allocations" ::: Vector Allocation) -> Int
forall a. Vector a -> Int
Data.Vector.length (("allocations" ::: Vector Allocation) -> Int)
-> ("allocations" ::: Vector Allocation) -> Int
forall a b. (a -> b) -> a -> b
$ ("allocations" ::: Vector Allocation
allocations)) :: CSize)) (Ptr Allocation
pPAllocations)
() -> 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
"vmaResizeAllocation" ffiVmaResizeAllocation
:: Allocator -> Allocation -> DeviceSize -> IO Result
resizeAllocation :: forall io
. (MonadIO io)
=>
Allocator
->
Allocation
->
("newSize" ::: DeviceSize)
-> io ()
resizeAllocation :: Allocator
-> Allocation -> ("lostAllocationCount" ::: Word64) -> io ()
resizeAllocation allocator :: Allocator
allocator allocation :: Allocation
allocation newSize :: "lostAllocationCount" ::: Word64
newSize = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
Result
r <- (Allocator
-> Allocation -> ("lostAllocationCount" ::: Word64) -> IO Result
ffiVmaResizeAllocation) (Allocator
allocator) (Allocation
allocation) ("lostAllocationCount" ::: Word64
newSize)
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))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaGetAllocationInfo" ffiVmaGetAllocationInfo
:: Allocator -> Allocation -> Ptr AllocationInfo -> IO ()
getAllocationInfo :: forall io
. (MonadIO io)
=>
Allocator
->
Allocation
-> io (AllocationInfo)
getAllocationInfo :: Allocator -> Allocation -> io AllocationInfo
getAllocationInfo allocator :: Allocator
allocator allocation :: Allocation
allocation = IO AllocationInfo -> io AllocationInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AllocationInfo -> io AllocationInfo)
-> (ContT AllocationInfo IO AllocationInfo -> IO AllocationInfo)
-> ContT AllocationInfo IO AllocationInfo
-> io AllocationInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT AllocationInfo IO AllocationInfo -> IO AllocationInfo
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT AllocationInfo IO AllocationInfo -> io AllocationInfo)
-> ContT AllocationInfo IO AllocationInfo -> io AllocationInfo
forall a b. (a -> b) -> a -> b
$ do
Ptr AllocationInfo
pPAllocationInfo <- ((Ptr AllocationInfo -> IO AllocationInfo) -> IO AllocationInfo)
-> ContT AllocationInfo IO (Ptr AllocationInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct AllocationInfo =>
(Ptr AllocationInfo -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @AllocationInfo)
IO () -> ContT AllocationInfo IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT AllocationInfo IO ())
-> IO () -> ContT AllocationInfo IO ()
forall a b. (a -> b) -> a -> b
$ (Allocator -> Allocation -> Ptr AllocationInfo -> IO ()
ffiVmaGetAllocationInfo) (Allocator
allocator) (Allocation
allocation) (Ptr AllocationInfo
pPAllocationInfo)
AllocationInfo
pAllocationInfo <- IO AllocationInfo -> ContT AllocationInfo IO AllocationInfo
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO AllocationInfo -> ContT AllocationInfo IO AllocationInfo)
-> IO AllocationInfo -> ContT AllocationInfo IO AllocationInfo
forall a b. (a -> b) -> a -> b
$ Ptr AllocationInfo -> IO AllocationInfo
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @AllocationInfo Ptr AllocationInfo
pPAllocationInfo
AllocationInfo -> ContT AllocationInfo IO AllocationInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AllocationInfo -> ContT AllocationInfo IO AllocationInfo)
-> AllocationInfo -> ContT AllocationInfo IO AllocationInfo
forall a b. (a -> b) -> a -> b
$ (AllocationInfo
pAllocationInfo)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaTouchAllocation" ffiVmaTouchAllocation
:: Allocator -> Allocation -> IO Bool32
touchAllocation :: forall io
. (MonadIO io)
=>
Allocator
->
Allocation
-> io (Bool)
touchAllocation :: Allocator -> Allocation -> io Bool
touchAllocation allocator :: Allocator
allocator allocation :: Allocation
allocation = IO Bool -> io Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> io Bool) -> IO Bool -> io Bool
forall a b. (a -> b) -> a -> b
$ do
Bool32
r <- (Allocator -> Allocation -> IO Bool32
ffiVmaTouchAllocation) (Allocator
allocator) (Allocation
allocation)
Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ ((Bool32 -> Bool
bool32ToBool Bool32
r))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaSetAllocationUserData" ffiVmaSetAllocationUserData
:: Allocator -> Allocation -> Ptr () -> IO ()
setAllocationUserData :: forall io
. (MonadIO io)
=>
Allocator
->
Allocation
->
("userData" ::: Ptr ())
-> io ()
setAllocationUserData :: Allocator -> Allocation -> ("userData" ::: Ptr ()) -> io ()
setAllocationUserData allocator :: Allocator
allocator allocation :: Allocation
allocation userData :: "userData" ::: Ptr ()
userData = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
(Allocator -> Allocation -> ("userData" ::: Ptr ()) -> IO ()
ffiVmaSetAllocationUserData) (Allocator
allocator) (Allocation
allocation) ("userData" ::: Ptr ()
userData)
() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ ()
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaCreateLostAllocation" ffiVmaCreateLostAllocation
:: Allocator -> Ptr Allocation -> IO ()
createLostAllocation :: forall io
. (MonadIO io)
=>
Allocator
-> io (Allocation)
createLostAllocation :: Allocator -> io Allocation
createLostAllocation allocator :: Allocator
allocator = IO Allocation -> io Allocation
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Allocation -> io Allocation)
-> (ContT Allocation IO Allocation -> IO Allocation)
-> ContT Allocation IO Allocation
-> io Allocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Allocation IO Allocation -> IO Allocation
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Allocation IO Allocation -> io Allocation)
-> ContT Allocation IO Allocation -> io Allocation
forall a b. (a -> b) -> a -> b
$ do
Ptr Allocation
pPAllocation <- ((Ptr Allocation -> IO Allocation) -> IO Allocation)
-> ContT Allocation IO (Ptr Allocation)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Allocation -> IO Allocation) -> IO Allocation)
-> ContT Allocation IO (Ptr Allocation))
-> ((Ptr Allocation -> IO Allocation) -> IO Allocation)
-> ContT Allocation IO (Ptr Allocation)
forall a b. (a -> b) -> a -> b
$ IO (Ptr Allocation)
-> (Ptr Allocation -> IO ())
-> (Ptr Allocation -> IO Allocation)
-> IO Allocation
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr Allocation)
forall a. Int -> IO (Ptr a)
callocBytes @Allocation 8) Ptr Allocation -> IO ()
forall a. Ptr a -> IO ()
free
IO () -> ContT Allocation IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Allocation IO ())
-> IO () -> ContT Allocation IO ()
forall a b. (a -> b) -> a -> b
$ (Allocator -> Ptr Allocation -> IO ()
ffiVmaCreateLostAllocation) (Allocator
allocator) (Ptr Allocation
pPAllocation)
Allocation
pAllocation <- IO Allocation -> ContT Allocation IO Allocation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Allocation -> ContT Allocation IO Allocation)
-> IO Allocation -> ContT Allocation IO Allocation
forall a b. (a -> b) -> a -> b
$ Ptr Allocation -> IO Allocation
forall a. Storable a => Ptr a -> IO a
peek @Allocation Ptr Allocation
pPAllocation
Allocation -> ContT Allocation IO Allocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Allocation -> ContT Allocation IO Allocation)
-> Allocation -> ContT Allocation IO Allocation
forall a b. (a -> b) -> a -> b
$ (Allocation
pAllocation)
withLostAllocation :: forall io r . MonadIO io => Allocator -> (io (Allocation) -> ((Allocation) -> io ()) -> r) -> r
withLostAllocation :: Allocator -> (io Allocation -> (Allocation -> io ()) -> r) -> r
withLostAllocation allocator :: Allocator
allocator b :: io Allocation -> (Allocation -> io ()) -> r
b =
io Allocation -> (Allocation -> io ()) -> r
b (Allocator -> io Allocation
forall (io :: * -> *). MonadIO io => Allocator -> io Allocation
createLostAllocation Allocator
allocator)
(\(Allocation
o0) -> Allocator -> Allocation -> io ()
forall (io :: * -> *).
MonadIO io =>
Allocator -> Allocation -> io ()
freeMemory Allocator
allocator Allocation
o0)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaMapMemory" ffiVmaMapMemory
:: Allocator -> Allocation -> Ptr (Ptr ()) -> IO Result
mapMemory :: forall io
. (MonadIO io)
=>
Allocator
->
Allocation
-> io (("data" ::: Ptr ()))
mapMemory :: Allocator -> Allocation -> io ("userData" ::: Ptr ())
mapMemory allocator :: Allocator
allocator allocation :: Allocation
allocation = IO ("userData" ::: Ptr ()) -> io ("userData" ::: Ptr ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ("userData" ::: Ptr ()) -> io ("userData" ::: Ptr ()))
-> (ContT ("userData" ::: Ptr ()) IO ("userData" ::: Ptr ())
-> IO ("userData" ::: Ptr ()))
-> ContT ("userData" ::: Ptr ()) IO ("userData" ::: Ptr ())
-> io ("userData" ::: Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT ("userData" ::: Ptr ()) IO ("userData" ::: Ptr ())
-> IO ("userData" ::: Ptr ())
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT ("userData" ::: Ptr ()) IO ("userData" ::: Ptr ())
-> io ("userData" ::: Ptr ()))
-> ContT ("userData" ::: Ptr ()) IO ("userData" ::: Ptr ())
-> io ("userData" ::: Ptr ())
forall a b. (a -> b) -> a -> b
$ do
Ptr ("userData" ::: Ptr ())
pPpData <- ((Ptr ("userData" ::: Ptr ()) -> IO ("userData" ::: Ptr ()))
-> IO ("userData" ::: Ptr ()))
-> ContT ("userData" ::: Ptr ()) IO (Ptr ("userData" ::: Ptr ()))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ("userData" ::: Ptr ()) -> IO ("userData" ::: Ptr ()))
-> IO ("userData" ::: Ptr ()))
-> ContT ("userData" ::: Ptr ()) IO (Ptr ("userData" ::: Ptr ())))
-> ((Ptr ("userData" ::: Ptr ()) -> IO ("userData" ::: Ptr ()))
-> IO ("userData" ::: Ptr ()))
-> ContT ("userData" ::: Ptr ()) IO (Ptr ("userData" ::: Ptr ()))
forall a b. (a -> b) -> a -> b
$ IO (Ptr ("userData" ::: Ptr ()))
-> (Ptr ("userData" ::: Ptr ()) -> IO ())
-> (Ptr ("userData" ::: Ptr ()) -> IO ("userData" ::: Ptr ()))
-> IO ("userData" ::: Ptr ())
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr ("userData" ::: Ptr ()))
forall a. Int -> IO (Ptr a)
callocBytes @(Ptr ()) 8) Ptr ("userData" ::: Ptr ()) -> IO ()
forall a. Ptr a -> IO ()
free
Result
r <- IO Result -> ContT ("userData" ::: Ptr ()) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT ("userData" ::: Ptr ()) IO Result)
-> IO Result -> ContT ("userData" ::: Ptr ()) IO Result
forall a b. (a -> b) -> a -> b
$ (Allocator -> Allocation -> Ptr ("userData" ::: Ptr ()) -> IO Result
ffiVmaMapMemory) (Allocator
allocator) (Allocation
allocation) (Ptr ("userData" ::: Ptr ())
pPpData)
IO () -> ContT ("userData" ::: Ptr ()) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ("userData" ::: Ptr ()) IO ())
-> IO () -> ContT ("userData" ::: Ptr ()) 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))
"userData" ::: Ptr ()
ppData <- IO ("userData" ::: Ptr ())
-> ContT ("userData" ::: Ptr ()) IO ("userData" ::: Ptr ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("userData" ::: Ptr ())
-> ContT ("userData" ::: Ptr ()) IO ("userData" ::: Ptr ()))
-> IO ("userData" ::: Ptr ())
-> ContT ("userData" ::: Ptr ()) IO ("userData" ::: Ptr ())
forall a b. (a -> b) -> a -> b
$ Ptr ("userData" ::: Ptr ()) -> IO ("userData" ::: Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) Ptr ("userData" ::: Ptr ())
pPpData
("userData" ::: Ptr ())
-> ContT ("userData" ::: Ptr ()) IO ("userData" ::: Ptr ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("userData" ::: Ptr ())
-> ContT ("userData" ::: Ptr ()) IO ("userData" ::: Ptr ()))
-> ("userData" ::: Ptr ())
-> ContT ("userData" ::: Ptr ()) IO ("userData" ::: Ptr ())
forall a b. (a -> b) -> a -> b
$ ("userData" ::: Ptr ()
ppData)
withMappedMemory :: forall io r . MonadIO io => Allocator -> Allocation -> (io (Ptr ()) -> ((Ptr ()) -> io ()) -> r) -> r
withMappedMemory :: Allocator
-> Allocation
-> (io ("userData" ::: Ptr ())
-> (("userData" ::: Ptr ()) -> io ()) -> r)
-> r
withMappedMemory allocator :: Allocator
allocator allocation :: Allocation
allocation b :: io ("userData" ::: Ptr ())
-> (("userData" ::: Ptr ()) -> io ()) -> r
b =
io ("userData" ::: Ptr ())
-> (("userData" ::: Ptr ()) -> io ()) -> r
b (Allocator -> Allocation -> io ("userData" ::: Ptr ())
forall (io :: * -> *).
MonadIO io =>
Allocator -> Allocation -> io ("userData" ::: Ptr ())
mapMemory Allocator
allocator Allocation
allocation)
(\("userData" ::: Ptr ()
_) -> Allocator -> Allocation -> io ()
forall (io :: * -> *).
MonadIO io =>
Allocator -> Allocation -> io ()
unmapMemory Allocator
allocator Allocation
allocation)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaUnmapMemory" ffiVmaUnmapMemory
:: Allocator -> Allocation -> IO ()
unmapMemory :: forall io
. (MonadIO io)
=>
Allocator
->
Allocation
-> io ()
unmapMemory :: Allocator -> Allocation -> io ()
unmapMemory allocator :: Allocator
allocator allocation :: Allocation
allocation = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
(Allocator -> Allocation -> IO ()
ffiVmaUnmapMemory) (Allocator
allocator) (Allocation
allocation)
() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ ()
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaFlushAllocation" ffiVmaFlushAllocation
:: Allocator -> Allocation -> DeviceSize -> DeviceSize -> IO Result
flushAllocation :: forall io
. (MonadIO io)
=>
Allocator
->
Allocation
->
("offset" ::: DeviceSize)
->
DeviceSize
-> io ()
flushAllocation :: Allocator
-> Allocation
-> ("lostAllocationCount" ::: Word64)
-> ("lostAllocationCount" ::: Word64)
-> io ()
flushAllocation allocator :: Allocator
allocator allocation :: Allocation
allocation offset :: "lostAllocationCount" ::: Word64
offset size :: "lostAllocationCount" ::: Word64
size = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
Result
r <- (Allocator
-> Allocation
-> ("lostAllocationCount" ::: Word64)
-> ("lostAllocationCount" ::: Word64)
-> IO Result
ffiVmaFlushAllocation) (Allocator
allocator) (Allocation
allocation) ("lostAllocationCount" ::: Word64
offset) ("lostAllocationCount" ::: Word64
size)
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))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaInvalidateAllocation" ffiVmaInvalidateAllocation
:: Allocator -> Allocation -> DeviceSize -> DeviceSize -> IO Result
invalidateAllocation :: forall io
. (MonadIO io)
=>
Allocator
->
Allocation
->
("offset" ::: DeviceSize)
->
DeviceSize
-> io ()
invalidateAllocation :: Allocator
-> Allocation
-> ("lostAllocationCount" ::: Word64)
-> ("lostAllocationCount" ::: Word64)
-> io ()
invalidateAllocation allocator :: Allocator
allocator allocation :: Allocation
allocation offset :: "lostAllocationCount" ::: Word64
offset size :: "lostAllocationCount" ::: Word64
size = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
Result
r <- (Allocator
-> Allocation
-> ("lostAllocationCount" ::: Word64)
-> ("lostAllocationCount" ::: Word64)
-> IO Result
ffiVmaInvalidateAllocation) (Allocator
allocator) (Allocation
allocation) ("lostAllocationCount" ::: Word64
offset) ("lostAllocationCount" ::: Word64
size)
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))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaFlushAllocations" ffiVmaFlushAllocations
:: Allocator -> Word32 -> Ptr Allocation -> Ptr DeviceSize -> Ptr DeviceSize -> IO Result
flushAllocations :: forall io
. (MonadIO io)
=>
Allocator
->
("allocations" ::: Vector Allocation)
->
("offsets" ::: Vector DeviceSize)
->
("sizes" ::: Vector DeviceSize)
-> io ()
flushAllocations :: Allocator
-> ("allocations" ::: Vector Allocation)
-> ("offsets" ::: Vector ("lostAllocationCount" ::: Word64))
-> ("offsets" ::: Vector ("lostAllocationCount" ::: Word64))
-> io ()
flushAllocations allocator :: Allocator
allocator allocations :: "allocations" ::: Vector Allocation
allocations offsets :: "offsets" ::: Vector ("lostAllocationCount" ::: Word64)
offsets sizes :: "offsets" ::: Vector ("lostAllocationCount" ::: Word64)
sizes = 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 allocationsLength :: Int
allocationsLength = ("allocations" ::: Vector Allocation) -> Int
forall a. Vector a -> Int
Data.Vector.length (("allocations" ::: Vector Allocation) -> Int)
-> ("allocations" ::: Vector Allocation) -> Int
forall a b. (a -> b) -> a -> b
$ ("allocations" ::: Vector Allocation
allocations)
let offsetsLength :: Int
offsetsLength = ("offsets" ::: Vector ("lostAllocationCount" ::: Word64)) -> Int
forall a. Vector a -> Int
Data.Vector.length (("offsets" ::: Vector ("lostAllocationCount" ::: Word64)) -> Int)
-> ("offsets" ::: Vector ("lostAllocationCount" ::: Word64)) -> Int
forall a b. (a -> b) -> a -> b
$ ("offsets" ::: Vector ("lostAllocationCount" ::: Word64)
offsets)
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 (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offsetsLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
allocationsLength Bool -> Bool -> Bool
|| Int
offsetsLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (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 "" "offsets and allocations must have the same length" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let sizesLength :: Int
sizesLength = ("offsets" ::: Vector ("lostAllocationCount" ::: Word64)) -> Int
forall a. Vector a -> Int
Data.Vector.length (("offsets" ::: Vector ("lostAllocationCount" ::: Word64)) -> Int)
-> ("offsets" ::: Vector ("lostAllocationCount" ::: Word64)) -> Int
forall a b. (a -> b) -> a -> b
$ ("offsets" ::: Vector ("lostAllocationCount" ::: Word64)
sizes)
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 (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sizesLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
allocationsLength Bool -> Bool -> Bool
|| Int
sizesLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (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 "" "sizes and allocations must have the same length" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
Ptr Allocation
pAllocations <- ((Ptr Allocation -> IO ()) -> IO ())
-> ContT () IO (Ptr Allocation)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Allocation -> IO ()) -> IO ())
-> ContT () IO (Ptr Allocation))
-> ((Ptr Allocation -> IO ()) -> IO ())
-> ContT () IO (Ptr Allocation)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Allocation -> IO ()) -> IO ()
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Allocation ((("allocations" ::: Vector Allocation) -> Int
forall a. Vector a -> Int
Data.Vector.length ("allocations" ::: Vector Allocation
allocations)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 8
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
$ (Int -> Allocation -> IO ())
-> ("allocations" ::: Vector Allocation) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Allocation
e -> Ptr Allocation -> Allocation -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Allocation
pAllocations Ptr Allocation -> Int -> Ptr Allocation
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Allocation) (Allocation
e)) ("allocations" ::: Vector Allocation
allocations)
Ptr ("lostAllocationCount" ::: Word64)
offsets' <- if ("offsets" ::: Vector ("lostAllocationCount" ::: Word64)) -> Bool
forall a. Vector a -> Bool
Data.Vector.null ("offsets" ::: Vector ("lostAllocationCount" ::: Word64)
offsets)
then Ptr ("lostAllocationCount" ::: Word64)
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr ("lostAllocationCount" ::: Word64)
forall a. Ptr a
nullPtr
else do
Ptr ("lostAllocationCount" ::: Word64)
pOffsets <- ((Ptr ("lostAllocationCount" ::: Word64) -> IO ()) -> IO ())
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ("lostAllocationCount" ::: Word64) -> IO ()) -> IO ())
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64)))
-> ((Ptr ("lostAllocationCount" ::: Word64) -> IO ()) -> IO ())
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64))
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> (Ptr ("lostAllocationCount" ::: Word64) -> IO ())
-> IO ()
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @DeviceSize (((("offsets" ::: Vector ("lostAllocationCount" ::: Word64)) -> Int
forall a. Vector a -> Int
Data.Vector.length ("offsets" ::: Vector ("lostAllocationCount" ::: Word64)
offsets))) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 8
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
$ (Int -> ("lostAllocationCount" ::: Word64) -> IO ())
-> ("offsets" ::: Vector ("lostAllocationCount" ::: Word64))
-> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: "lostAllocationCount" ::: Word64
e -> Ptr ("lostAllocationCount" ::: Word64)
-> ("lostAllocationCount" ::: Word64) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ("lostAllocationCount" ::: Word64)
pOffsets Ptr ("lostAllocationCount" ::: Word64)
-> Int -> Ptr ("lostAllocationCount" ::: Word64)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr DeviceSize) ("lostAllocationCount" ::: Word64
e)) (("offsets" ::: Vector ("lostAllocationCount" ::: Word64)
offsets))
Ptr ("lostAllocationCount" ::: Word64)
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr ("lostAllocationCount" ::: Word64)
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64)))
-> Ptr ("lostAllocationCount" ::: Word64)
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64))
forall a b. (a -> b) -> a -> b
$ Ptr ("lostAllocationCount" ::: Word64)
pOffsets
Ptr ("lostAllocationCount" ::: Word64)
sizes' <- if ("offsets" ::: Vector ("lostAllocationCount" ::: Word64)) -> Bool
forall a. Vector a -> Bool
Data.Vector.null ("offsets" ::: Vector ("lostAllocationCount" ::: Word64)
sizes)
then Ptr ("lostAllocationCount" ::: Word64)
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr ("lostAllocationCount" ::: Word64)
forall a. Ptr a
nullPtr
else do
Ptr ("lostAllocationCount" ::: Word64)
pSizes <- ((Ptr ("lostAllocationCount" ::: Word64) -> IO ()) -> IO ())
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ("lostAllocationCount" ::: Word64) -> IO ()) -> IO ())
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64)))
-> ((Ptr ("lostAllocationCount" ::: Word64) -> IO ()) -> IO ())
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64))
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> (Ptr ("lostAllocationCount" ::: Word64) -> IO ())
-> IO ()
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @DeviceSize (((("offsets" ::: Vector ("lostAllocationCount" ::: Word64)) -> Int
forall a. Vector a -> Int
Data.Vector.length ("offsets" ::: Vector ("lostAllocationCount" ::: Word64)
sizes))) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 8
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
$ (Int -> ("lostAllocationCount" ::: Word64) -> IO ())
-> ("offsets" ::: Vector ("lostAllocationCount" ::: Word64))
-> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: "lostAllocationCount" ::: Word64
e -> Ptr ("lostAllocationCount" ::: Word64)
-> ("lostAllocationCount" ::: Word64) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ("lostAllocationCount" ::: Word64)
pSizes Ptr ("lostAllocationCount" ::: Word64)
-> Int -> Ptr ("lostAllocationCount" ::: Word64)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr DeviceSize) ("lostAllocationCount" ::: Word64
e)) (("offsets" ::: Vector ("lostAllocationCount" ::: Word64)
sizes))
Ptr ("lostAllocationCount" ::: Word64)
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr ("lostAllocationCount" ::: Word64)
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64)))
-> Ptr ("lostAllocationCount" ::: Word64)
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64))
forall a b. (a -> b) -> a -> b
$ Ptr ("lostAllocationCount" ::: Word64)
pSizes
Result
r <- IO Result -> ContT () IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT () IO Result)
-> IO Result -> ContT () IO Result
forall a b. (a -> b) -> a -> b
$ (Allocator
-> ("memoryTypeIndex" ::: Word32)
-> Ptr Allocation
-> Ptr ("lostAllocationCount" ::: Word64)
-> Ptr ("lostAllocationCount" ::: Word64)
-> IO Result
ffiVmaFlushAllocations) (Allocator
allocator) ((Int -> "memoryTypeIndex" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
allocationsLength :: Word32)) (Ptr Allocation
pAllocations) Ptr ("lostAllocationCount" ::: Word64)
offsets' Ptr ("lostAllocationCount" ::: Word64)
sizes'
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 ()
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))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaInvalidateAllocations" ffiVmaInvalidateAllocations
:: Allocator -> Word32 -> Ptr Allocation -> Ptr DeviceSize -> Ptr DeviceSize -> IO Result
invalidateAllocations :: forall io
. (MonadIO io)
=>
Allocator
->
("allocations" ::: Vector Allocation)
->
("offsets" ::: Vector DeviceSize)
->
("sizes" ::: Vector DeviceSize)
-> io ()
invalidateAllocations :: Allocator
-> ("allocations" ::: Vector Allocation)
-> ("offsets" ::: Vector ("lostAllocationCount" ::: Word64))
-> ("offsets" ::: Vector ("lostAllocationCount" ::: Word64))
-> io ()
invalidateAllocations allocator :: Allocator
allocator allocations :: "allocations" ::: Vector Allocation
allocations offsets :: "offsets" ::: Vector ("lostAllocationCount" ::: Word64)
offsets sizes :: "offsets" ::: Vector ("lostAllocationCount" ::: Word64)
sizes = 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 allocationsLength :: Int
allocationsLength = ("allocations" ::: Vector Allocation) -> Int
forall a. Vector a -> Int
Data.Vector.length (("allocations" ::: Vector Allocation) -> Int)
-> ("allocations" ::: Vector Allocation) -> Int
forall a b. (a -> b) -> a -> b
$ ("allocations" ::: Vector Allocation
allocations)
let offsetsLength :: Int
offsetsLength = ("offsets" ::: Vector ("lostAllocationCount" ::: Word64)) -> Int
forall a. Vector a -> Int
Data.Vector.length (("offsets" ::: Vector ("lostAllocationCount" ::: Word64)) -> Int)
-> ("offsets" ::: Vector ("lostAllocationCount" ::: Word64)) -> Int
forall a b. (a -> b) -> a -> b
$ ("offsets" ::: Vector ("lostAllocationCount" ::: Word64)
offsets)
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 (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offsetsLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
allocationsLength Bool -> Bool -> Bool
|| Int
offsetsLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (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 "" "offsets and allocations must have the same length" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
let sizesLength :: Int
sizesLength = ("offsets" ::: Vector ("lostAllocationCount" ::: Word64)) -> Int
forall a. Vector a -> Int
Data.Vector.length (("offsets" ::: Vector ("lostAllocationCount" ::: Word64)) -> Int)
-> ("offsets" ::: Vector ("lostAllocationCount" ::: Word64)) -> Int
forall a b. (a -> b) -> a -> b
$ ("offsets" ::: Vector ("lostAllocationCount" ::: Word64)
sizes)
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 (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sizesLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
allocationsLength Bool -> Bool -> Bool
|| Int
sizesLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (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 "" "sizes and allocations must have the same length" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
Ptr Allocation
pAllocations <- ((Ptr Allocation -> IO ()) -> IO ())
-> ContT () IO (Ptr Allocation)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Allocation -> IO ()) -> IO ())
-> ContT () IO (Ptr Allocation))
-> ((Ptr Allocation -> IO ()) -> IO ())
-> ContT () IO (Ptr Allocation)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr Allocation -> IO ()) -> IO ()
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Allocation ((("allocations" ::: Vector Allocation) -> Int
forall a. Vector a -> Int
Data.Vector.length ("allocations" ::: Vector Allocation
allocations)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 8
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
$ (Int -> Allocation -> IO ())
-> ("allocations" ::: Vector Allocation) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Allocation
e -> Ptr Allocation -> Allocation -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Allocation
pAllocations Ptr Allocation -> Int -> Ptr Allocation
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Allocation) (Allocation
e)) ("allocations" ::: Vector Allocation
allocations)
Ptr ("lostAllocationCount" ::: Word64)
offsets' <- if ("offsets" ::: Vector ("lostAllocationCount" ::: Word64)) -> Bool
forall a. Vector a -> Bool
Data.Vector.null ("offsets" ::: Vector ("lostAllocationCount" ::: Word64)
offsets)
then Ptr ("lostAllocationCount" ::: Word64)
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr ("lostAllocationCount" ::: Word64)
forall a. Ptr a
nullPtr
else do
Ptr ("lostAllocationCount" ::: Word64)
pOffsets <- ((Ptr ("lostAllocationCount" ::: Word64) -> IO ()) -> IO ())
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ("lostAllocationCount" ::: Word64) -> IO ()) -> IO ())
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64)))
-> ((Ptr ("lostAllocationCount" ::: Word64) -> IO ()) -> IO ())
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64))
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> (Ptr ("lostAllocationCount" ::: Word64) -> IO ())
-> IO ()
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @DeviceSize (((("offsets" ::: Vector ("lostAllocationCount" ::: Word64)) -> Int
forall a. Vector a -> Int
Data.Vector.length ("offsets" ::: Vector ("lostAllocationCount" ::: Word64)
offsets))) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 8
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
$ (Int -> ("lostAllocationCount" ::: Word64) -> IO ())
-> ("offsets" ::: Vector ("lostAllocationCount" ::: Word64))
-> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: "lostAllocationCount" ::: Word64
e -> Ptr ("lostAllocationCount" ::: Word64)
-> ("lostAllocationCount" ::: Word64) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ("lostAllocationCount" ::: Word64)
pOffsets Ptr ("lostAllocationCount" ::: Word64)
-> Int -> Ptr ("lostAllocationCount" ::: Word64)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr DeviceSize) ("lostAllocationCount" ::: Word64
e)) (("offsets" ::: Vector ("lostAllocationCount" ::: Word64)
offsets))
Ptr ("lostAllocationCount" ::: Word64)
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr ("lostAllocationCount" ::: Word64)
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64)))
-> Ptr ("lostAllocationCount" ::: Word64)
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64))
forall a b. (a -> b) -> a -> b
$ Ptr ("lostAllocationCount" ::: Word64)
pOffsets
Ptr ("lostAllocationCount" ::: Word64)
sizes' <- if ("offsets" ::: Vector ("lostAllocationCount" ::: Word64)) -> Bool
forall a. Vector a -> Bool
Data.Vector.null ("offsets" ::: Vector ("lostAllocationCount" ::: Word64)
sizes)
then Ptr ("lostAllocationCount" ::: Word64)
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr ("lostAllocationCount" ::: Word64)
forall a. Ptr a
nullPtr
else do
Ptr ("lostAllocationCount" ::: Word64)
pSizes <- ((Ptr ("lostAllocationCount" ::: Word64) -> IO ()) -> IO ())
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ("lostAllocationCount" ::: Word64) -> IO ()) -> IO ())
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64)))
-> ((Ptr ("lostAllocationCount" ::: Word64) -> IO ()) -> IO ())
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64))
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> (Ptr ("lostAllocationCount" ::: Word64) -> IO ())
-> IO ()
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @DeviceSize (((("offsets" ::: Vector ("lostAllocationCount" ::: Word64)) -> Int
forall a. Vector a -> Int
Data.Vector.length ("offsets" ::: Vector ("lostAllocationCount" ::: Word64)
sizes))) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 8
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
$ (Int -> ("lostAllocationCount" ::: Word64) -> IO ())
-> ("offsets" ::: Vector ("lostAllocationCount" ::: Word64))
-> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: "lostAllocationCount" ::: Word64
e -> Ptr ("lostAllocationCount" ::: Word64)
-> ("lostAllocationCount" ::: Word64) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ("lostAllocationCount" ::: Word64)
pSizes Ptr ("lostAllocationCount" ::: Word64)
-> Int -> Ptr ("lostAllocationCount" ::: Word64)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr DeviceSize) ("lostAllocationCount" ::: Word64
e)) (("offsets" ::: Vector ("lostAllocationCount" ::: Word64)
sizes))
Ptr ("lostAllocationCount" ::: Word64)
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr ("lostAllocationCount" ::: Word64)
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64)))
-> Ptr ("lostAllocationCount" ::: Word64)
-> ContT () IO (Ptr ("lostAllocationCount" ::: Word64))
forall a b. (a -> b) -> a -> b
$ Ptr ("lostAllocationCount" ::: Word64)
pSizes
Result
r <- IO Result -> ContT () IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT () IO Result)
-> IO Result -> ContT () IO Result
forall a b. (a -> b) -> a -> b
$ (Allocator
-> ("memoryTypeIndex" ::: Word32)
-> Ptr Allocation
-> Ptr ("lostAllocationCount" ::: Word64)
-> Ptr ("lostAllocationCount" ::: Word64)
-> IO Result
ffiVmaInvalidateAllocations) (Allocator
allocator) ((Int -> "memoryTypeIndex" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
allocationsLength :: Word32)) (Ptr Allocation
pAllocations) Ptr ("lostAllocationCount" ::: Word64)
offsets' Ptr ("lostAllocationCount" ::: Word64)
sizes'
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 ()
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))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaCheckCorruption" ffiVmaCheckCorruption
:: Allocator -> Word32 -> IO Result
checkCorruption :: forall io
. (MonadIO io)
=>
Allocator
->
("memoryTypeBits" ::: Word32)
-> io ()
checkCorruption :: Allocator -> ("memoryTypeIndex" ::: Word32) -> io ()
checkCorruption allocator :: Allocator
allocator memoryTypeBits :: "memoryTypeIndex" ::: Word32
memoryTypeBits = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
Result
r <- (Allocator -> ("memoryTypeIndex" ::: Word32) -> IO Result
ffiVmaCheckCorruption) (Allocator
allocator) ("memoryTypeIndex" ::: Word32
memoryTypeBits)
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))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaDefragmentationBegin" ffiVmaDefragmentationBegin
:: Allocator -> Ptr DefragmentationInfo2 -> Ptr DefragmentationStats -> Ptr DefragmentationContext -> IO Result
defragmentationBegin :: forall io
. (MonadIO io)
=>
Allocator
->
DefragmentationInfo2
-> io (Result, DefragmentationStats, DefragmentationContext)
defragmentationBegin :: Allocator
-> DefragmentationInfo2
-> io (Result, DefragmentationStats, DefragmentationContext)
defragmentationBegin allocator :: Allocator
allocator info :: DefragmentationInfo2
info = IO (Result, DefragmentationStats, DefragmentationContext)
-> io (Result, DefragmentationStats, DefragmentationContext)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, DefragmentationStats, DefragmentationContext)
-> io (Result, DefragmentationStats, DefragmentationContext))
-> (ContT
(Result, DefragmentationStats, DefragmentationContext)
IO
(Result, DefragmentationStats, DefragmentationContext)
-> IO (Result, DefragmentationStats, DefragmentationContext))
-> ContT
(Result, DefragmentationStats, DefragmentationContext)
IO
(Result, DefragmentationStats, DefragmentationContext)
-> io (Result, DefragmentationStats, DefragmentationContext)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
(Result, DefragmentationStats, DefragmentationContext)
IO
(Result, DefragmentationStats, DefragmentationContext)
-> IO (Result, DefragmentationStats, DefragmentationContext)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
(Result, DefragmentationStats, DefragmentationContext)
IO
(Result, DefragmentationStats, DefragmentationContext)
-> io (Result, DefragmentationStats, DefragmentationContext))
-> ContT
(Result, DefragmentationStats, DefragmentationContext)
IO
(Result, DefragmentationStats, DefragmentationContext)
-> io (Result, DefragmentationStats, DefragmentationContext)
forall a b. (a -> b) -> a -> b
$ do
Ptr DefragmentationInfo2
pInfo <- ((Ptr DefragmentationInfo2
-> IO (Result, DefragmentationStats, DefragmentationContext))
-> IO (Result, DefragmentationStats, DefragmentationContext))
-> ContT
(Result, DefragmentationStats, DefragmentationContext)
IO
(Ptr DefragmentationInfo2)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr DefragmentationInfo2
-> IO (Result, DefragmentationStats, DefragmentationContext))
-> IO (Result, DefragmentationStats, DefragmentationContext))
-> ContT
(Result, DefragmentationStats, DefragmentationContext)
IO
(Ptr DefragmentationInfo2))
-> ((Ptr DefragmentationInfo2
-> IO (Result, DefragmentationStats, DefragmentationContext))
-> IO (Result, DefragmentationStats, DefragmentationContext))
-> ContT
(Result, DefragmentationStats, DefragmentationContext)
IO
(Ptr DefragmentationInfo2)
forall a b. (a -> b) -> a -> b
$ DefragmentationInfo2
-> (Ptr DefragmentationInfo2
-> IO (Result, DefragmentationStats, DefragmentationContext))
-> IO (Result, DefragmentationStats, DefragmentationContext)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (DefragmentationInfo2
info)
Ptr DefragmentationStats
pPStats <- ((Ptr DefragmentationStats
-> IO (Result, DefragmentationStats, DefragmentationContext))
-> IO (Result, DefragmentationStats, DefragmentationContext))
-> ContT
(Result, DefragmentationStats, DefragmentationContext)
IO
(Ptr DefragmentationStats)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct DefragmentationStats =>
(Ptr DefragmentationStats -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @DefragmentationStats)
Ptr DefragmentationContext
pPContext <- ((Ptr DefragmentationContext
-> IO (Result, DefragmentationStats, DefragmentationContext))
-> IO (Result, DefragmentationStats, DefragmentationContext))
-> ContT
(Result, DefragmentationStats, DefragmentationContext)
IO
(Ptr DefragmentationContext)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr DefragmentationContext
-> IO (Result, DefragmentationStats, DefragmentationContext))
-> IO (Result, DefragmentationStats, DefragmentationContext))
-> ContT
(Result, DefragmentationStats, DefragmentationContext)
IO
(Ptr DefragmentationContext))
-> ((Ptr DefragmentationContext
-> IO (Result, DefragmentationStats, DefragmentationContext))
-> IO (Result, DefragmentationStats, DefragmentationContext))
-> ContT
(Result, DefragmentationStats, DefragmentationContext)
IO
(Ptr DefragmentationContext)
forall a b. (a -> b) -> a -> b
$ IO (Ptr DefragmentationContext)
-> (Ptr DefragmentationContext -> IO ())
-> (Ptr DefragmentationContext
-> IO (Result, DefragmentationStats, DefragmentationContext))
-> IO (Result, DefragmentationStats, DefragmentationContext)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr DefragmentationContext)
forall a. Int -> IO (Ptr a)
callocBytes @DefragmentationContext 8) Ptr DefragmentationContext -> IO ()
forall a. Ptr a -> IO ()
free
Result
r <- IO Result
-> ContT
(Result, DefragmentationStats, DefragmentationContext) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
-> ContT
(Result, DefragmentationStats, DefragmentationContext) IO Result)
-> IO Result
-> ContT
(Result, DefragmentationStats, DefragmentationContext) IO Result
forall a b. (a -> b) -> a -> b
$ (Allocator
-> Ptr DefragmentationInfo2
-> Ptr DefragmentationStats
-> Ptr DefragmentationContext
-> IO Result
ffiVmaDefragmentationBegin) (Allocator
allocator) Ptr DefragmentationInfo2
pInfo (Ptr DefragmentationStats
pPStats) (Ptr DefragmentationContext
pPContext)
IO ()
-> ContT
(Result, DefragmentationStats, DefragmentationContext) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
-> ContT
(Result, DefragmentationStats, DefragmentationContext) IO ())
-> IO ()
-> ContT
(Result, DefragmentationStats, DefragmentationContext) 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))
DefragmentationStats
pStats <- IO DefragmentationStats
-> ContT
(Result, DefragmentationStats, DefragmentationContext)
IO
DefragmentationStats
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO DefragmentationStats
-> ContT
(Result, DefragmentationStats, DefragmentationContext)
IO
DefragmentationStats)
-> IO DefragmentationStats
-> ContT
(Result, DefragmentationStats, DefragmentationContext)
IO
DefragmentationStats
forall a b. (a -> b) -> a -> b
$ Ptr DefragmentationStats -> IO DefragmentationStats
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @DefragmentationStats Ptr DefragmentationStats
pPStats
DefragmentationContext
pContext <- IO DefragmentationContext
-> ContT
(Result, DefragmentationStats, DefragmentationContext)
IO
DefragmentationContext
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO DefragmentationContext
-> ContT
(Result, DefragmentationStats, DefragmentationContext)
IO
DefragmentationContext)
-> IO DefragmentationContext
-> ContT
(Result, DefragmentationStats, DefragmentationContext)
IO
DefragmentationContext
forall a b. (a -> b) -> a -> b
$ Ptr DefragmentationContext -> IO DefragmentationContext
forall a. Storable a => Ptr a -> IO a
peek @DefragmentationContext Ptr DefragmentationContext
pPContext
(Result, DefragmentationStats, DefragmentationContext)
-> ContT
(Result, DefragmentationStats, DefragmentationContext)
IO
(Result, DefragmentationStats, DefragmentationContext)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, DefragmentationStats, DefragmentationContext)
-> ContT
(Result, DefragmentationStats, DefragmentationContext)
IO
(Result, DefragmentationStats, DefragmentationContext))
-> (Result, DefragmentationStats, DefragmentationContext)
-> ContT
(Result, DefragmentationStats, DefragmentationContext)
IO
(Result, DefragmentationStats, DefragmentationContext)
forall a b. (a -> b) -> a -> b
$ (Result
r, DefragmentationStats
pStats, DefragmentationContext
pContext)
withDefragmentation :: forall io r . MonadIO io => Allocator -> DefragmentationInfo2 -> (io (Result, DefragmentationStats, DefragmentationContext) -> ((Result, DefragmentationStats, DefragmentationContext) -> io ()) -> r) -> r
withDefragmentation :: Allocator
-> DefragmentationInfo2
-> (io (Result, DefragmentationStats, DefragmentationContext)
-> ((Result, DefragmentationStats, DefragmentationContext)
-> io ())
-> r)
-> r
withDefragmentation allocator :: Allocator
allocator pInfo :: DefragmentationInfo2
pInfo b :: io (Result, DefragmentationStats, DefragmentationContext)
-> ((Result, DefragmentationStats, DefragmentationContext)
-> io ())
-> r
b =
io (Result, DefragmentationStats, DefragmentationContext)
-> ((Result, DefragmentationStats, DefragmentationContext)
-> io ())
-> r
b (Allocator
-> DefragmentationInfo2
-> io (Result, DefragmentationStats, DefragmentationContext)
forall (io :: * -> *).
MonadIO io =>
Allocator
-> DefragmentationInfo2
-> io (Result, DefragmentationStats, DefragmentationContext)
defragmentationBegin Allocator
allocator DefragmentationInfo2
pInfo)
(\(_, _, o2 :: DefragmentationContext
o2) -> Allocator -> DefragmentationContext -> io ()
forall (io :: * -> *).
MonadIO io =>
Allocator -> DefragmentationContext -> io ()
defragmentationEnd Allocator
allocator DefragmentationContext
o2)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaDefragmentationEnd" ffiVmaDefragmentationEnd
:: Allocator -> DefragmentationContext -> IO Result
defragmentationEnd :: forall io
. (MonadIO io)
=>
Allocator
->
DefragmentationContext
-> io ()
defragmentationEnd :: Allocator -> DefragmentationContext -> io ()
defragmentationEnd allocator :: Allocator
allocator context :: DefragmentationContext
context = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
Result
r <- (Allocator -> DefragmentationContext -> IO Result
ffiVmaDefragmentationEnd) (Allocator
allocator) (DefragmentationContext
context)
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))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaBeginDefragmentationPass" ffiVmaBeginDefragmentationPass
:: Allocator -> DefragmentationContext -> Ptr DefragmentationPassInfo -> IO Result
beginDefragmentationPass :: forall io
. (MonadIO io)
=>
Allocator
->
DefragmentationContext
-> io (DefragmentationPassInfo)
beginDefragmentationPass :: Allocator -> DefragmentationContext -> io DefragmentationPassInfo
beginDefragmentationPass allocator :: Allocator
allocator context :: DefragmentationContext
context = IO DefragmentationPassInfo -> io DefragmentationPassInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DefragmentationPassInfo -> io DefragmentationPassInfo)
-> (ContT DefragmentationPassInfo IO DefragmentationPassInfo
-> IO DefragmentationPassInfo)
-> ContT DefragmentationPassInfo IO DefragmentationPassInfo
-> io DefragmentationPassInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT DefragmentationPassInfo IO DefragmentationPassInfo
-> IO DefragmentationPassInfo
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT DefragmentationPassInfo IO DefragmentationPassInfo
-> io DefragmentationPassInfo)
-> ContT DefragmentationPassInfo IO DefragmentationPassInfo
-> io DefragmentationPassInfo
forall a b. (a -> b) -> a -> b
$ do
Ptr DefragmentationPassInfo
pPInfo <- ((Ptr DefragmentationPassInfo -> IO DefragmentationPassInfo)
-> IO DefragmentationPassInfo)
-> ContT DefragmentationPassInfo IO (Ptr DefragmentationPassInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct DefragmentationPassInfo =>
(Ptr DefragmentationPassInfo -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @DefragmentationPassInfo)
Result
r <- IO Result -> ContT DefragmentationPassInfo IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT DefragmentationPassInfo IO Result)
-> IO Result -> ContT DefragmentationPassInfo IO Result
forall a b. (a -> b) -> a -> b
$ (Allocator
-> DefragmentationContext
-> Ptr DefragmentationPassInfo
-> IO Result
ffiVmaBeginDefragmentationPass) (Allocator
allocator) (DefragmentationContext
context) (Ptr DefragmentationPassInfo
pPInfo)
IO () -> ContT DefragmentationPassInfo IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT DefragmentationPassInfo IO ())
-> IO () -> ContT DefragmentationPassInfo 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))
DefragmentationPassInfo
pInfo <- IO DefragmentationPassInfo
-> ContT DefragmentationPassInfo IO DefragmentationPassInfo
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO DefragmentationPassInfo
-> ContT DefragmentationPassInfo IO DefragmentationPassInfo)
-> IO DefragmentationPassInfo
-> ContT DefragmentationPassInfo IO DefragmentationPassInfo
forall a b. (a -> b) -> a -> b
$ Ptr DefragmentationPassInfo -> IO DefragmentationPassInfo
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @DefragmentationPassInfo Ptr DefragmentationPassInfo
pPInfo
DefragmentationPassInfo
-> ContT DefragmentationPassInfo IO DefragmentationPassInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DefragmentationPassInfo
-> ContT DefragmentationPassInfo IO DefragmentationPassInfo)
-> DefragmentationPassInfo
-> ContT DefragmentationPassInfo IO DefragmentationPassInfo
forall a b. (a -> b) -> a -> b
$ (DefragmentationPassInfo
pInfo)
useDefragmentationPass :: forall io r . MonadIO io => Allocator -> DefragmentationContext -> ((DefragmentationPassInfo) -> io r) -> io r
useDefragmentationPass :: Allocator
-> DefragmentationContext
-> (DefragmentationPassInfo -> io r)
-> io r
useDefragmentationPass allocator :: Allocator
allocator context :: DefragmentationContext
context a :: DefragmentationPassInfo -> io r
a =
do
DefragmentationPassInfo
x <- Allocator -> DefragmentationContext -> io DefragmentationPassInfo
forall (io :: * -> *).
MonadIO io =>
Allocator -> DefragmentationContext -> io DefragmentationPassInfo
beginDefragmentationPass Allocator
allocator DefragmentationContext
context
r
r <- DefragmentationPassInfo -> io r
a DefragmentationPassInfo
x
(\(DefragmentationPassInfo
_) -> Allocator -> DefragmentationContext -> io ()
forall (io :: * -> *).
MonadIO io =>
Allocator -> DefragmentationContext -> io ()
endDefragmentationPass Allocator
allocator DefragmentationContext
context) DefragmentationPassInfo
x
r -> io r
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
r
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaEndDefragmentationPass" ffiVmaEndDefragmentationPass
:: Allocator -> DefragmentationContext -> IO Result
endDefragmentationPass :: forall io
. (MonadIO io)
=>
Allocator
->
DefragmentationContext
-> io ()
endDefragmentationPass :: Allocator -> DefragmentationContext -> io ()
endDefragmentationPass allocator :: Allocator
allocator context :: DefragmentationContext
context = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
Result
r <- (Allocator -> DefragmentationContext -> IO Result
ffiVmaEndDefragmentationPass) (Allocator
allocator) (DefragmentationContext
context)
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))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaDefragment" ffiVmaDefragment
:: Allocator -> Ptr Allocation -> CSize -> Ptr Bool32 -> Ptr DefragmentationInfo -> Ptr DefragmentationStats -> IO Result
defragment :: forall io
. (MonadIO io)
=>
Allocator
->
("allocations" ::: Vector Allocation)
->
("defragmentationInfo" ::: Maybe DefragmentationInfo)
-> io (("allocationsChanged" ::: Vector Bool), DefragmentationStats)
defragment :: Allocator
-> ("allocations" ::: Vector Allocation)
-> ("defragmentationInfo" ::: Maybe DefragmentationInfo)
-> io ("allocationsChanged" ::: Vector Bool, DefragmentationStats)
defragment allocator :: Allocator
allocator allocations :: "allocations" ::: Vector Allocation
allocations defragmentationInfo :: "defragmentationInfo" ::: Maybe DefragmentationInfo
defragmentationInfo = IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats)
-> io ("allocationsChanged" ::: Vector Bool, DefragmentationStats)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats)
-> io ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> (ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
-> io ("allocationsChanged" ::: Vector Bool, DefragmentationStats)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
-> io ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
-> io ("allocationsChanged" ::: Vector Bool, DefragmentationStats)
forall a b. (a -> b) -> a -> b
$ do
Ptr Allocation
pPAllocations <- ((Ptr Allocation
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
(Ptr Allocation)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Allocation
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
(Ptr Allocation))
-> ((Ptr Allocation
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
(Ptr Allocation)
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> (Ptr Allocation
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats)
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Allocation ((("allocations" ::: Vector Allocation) -> Int
forall a. Vector a -> Int
Data.Vector.length ("allocations" ::: Vector Allocation
allocations)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 8
IO ()
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats) IO ())
-> IO ()
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats) IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> Allocation -> IO ())
-> ("allocations" ::: Vector Allocation) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Allocation
e -> Ptr Allocation -> Allocation -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Allocation
pPAllocations Ptr Allocation -> Int -> Ptr Allocation
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Allocation) (Allocation
e)) ("allocations" ::: Vector Allocation
allocations)
Ptr Bool32
pPAllocationsChanged <- ((Ptr Bool32
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
(Ptr Bool32)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Bool32
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
(Ptr Bool32))
-> ((Ptr Bool32
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
(Ptr Bool32)
forall a b. (a -> b) -> a -> b
$ IO (Ptr Bool32)
-> (Ptr Bool32 -> IO ())
-> (Ptr Bool32
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr Bool32)
forall a. Int -> IO (Ptr a)
callocBytes @Bool32 ((CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("allocations" ::: Vector Allocation) -> Int
forall a. Vector a -> Int
Data.Vector.length (("allocations" ::: Vector Allocation) -> Int)
-> ("allocations" ::: Vector Allocation) -> Int
forall a b. (a -> b) -> a -> b
$ ("allocations" ::: Vector Allocation
allocations)) :: CSize))) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 4)) Ptr Bool32 -> IO ()
forall a. Ptr a -> IO ()
free
Ptr DefragmentationInfo
pDefragmentationInfo <- case ("defragmentationInfo" ::: Maybe DefragmentationInfo
defragmentationInfo) of
Nothing -> Ptr DefragmentationInfo
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
(Ptr DefragmentationInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr DefragmentationInfo
forall a. Ptr a
nullPtr
Just j :: DefragmentationInfo
j -> ((Ptr DefragmentationInfo
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
(Ptr DefragmentationInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr DefragmentationInfo
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
(Ptr DefragmentationInfo))
-> ((Ptr DefragmentationInfo
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
(Ptr DefragmentationInfo)
forall a b. (a -> b) -> a -> b
$ DefragmentationInfo
-> (Ptr DefragmentationInfo
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (DefragmentationInfo
j)
Ptr DefragmentationStats
pPDefragmentationStats <- ((Ptr DefragmentationStats
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> IO ("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
(Ptr DefragmentationStats)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct DefragmentationStats =>
(Ptr DefragmentationStats -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @DefragmentationStats)
Result
r <- IO Result
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
Result)
-> IO Result
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
Result
forall a b. (a -> b) -> a -> b
$ (Allocator
-> Ptr Allocation
-> CSize
-> Ptr Bool32
-> Ptr DefragmentationInfo
-> Ptr DefragmentationStats
-> IO Result
ffiVmaDefragment) (Allocator
allocator) (Ptr Allocation
pPAllocations) ((Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("allocations" ::: Vector Allocation) -> Int
forall a. Vector a -> Int
Data.Vector.length (("allocations" ::: Vector Allocation) -> Int)
-> ("allocations" ::: Vector Allocation) -> Int
forall a b. (a -> b) -> a -> b
$ ("allocations" ::: Vector Allocation
allocations)) :: CSize)) (Ptr Bool32
pPAllocationsChanged) Ptr DefragmentationInfo
pDefragmentationInfo (Ptr DefragmentationStats
pPDefragmentationStats)
IO ()
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats) IO ())
-> IO ()
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats) 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))
"allocationsChanged" ::: Vector Bool
pAllocationsChanged <- IO ("allocationsChanged" ::: Vector Bool)
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
("allocationsChanged" ::: Vector Bool)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("allocationsChanged" ::: Vector Bool)
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
("allocationsChanged" ::: Vector Bool))
-> IO ("allocationsChanged" ::: Vector Bool)
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
("allocationsChanged" ::: Vector Bool)
forall a b. (a -> b) -> a -> b
$ Int
-> (Int -> IO Bool) -> IO ("allocationsChanged" ::: Vector Bool)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (("allocations" ::: Vector Allocation) -> Int
forall a. Vector a -> Int
Data.Vector.length (("allocations" ::: Vector Allocation) -> Int)
-> ("allocations" ::: Vector Allocation) -> Int
forall a b. (a -> b) -> a -> b
$ ("allocations" ::: Vector Allocation
allocations)) :: CSize))) (\i :: Int
i -> do
Bool32
pAllocationsChangedElem <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr Bool32
pPAllocationsChanged Ptr Bool32 -> Int -> Ptr Bool32
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Bool32))
Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Bool32 -> Bool
bool32ToBool Bool32
pAllocationsChangedElem)
DefragmentationStats
pDefragmentationStats <- IO DefragmentationStats
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
DefragmentationStats
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO DefragmentationStats
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
DefragmentationStats)
-> IO DefragmentationStats
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
DefragmentationStats
forall a b. (a -> b) -> a -> b
$ Ptr DefragmentationStats -> IO DefragmentationStats
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @DefragmentationStats Ptr DefragmentationStats
pPDefragmentationStats
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("allocationsChanged" ::: Vector Bool, DefragmentationStats)
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
("allocationsChanged" ::: Vector Bool, DefragmentationStats))
-> ("allocationsChanged" ::: Vector Bool, DefragmentationStats)
-> ContT
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
IO
("allocationsChanged" ::: Vector Bool, DefragmentationStats)
forall a b. (a -> b) -> a -> b
$ ("allocationsChanged" ::: Vector Bool
pAllocationsChanged, DefragmentationStats
pDefragmentationStats)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaBindBufferMemory" ffiVmaBindBufferMemory
:: Allocator -> Allocation -> Buffer -> IO Result
bindBufferMemory :: forall io
. (MonadIO io)
=>
Allocator
->
Allocation
->
Buffer
-> io ()
bindBufferMemory :: Allocator -> Allocation -> Buffer -> io ()
bindBufferMemory allocator :: Allocator
allocator allocation :: Allocation
allocation buffer :: Buffer
buffer = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
Result
r <- (Allocator -> Allocation -> Buffer -> IO Result
ffiVmaBindBufferMemory) (Allocator
allocator) (Allocation
allocation) (Buffer
buffer)
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))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaBindBufferMemory2" ffiVmaBindBufferMemory2
:: Allocator -> Allocation -> DeviceSize -> Buffer -> Ptr () -> IO Result
bindBufferMemory2 :: forall io
. (MonadIO io)
=>
Allocator
->
Allocation
->
("allocationLocalOffset" ::: DeviceSize)
->
Buffer
->
("next" ::: Ptr ())
-> io ()
bindBufferMemory2 :: Allocator
-> Allocation
-> ("lostAllocationCount" ::: Word64)
-> Buffer
-> ("userData" ::: Ptr ())
-> io ()
bindBufferMemory2 allocator :: Allocator
allocator allocation :: Allocation
allocation allocationLocalOffset :: "lostAllocationCount" ::: Word64
allocationLocalOffset buffer :: Buffer
buffer next :: "userData" ::: Ptr ()
next = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
Result
r <- (Allocator
-> Allocation
-> ("lostAllocationCount" ::: Word64)
-> Buffer
-> ("userData" ::: Ptr ())
-> IO Result
ffiVmaBindBufferMemory2) (Allocator
allocator) (Allocation
allocation) ("lostAllocationCount" ::: Word64
allocationLocalOffset) (Buffer
buffer) ("userData" ::: Ptr ()
next)
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))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaBindImageMemory" ffiVmaBindImageMemory
:: Allocator -> Allocation -> Image -> IO Result
bindImageMemory :: forall io
. (MonadIO io)
=>
Allocator
->
Allocation
->
Image
-> io ()
bindImageMemory :: Allocator -> Allocation -> Image -> io ()
bindImageMemory allocator :: Allocator
allocator allocation :: Allocation
allocation image :: Image
image = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
Result
r <- (Allocator -> Allocation -> Image -> IO Result
ffiVmaBindImageMemory) (Allocator
allocator) (Allocation
allocation) (Image
image)
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))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaBindImageMemory2" ffiVmaBindImageMemory2
:: Allocator -> Allocation -> DeviceSize -> Image -> Ptr () -> IO Result
bindImageMemory2 :: forall io
. (MonadIO io)
=>
Allocator
->
Allocation
->
("allocationLocalOffset" ::: DeviceSize)
->
Image
->
("next" ::: Ptr ())
-> io ()
bindImageMemory2 :: Allocator
-> Allocation
-> ("lostAllocationCount" ::: Word64)
-> Image
-> ("userData" ::: Ptr ())
-> io ()
bindImageMemory2 allocator :: Allocator
allocator allocation :: Allocation
allocation allocationLocalOffset :: "lostAllocationCount" ::: Word64
allocationLocalOffset image :: Image
image next :: "userData" ::: Ptr ()
next = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
Result
r <- (Allocator
-> Allocation
-> ("lostAllocationCount" ::: Word64)
-> Image
-> ("userData" ::: Ptr ())
-> IO Result
ffiVmaBindImageMemory2) (Allocator
allocator) (Allocation
allocation) ("lostAllocationCount" ::: Word64
allocationLocalOffset) (Image
image) ("userData" ::: Ptr ()
next)
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))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaCreateBuffer" ffiVmaCreateBuffer
:: Allocator -> Ptr (SomeStruct BufferCreateInfo) -> Ptr AllocationCreateInfo -> Ptr Buffer -> Ptr Allocation -> Ptr AllocationInfo -> IO Result
createBuffer :: forall a io
. (Extendss BufferCreateInfo a, PokeChain a, MonadIO io)
=>
Allocator
->
(BufferCreateInfo a)
->
AllocationCreateInfo
-> io (Buffer, Allocation, AllocationInfo)
createBuffer :: Allocator
-> BufferCreateInfo a
-> AllocationCreateInfo
-> io (Buffer, Allocation, AllocationInfo)
createBuffer allocator :: Allocator
allocator bufferCreateInfo :: BufferCreateInfo a
bufferCreateInfo allocationCreateInfo :: AllocationCreateInfo
allocationCreateInfo = IO (Buffer, Allocation, AllocationInfo)
-> io (Buffer, Allocation, AllocationInfo)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Buffer, Allocation, AllocationInfo)
-> io (Buffer, Allocation, AllocationInfo))
-> (ContT
(Buffer, Allocation, AllocationInfo)
IO
(Buffer, Allocation, AllocationInfo)
-> IO (Buffer, Allocation, AllocationInfo))
-> ContT
(Buffer, Allocation, AllocationInfo)
IO
(Buffer, Allocation, AllocationInfo)
-> io (Buffer, Allocation, AllocationInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
(Buffer, Allocation, AllocationInfo)
IO
(Buffer, Allocation, AllocationInfo)
-> IO (Buffer, Allocation, AllocationInfo)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
(Buffer, Allocation, AllocationInfo)
IO
(Buffer, Allocation, AllocationInfo)
-> io (Buffer, Allocation, AllocationInfo))
-> ContT
(Buffer, Allocation, AllocationInfo)
IO
(Buffer, Allocation, AllocationInfo)
-> io (Buffer, Allocation, AllocationInfo)
forall a b. (a -> b) -> a -> b
$ do
Ptr (BufferCreateInfo a)
pBufferCreateInfo <- ((Ptr (BufferCreateInfo a)
-> IO (Buffer, Allocation, AllocationInfo))
-> IO (Buffer, Allocation, AllocationInfo))
-> ContT
(Buffer, Allocation, AllocationInfo) IO (Ptr (BufferCreateInfo a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (BufferCreateInfo a)
-> IO (Buffer, Allocation, AllocationInfo))
-> IO (Buffer, Allocation, AllocationInfo))
-> ContT
(Buffer, Allocation, AllocationInfo) IO (Ptr (BufferCreateInfo a)))
-> ((Ptr (BufferCreateInfo a)
-> IO (Buffer, Allocation, AllocationInfo))
-> IO (Buffer, Allocation, AllocationInfo))
-> ContT
(Buffer, Allocation, AllocationInfo) IO (Ptr (BufferCreateInfo a))
forall a b. (a -> b) -> a -> b
$ BufferCreateInfo a
-> (Ptr (BufferCreateInfo a)
-> IO (Buffer, Allocation, AllocationInfo))
-> IO (Buffer, Allocation, AllocationInfo)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (BufferCreateInfo a
bufferCreateInfo)
Ptr AllocationCreateInfo
pAllocationCreateInfo <- ((Ptr AllocationCreateInfo
-> IO (Buffer, Allocation, AllocationInfo))
-> IO (Buffer, Allocation, AllocationInfo))
-> ContT
(Buffer, Allocation, AllocationInfo) IO (Ptr AllocationCreateInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr AllocationCreateInfo
-> IO (Buffer, Allocation, AllocationInfo))
-> IO (Buffer, Allocation, AllocationInfo))
-> ContT
(Buffer, Allocation, AllocationInfo) IO (Ptr AllocationCreateInfo))
-> ((Ptr AllocationCreateInfo
-> IO (Buffer, Allocation, AllocationInfo))
-> IO (Buffer, Allocation, AllocationInfo))
-> ContT
(Buffer, Allocation, AllocationInfo) IO (Ptr AllocationCreateInfo)
forall a b. (a -> b) -> a -> b
$ AllocationCreateInfo
-> (Ptr AllocationCreateInfo
-> IO (Buffer, Allocation, AllocationInfo))
-> IO (Buffer, Allocation, AllocationInfo)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (AllocationCreateInfo
allocationCreateInfo)
Ptr Buffer
pPBuffer <- ((Ptr Buffer -> IO (Buffer, Allocation, AllocationInfo))
-> IO (Buffer, Allocation, AllocationInfo))
-> ContT (Buffer, Allocation, AllocationInfo) IO (Ptr Buffer)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Buffer -> IO (Buffer, Allocation, AllocationInfo))
-> IO (Buffer, Allocation, AllocationInfo))
-> ContT (Buffer, Allocation, AllocationInfo) IO (Ptr Buffer))
-> ((Ptr Buffer -> IO (Buffer, Allocation, AllocationInfo))
-> IO (Buffer, Allocation, AllocationInfo))
-> ContT (Buffer, Allocation, AllocationInfo) IO (Ptr Buffer)
forall a b. (a -> b) -> a -> b
$ IO (Ptr Buffer)
-> (Ptr Buffer -> IO ())
-> (Ptr Buffer -> IO (Buffer, Allocation, AllocationInfo))
-> IO (Buffer, Allocation, AllocationInfo)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr Buffer)
forall a. Int -> IO (Ptr a)
callocBytes @Buffer 8) Ptr Buffer -> IO ()
forall a. Ptr a -> IO ()
free
Ptr Allocation
pPAllocation <- ((Ptr Allocation -> IO (Buffer, Allocation, AllocationInfo))
-> IO (Buffer, Allocation, AllocationInfo))
-> ContT (Buffer, Allocation, AllocationInfo) IO (Ptr Allocation)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Allocation -> IO (Buffer, Allocation, AllocationInfo))
-> IO (Buffer, Allocation, AllocationInfo))
-> ContT (Buffer, Allocation, AllocationInfo) IO (Ptr Allocation))
-> ((Ptr Allocation -> IO (Buffer, Allocation, AllocationInfo))
-> IO (Buffer, Allocation, AllocationInfo))
-> ContT (Buffer, Allocation, AllocationInfo) IO (Ptr Allocation)
forall a b. (a -> b) -> a -> b
$ IO (Ptr Allocation)
-> (Ptr Allocation -> IO ())
-> (Ptr Allocation -> IO (Buffer, Allocation, AllocationInfo))
-> IO (Buffer, Allocation, AllocationInfo)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO (Ptr Allocation)
forall a. Int -> IO (Ptr a)
callocBytes @Allocation 8) Ptr Allocation -> IO ()
forall a. Ptr a -> IO ()
free
Ptr AllocationInfo
pPAllocationInfo <- ((Ptr AllocationInfo -> IO (Buffer, Allocation, AllocationInfo))
-> IO (Buffer, Allocation, AllocationInfo))
-> ContT
(Buffer, Allocation, AllocationInfo) IO (Ptr AllocationInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct AllocationInfo =>
(Ptr AllocationInfo -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @AllocationInfo)
Result
r <- IO Result -> ContT (Buffer, Allocation, AllocationInfo) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT (Buffer, Allocation, AllocationInfo) IO Result)
-> IO Result
-> ContT (Buffer, Allocation, AllocationInfo) IO Result
forall a b. (a -> b) -> a -> b
$ (Allocator
-> Ptr (SomeStruct BufferCreateInfo)
-> Ptr AllocationCreateInfo
-> Ptr Buffer
-> Ptr Allocation
-> Ptr AllocationInfo
-> IO Result
ffiVmaCreateBuffer) (Allocator
allocator) (Ptr (BufferCreateInfo a) -> Ptr (SomeStruct BufferCreateInfo)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr (BufferCreateInfo a)
pBufferCreateInfo) Ptr AllocationCreateInfo
pAllocationCreateInfo (Ptr Buffer
pPBuffer) (Ptr Allocation
pPAllocation) (Ptr AllocationInfo
pPAllocationInfo)
IO () -> ContT (Buffer, Allocation, AllocationInfo) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Buffer, Allocation, AllocationInfo) IO ())
-> IO () -> ContT (Buffer, Allocation, AllocationInfo) 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))
Buffer
pBuffer <- IO Buffer -> ContT (Buffer, Allocation, AllocationInfo) IO Buffer
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Buffer -> ContT (Buffer, Allocation, AllocationInfo) IO Buffer)
-> IO Buffer
-> ContT (Buffer, Allocation, AllocationInfo) IO Buffer
forall a b. (a -> b) -> a -> b
$ Ptr Buffer -> IO Buffer
forall a. Storable a => Ptr a -> IO a
peek @Buffer Ptr Buffer
pPBuffer
Allocation
pAllocation <- IO Allocation
-> ContT (Buffer, Allocation, AllocationInfo) IO Allocation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Allocation
-> ContT (Buffer, Allocation, AllocationInfo) IO Allocation)
-> IO Allocation
-> ContT (Buffer, Allocation, AllocationInfo) IO Allocation
forall a b. (a -> b) -> a -> b
$ Ptr Allocation -> IO Allocation
forall a. Storable a => Ptr a -> IO a
peek @Allocation Ptr Allocation
pPAllocation
AllocationInfo
pAllocationInfo <- IO AllocationInfo
-> ContT (Buffer, Allocation, AllocationInfo) IO AllocationInfo
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO AllocationInfo
-> ContT (Buffer, Allocation, AllocationInfo) IO AllocationInfo)
-> IO AllocationInfo
-> ContT (Buffer, Allocation, AllocationInfo) IO AllocationInfo
forall a b. (a -> b) -> a -> b
$ Ptr AllocationInfo -> IO AllocationInfo
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @AllocationInfo Ptr AllocationInfo
pPAllocationInfo
(Buffer, Allocation, AllocationInfo)
-> ContT
(Buffer, Allocation, AllocationInfo)
IO
(Buffer, Allocation, AllocationInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Buffer, Allocation, AllocationInfo)
-> ContT
(Buffer, Allocation, AllocationInfo)
IO
(Buffer, Allocation, AllocationInfo))
-> (Buffer, Allocation, AllocationInfo)
-> ContT
(Buffer, Allocation, AllocationInfo)
IO
(Buffer, Allocation, AllocationInfo)
forall a b. (a -> b) -> a -> b
$ (Buffer
pBuffer, Allocation
pAllocation, AllocationInfo
pAllocationInfo)
withBuffer :: forall a io r . (Extendss BufferCreateInfo a, PokeChain a, MonadIO io) => Allocator -> BufferCreateInfo a -> AllocationCreateInfo -> (io (Buffer, Allocation, AllocationInfo) -> ((Buffer, Allocation, AllocationInfo) -> io ()) -> r) -> r
withBuffer :: Allocator
-> BufferCreateInfo a
-> AllocationCreateInfo
-> (io (Buffer, Allocation, AllocationInfo)
-> ((Buffer, Allocation, AllocationInfo) -> io ()) -> r)
-> r
withBuffer allocator :: Allocator
allocator pBufferCreateInfo :: BufferCreateInfo a
pBufferCreateInfo pAllocationCreateInfo :: AllocationCreateInfo
pAllocationCreateInfo b :: io (Buffer, Allocation, AllocationInfo)
-> ((Buffer, Allocation, AllocationInfo) -> io ()) -> r
b =
io (Buffer, Allocation, AllocationInfo)
-> ((Buffer, Allocation, AllocationInfo) -> io ()) -> r
b (Allocator
-> BufferCreateInfo a
-> AllocationCreateInfo
-> io (Buffer, Allocation, AllocationInfo)
forall (a :: [*]) (io :: * -> *).
(Extendss BufferCreateInfo a, PokeChain a, MonadIO io) =>
Allocator
-> BufferCreateInfo a
-> AllocationCreateInfo
-> io (Buffer, Allocation, AllocationInfo)
createBuffer Allocator
allocator BufferCreateInfo a
pBufferCreateInfo AllocationCreateInfo
pAllocationCreateInfo)
(\(o0 :: Buffer
o0, o1 :: Allocation
o1, _) -> Allocator -> Buffer -> Allocation -> io ()
forall (io :: * -> *).
MonadIO io =>
Allocator -> Buffer -> Allocation -> io ()
destroyBuffer Allocator
allocator Buffer
o0 Allocation
o1)
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
unsafe
#endif
"vmaDestroyBuffer" ffiVmaDestroyBuffer
:: Allocator -> Buffer -> Allocation -> IO ()
destroyBuffer :: forall io
. (MonadIO io)
=>
Allocator
->
Buffer
->
Allocation
-> io ()
destroyBuffer :: Allocator -> Buffer -> Allocation -> io ()
destroyBuffer allocator :: Allocator
allocator buffer :: Buffer
buffer allocation :: Allocation
allocation = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
(Allocator -> Buffer -> Allocation -> IO ()
ffiVmaDestroyBuffer) (Allocator
allocator) (Buffer
buffer) (Allocation
allocation)
() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ ()
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)