vulkan-tutorial/src/Memory.hs

74 lines
2.2 KiB
Haskell
Raw Normal View History

2022-12-01 20:16:51 +00:00
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DataKinds #-}
module Memory where
2023-01-06 19:02:17 +00:00
import Control.Monad.IO.Class
2022-12-01 20:16:51 +00:00
import Control.Monad.Trans.Resource
2022-12-02 01:57:00 +00:00
import Foreign.Ptr
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
2023-01-06 19:02:17 +00:00
-- internal imports
import Types
2022-12-01 20:16:51 +00:00
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
2023-01-06 19:02:17 +00:00
createAllocatedBuffer
:: (MonadResource m, MonadIO m)
2023-04-02 08:46:02 +00:00
=> VMA.Allocator
2023-01-06 19:02:17 +00:00
-> Int
-> Vk.BufferUsageFlags
-> VMA.MemoryUsage
-> m AllocatedBuffer
2023-04-02 08:46:02 +00:00
createAllocatedBuffer allocator allocationSize usage memoryUsage = do
2023-01-06 19:02:17 +00:00
let bufferInfo = Vk.zero
{ Vk.size = fromIntegral allocationSize
, Vk.usage = usage
}
vmaAllocationInfo = Vk.zero
{ VMA.usage = memoryUsage
} :: VMA.AllocationCreateInfo
(_, (buffer, newAllocation, _)) <- allocate
(VMA.createBuffer allocator bufferInfo vmaAllocationInfo)
2023-01-16 00:10:23 +00:00
(\(buffer, newAllocation, _) -> do
2023-01-06 19:02:17 +00:00
putStrLn "destroying buffer"
2023-01-16 00:10:23 +00:00
VMA.destroyBuffer allocator buffer newAllocation
2023-01-06 19:02:17 +00:00
)
return $ AllocatedBuffer buffer newAllocation