vulkan-tutorial/src/Instance.hs

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

import Control.Monad.IO.Class
import Control.Monad.Trans.Resource
import qualified Data.ByteString as BS
import qualified Data.Vector as V
import qualified SDL hiding (V2)
import qualified SDL.Video.Vulkan as SDL
import qualified Vulkan as Vk
import qualified Vulkan.Zero as Vk

createInstance :: MonadResource m => SDL.Window -> m Vk.Instance
createInstance window = do
  windowExtensions <-
    (++) [Vk.KHR_PUSH_DESCRIPTOR_EXTENSION_NAME, Vk.EXT_DEBUG_UTILS_EXTENSION_NAME] <$>
      ((liftIO . mapM BS.packCString) =<< SDL.vkGetInstanceExtensions window)
  liftIO $ do
    putStrLn "activating followinfg extensions:"
    print windowExtensions
  let createInfo = Vk.zero
        { Vk.applicationInfo       = Just Vk.zero
          { Vk.applicationName = Just "Haskell ❤️ Vulkan"
          , Vk.apiVersion      = Vk.API_VERSION_1_3
          }
          -- enable debug util extension for debugging purposes
        , Vk.enabledExtensionNames = V.fromList windowExtensions
          -- enable validation layer for debugging purposes
        , Vk.enabledLayerNames     = V.singleton "VK_LAYER_KHRONOS_validation"
        }

  SDL.vkLoadLibrary Nothing

  (_, inst) <- allocate
    (Vk.createInstance createInfo Nothing)
    (\inst -> do
      putStrLn "destroying instance"
      Vk.destroyInstance inst Nothing
      )

  return inst