From c2fc5e8a58e9a36211844f5662654f0e6a955cad Mon Sep 17 00:00:00 2001 From: nek0 Date: Mon, 17 Jan 2022 21:52:39 +0100 Subject: [PATCH] successfully cerate a surface --- src/Main.hs | 59 +++++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 50 insertions(+), 9 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 0dd074c..15af792 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -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 +--