74 lines
2.3 KiB
Haskell
74 lines
2.3 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE DataKinds #-}
|
|
module Memory where
|
|
|
|
import Control.Monad.IO.Class
|
|
import Control.Monad.Trans.Resource
|
|
|
|
import Data.Bits ((.|.))
|
|
|
|
import Foreign.Ptr
|
|
|
|
import qualified VulkanMemoryAllocator as VMA
|
|
import qualified Vulkan.Core10 as Vk
|
|
import qualified Vulkan.Dynamic as Vk
|
|
import qualified Vulkan.Zero as Vk
|
|
|
|
-- internal imports
|
|
|
|
import Types
|
|
|
|
initAllocator
|
|
:: (MonadResource m, MonadFail m)
|
|
=> Vk.PhysicalDevice
|
|
-> Vk.Device
|
|
-> Vk.Instance
|
|
-> m VMA.Allocator
|
|
initAllocator physicalDevice device instance' = do
|
|
let instanceProcAddr = castFunPtr $
|
|
Vk.pVkGetInstanceProcAddr ((Vk.instanceCmds :: Vk.Instance -> Vk.InstanceCmds) instance')
|
|
deviceProcAddr = castFunPtr $
|
|
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
|
|
putStrLn "destroying allocator"
|
|
VMA.destroyAllocator allocator
|
|
)
|
|
|
|
return allocator
|
|
|
|
createAllocatedBuffer
|
|
:: (MonadResource m, MonadIO m)
|
|
=> VMA.Allocator
|
|
-> Int
|
|
-> Vk.BufferUsageFlags
|
|
-> VMA.MemoryUsage
|
|
-> m AllocatedBuffer
|
|
createAllocatedBuffer allocator allocationSize usage memoryUsage = do
|
|
let bufferCreateInfo = Vk.zero
|
|
{ Vk.size = fromIntegral allocationSize
|
|
, Vk.usage = usage
|
|
}
|
|
vmaAllocationInfo = Vk.zero
|
|
{ VMA.usage = memoryUsage
|
|
, 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
|
|
} :: VMA.AllocationCreateInfo
|
|
|
|
(_, (buffer, newAllocation, info)) <-
|
|
VMA.withBuffer allocator bufferCreateInfo vmaAllocationInfo allocate
|
|
|
|
return $ AllocatedBuffer buffer newAllocation info
|