vulkan-tutorial/src/Memory.hs

46 lines
1.4 KiB
Haskell
Raw Normal View History

2022-12-01 20:16:51 +00:00
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DataKinds #-}
module Memory where
2022-12-02 01:57:00 +00:00
import Control.Monad.IO.Class (liftIO)
2022-12-01 20:16:51 +00:00
import Control.Monad.Trans.Resource
2022-12-02 01:57:00 +00:00
import Foreign.Ptr
import Foreign.Storable
2022-12-01 20:16:51 +00:00
import qualified VulkanMemoryAllocator as VMA
import qualified Vulkan.Core10 as Vk
2022-12-02 01:57:00 +00:00
import qualified Vulkan.Dynamic as Vk
2022-12-01 20:16:51 +00:00
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
2022-12-02 15:58:57 +00:00
let instanceProcAddr = castFunPtr $
Vk.pVkGetInstanceProcAddr ((Vk.instanceCmds :: Vk.Instance -> Vk.InstanceCmds) instance')
deviceProcAddr = castFunPtr $
Vk.pVkGetDeviceProcAddr ((Vk.deviceCmds :: Vk.Device -> Vk.DeviceCmds) device)
2022-12-01 20:16:51 +00:00
let allocatorInfo = Vk.zero
2022-12-02 01:57:00 +00:00
{ 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)
2022-12-01 20:16:51 +00:00
} :: VMA.AllocatorCreateInfo
(_, allocator) <- allocate
(VMA.createAllocator allocatorInfo)
(\allocator -> do
2022-12-02 19:34:35 +00:00
putStrLn "destroying allocator"
2022-12-01 20:16:51 +00:00
VMA.destroyAllocator allocator
)
return allocator