successfully cerate a surface

This commit is contained in:
nek0 2022-01-17 21:52:39 +01:00
parent 2fa3e2a8d6
commit c2fc5e8a58
1 changed files with 50 additions and 9 deletions

View File

@ -11,7 +11,7 @@ import Control.Monad.Trans.Resource
import Control.Monad.Trans.Maybe
import Data.Bits
import qualified Data.ByteString as BS
import Data.Maybe (isNothing, fromMaybe)
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Vector as V
import Data.Word
@ -33,6 +33,7 @@ import qualified Vulkan.Utils.Initialization as Vk
import qualified Vulkan.Utils.QueueAssignment as Vk
import qualified Vulkan.Utils.Requirements as Vk
import qualified Vulkan.Zero as Vk
import qualified Vulkan as SDL
myApiVersion :: Word32
myApiVersion = Vk.API_VERSION_1_2
@ -81,22 +82,25 @@ initEngine = do
-- create the window
window <- SDL.createWindow "Vulkan window" windowConfig
initVulkan window
surface <- initVulkan window
return window
initVulkan :: MonadResource m => SDL.Window -> m ()
initVulkan :: MonadResource m => SDL.Window -> m SDL.VkSurfaceKHR
initVulkan window = do
vulkanInstance <- createInstance window
vulkanDevice <- pickPhysicalDevice vulkanInstance
liftIO $ print vulkanDevice
-- vulkanPhysicalDevice <- pickPhysicalDevice vulkanInstance
-- vulkanLogicalDevice <- createLogicalDevice vulkanPhysicalDevice
return ()
SDL.vkCreateSurface window (castPtr (Vk.instanceHandle vulkanInstance))
quitEngine :: MonadResource m => SDL.Window -> m ()
quitEngine window = liftIO $ do
quitEngine :: MonadResource m => SDL.Window -> Vk.Instance -> > m ()
quitEngine inst surface window = liftIO $ do
-- destroy instance
Vk.destroySurfaceKHR inst surface Nothing
-- destroy window
SDL.destroyWindow window
@ -143,8 +147,45 @@ isDeviceSuitable :: MonadResource m => Vk.PhysicalDevice -> m Bool
isDeviceSuitable device = do
props <- Vk.getPhysicalDeviceProperties device
features <- Vk.getPhysicalDeviceFeatures device
queues <- isJust <$> findQueueFamilies device
return
( Vk.deviceType props == Vk.PHYSICAL_DEVICE_TYPE_DISCRETE_GPU &&
Vk.geometryShader features
Vk.geometryShader features &&
queues
)
findQueueFamilies :: MonadIO m => Vk.PhysicalDevice -> m (Maybe Word32)
findQueueFamilies device = do
familyProperties <- Vk.getPhysicalDeviceQueueFamilyProperties device
return $ snd $ V.foldl
(\acc@(curInd, index) prop ->
let flags = Vk.queueFlags prop
in
( curInd + 1
, if (flags .&. Vk.QUEUE_GRAPHICS_BIT) == Vk.QueueFlagBits 0
then index
else Just curInd
)
)
(0, Nothing)
familyProperties
-- createLogicalDevice :: MonadResource m => Vk.PhysicalDevice -> m Vk.Device
-- createLogicalDevice device = do
-- queueFamilies <- liftIO $ Vk.getPhysicalDeviceQueueFamilyProperties device
-- index <- liftIO (fromJust <$> findQueueFamilies device)
-- let queueCreateInfo = Vk.zero
-- { Vk.queueFamilyIndex = index
-- , Vk.queuePriorities = V.singleton 1
-- }
-- deviceFeatures = Nothing
-- deviceCreateInfo = Vk.zero
-- { Vk.queueCreateInfos = V.singleton queueCreateInfo
-- , Vk.enabledFeatures = deviceFeatures
-- , Vk.enabledExtensionNames = V.empty
-- } :: Vk.DeviceCreateInfo '[]
-- Vk.createDevice device deviceCreateInfo Nothing
--