81 lines
3 KiB
Haskell
81 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
|