vulkan-tutorial/src/Memory.hs

75 lines
2.3 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
2023-04-19 15:26:33 +00:00
import Data.Bits ((.|.))
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-04-20 04:21:43 +00:00
let bufferCreateInfo = Vk.zero
2023-01-06 19:02:17 +00:00
{ Vk.size = fromIntegral allocationSize
, Vk.usage = usage
}
vmaAllocationInfo = Vk.zero
{ VMA.usage = memoryUsage
2023-04-19 15:26:33 +00:00
, VMA.flags = VMA.ALLOCATION_CREATE_MAPPED_BIT
, VMA.requiredFlags = Vk.MEMORY_PROPERTY_HOST_VISIBLE_BIT .|. Vk.MEMORY_PROPERTY_HOST_COHERENT_BIT
, VMA.preferredFlags = Vk.MEMORY_PROPERTY_DEVICE_LOCAL_BIT
2023-01-06 19:02:17 +00:00
} :: VMA.AllocationCreateInfo
2023-04-29 00:10:27 +00:00
(_, (buffer, newAllocation, info)) <-
VMA.withBuffer allocator bufferCreateInfo vmaAllocationInfo allocate
2023-01-06 19:02:17 +00:00
2023-04-19 15:26:33 +00:00
return $ AllocatedBuffer buffer newAllocation info