vulkan-tutorial/src/Memory.hs

72 lines
2.1 KiB
Haskell
Raw Normal View History

2022-12-01 20:16:51 +00:00
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DataKinds #-}
2023-10-21 23:15:03 +00:00
{-# LANGUAGE OverloadedRecordDot #-}
2022-12-01 20:16:51 +00:00
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 $
2023-10-21 23:15:03 +00:00
Vk.pVkGetInstanceProcAddr (instance'.instanceCmds)
2022-12-02 15:58:57 +00:00
deviceProcAddr = castFunPtr $
2023-10-21 23:15:03 +00:00
Vk.pVkGetDeviceProcAddr (device.deviceCmds)
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
2023-05-01 17:13:21 +00:00
(_, allocator) <- VMA.withAllocator allocatorInfo allocate
2022-12-01 20:16:51 +00:00
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