successfully cerate a surface

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
+  -- vulkanPhysicalDevice <- pickPhysicalDevice vulkanInstance
-  liftIO $ print vulkanDevice
+  -- vulkanLogicalDevice <- createLogicalDevice vulkanPhysicalDevice
 
-  return ()
+  SDL.vkCreateSurface window (castPtr (Vk.instanceHandle vulkanInstance))
 
 
-quitEngine :: MonadResource m => SDL.Window -> m ()
+quitEngine :: MonadResource m => SDL.Window -> Vk.Instance -> > m ()
-quitEngine window = liftIO $ do
+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
+--