{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DataKinds #-} module Memory where import Control.Monad.IO.Class import Control.Monad.Trans.Resource 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) => Vk.Device -> VMA.Allocator -> Int -> Vk.BufferUsageFlags -> VMA.MemoryUsage -> m AllocatedBuffer createAllocatedBuffer device allocator allocationSize usage memoryUsage = do 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) (\(buffer, newAllocation, _) -> do putStrLn "destroying buffer" VMA.destroyBuffer allocator buffer newAllocation ) return $ AllocatedBuffer buffer newAllocation