vulkan-tutorial/src/Instance.hs
2023-01-16 01:10:23 +01:00

82 lines
3 KiB
Haskell

{-# 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