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.Requirement as Vk
import qualified Vulkan.Zero as Vk
import qualified Vulkan.Utils.Initialization as VkU

createInstance :: MonadResource m => SDL.Window -> m Vk.Instance
createInstance window = do
  windowExtensions <-
    (++)
      -- [ Vk.KHR_PUSH_DESCRIPTOR_EXTENSION_NAME
      -- , Vk.EXT_DEBUG_UTILS_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_2
          }
          -- enable debug util extension for debugging purposes
        , Vk.enabledExtensionNames = V.fromList windowExtensions
          -- enable validation layer for debugging purposes
        , Vk.enabledLayerNames     = V.fromList
          [ "VK_LAYER_KHRONOS_validation"
          ]
        }
      requirements =
        [ Vk.RequireInstanceExtension
          { Vk.instanceExtensionLayerName  = Nothing
          , Vk.instanceExtensionName       = Vk.KHR_GET_DISPLAY_PROPERTIES_2_EXTENSION_NAME
          , Vk.instanceExtensionMinVersion = Vk.KHR_GET_DISPLAY_PROPERTIES_2_SPEC_VERSION
          }
        , Vk.RequireInstanceExtension
          { Vk.instanceExtensionLayerName  = Nothing
          , Vk.instanceExtensionName       = Vk.KHR_XLIB_SURFACE_EXTENSION_NAME
          , Vk.instanceExtensionMinVersion = Vk.KHR_XLIB_SURFACE_SPEC_VERSION
          }
        , Vk.RequireInstanceExtension
          { Vk.instanceExtensionLayerName  = Nothing
          , Vk.instanceExtensionName       = Vk.KHR_DISPLAY_EXTENSION_NAME
          , Vk.instanceExtensionMinVersion = Vk.KHR_DISPLAY_SPEC_VERSION
          }
        , Vk.RequireInstanceExtension
          { Vk.instanceExtensionLayerName  = Nothing
          , Vk.instanceExtensionName       = Vk.KHR_SURFACE_EXTENSION_NAME
          , Vk.instanceExtensionMinVersion = Vk.KHR_SURFACE_SPEC_VERSION
          }
        , Vk.RequireInstanceExtension
          { Vk.instanceExtensionLayerName  = Nothing
          , Vk.instanceExtensionName       = Vk.KHR_PUSH_DESCRIPTOR_EXTENSION_NAME
          , Vk.instanceExtensionMinVersion = Vk.KHR_PUSH_DESCRIPTOR_SPEC_VERSION
          }
        ]

  SDL.vkLoadLibrary Nothing

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

  return inst