45 lines
1.5 KiB
Haskell
45 lines
1.5 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE DataKinds #-}
|
|
module Memory where
|
|
|
|
import Control.Monad.IO.Class (liftIO)
|
|
import Control.Monad.Trans.Resource
|
|
|
|
import Foreign.Ptr
|
|
import Foreign.Storable
|
|
|
|
import qualified VulkanMemoryAllocator as VMA
|
|
import qualified Vulkan.Core10 as Vk
|
|
import qualified Vulkan.Dynamic as Vk
|
|
import qualified Vulkan.Zero as Vk
|
|
|
|
initAllocator
|
|
:: (MonadResource m, MonadFail m)
|
|
=> Vk.PhysicalDevice
|
|
-> Vk.Device
|
|
-> Vk.Instance
|
|
-> m VMA.Allocator
|
|
initAllocator physicalDevice device instance' = do
|
|
instanceProcAddr <- liftIO $ peek $ castFunPtrToPtr $
|
|
Vk.pVkGetInstanceProcAddr ((Vk.instanceCmds :: Vk.Instance -> Vk.InstanceCmds) instance')
|
|
deviceProcAddr <- liftIO $ peek $ castFunPtrToPtr $
|
|
Vk.pVkGetDeviceProcAddr ((Vk.deviceCmds :: Vk.Device -> Vk.DeviceCmds) device)
|
|
let allocatorInfo = Vk.zero
|
|
{ VMA.physicalDevice = Vk.physicalDeviceHandle physicalDevice
|
|
, VMA.device = Vk.deviceHandle device
|
|
, VMA.instance' = Vk.instanceHandle instance'
|
|
, VMA.vulkanFunctions = Just (Vk.zero
|
|
{ VMA.vkGetInstanceProcAddr = instanceProcAddr
|
|
, VMA.vkGetDeviceProcAddr = deviceProcAddr
|
|
} :: VMA.VulkanFunctions)
|
|
} :: VMA.AllocatorCreateInfo
|
|
|
|
(_, allocator) <- allocate
|
|
(VMA.createAllocator allocatorInfo)
|
|
(\allocator -> do
|
|
print ("destroying allocator" :: String)
|
|
VMA.destroyAllocator allocator
|
|
)
|
|
|
|
return allocator
|