vulkan-tutorial/src/Memory.hs

71 lines
2.1 KiB
Haskell

{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedRecordDot #-}
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 (instance'.instanceCmds)
deviceProcAddr = castFunPtr $
Vk.pVkGetDeviceProcAddr (device.deviceCmds)
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) <- VMA.withAllocator allocatorInfo allocate
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