vulkan-tutorial/src/Memory.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DataKinds #-}
module Memory where

import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Resource

import Foreign.Ptr
import Foreign.Storable

import qualified VulkanMemoryAllocator as VMA
import qualified Vulkan.Core10 as Vk
import qualified Vulkan.Dynamic as Vk
import qualified Vulkan.Zero as Vk

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