Add MoltenVK compat to vulkan example

haskell-game · Apr 13, 2024 · 71572a7 · 71572a7
1 parent 1b40bc1
commit 71572a7
Show file tree

Hide file tree

Showing 2 changed files with 12 additions and 7 deletions.
diff --git a/examples/vulkan/Backend.hs b/examples/vulkan/Backend.hs
@@ -156,9 +156,10 @@ data InstanceType
 
 data VulkanRequirements =
   VulkanRequirements
-    { instanceRequirements :: [ Vulkan.InstanceRequirement ]
-    , deviceRequirements   :: [ Vulkan.DeviceRequirement   ]
-    , queueFlags           :: Vulkan.QueueFlags
+    { instanceRequirements    :: [ Vulkan.InstanceRequirement ]
+    , instanceRequirementsOpt :: [ Vulkan.InstanceRequirement ]
+    , deviceRequirements      :: [ Vulkan.DeviceRequirement   ]
+    , queueFlags              :: Vulkan.QueueFlags
     }
 
 data ValidationLayerName
@@ -167,12 +168,12 @@ data ValidationLayerName
   deriving stock ( Eq, Show )
 
 initialiseVulkanContext :: MonadVulkan m => InstanceType -> ByteString -> VulkanRequirements -> m VulkanContext
-initialiseVulkanContext instanceType appName ( VulkanRequirements { instanceRequirements, deviceRequirements, queueFlags } ) = do
+initialiseVulkanContext instanceType appName ( VulkanRequirements { instanceRequirements, instanceRequirementsOpt, deviceRequirements, queueFlags } ) = do
   logDebug "Creating Vulkan instance"
   instanceInfo    <- vulkanInstanceInfo appName
   instance'       <- case instanceType of
-    NormalInstance -> Vulkan.Utils.createInstanceFromRequirements      instanceRequirements [] instanceInfo
-    DebugInstance  -> Vulkan.Utils.createDebugInstanceFromRequirements instanceRequirements [] instanceInfo
+    NormalInstance -> Vulkan.Utils.createInstanceFromRequirements      instanceRequirements instanceRequirementsOpt instanceInfo
+    DebugInstance  -> Vulkan.Utils.createDebugInstanceFromRequirements instanceRequirements instanceRequirementsOpt instanceInfo
   physicalDevice  <- logDebug "Creating physical device"      *> createPhysicalDevice instance'
   queueFamily     <- logDebug "Finding suitable queue family" *> findQueueFamilyIndex physicalDevice queueFlags
   let
@@ -236,7 +237,7 @@ vulkanInstanceInfo appName = do
     createInfo =
       Vulkan.InstanceCreateInfo
         { Vulkan.next                  = ()
-        , Vulkan.flags                 = Vulkan.zero
+        , Vulkan.flags                 = Vulkan.INSTANCE_CREATE_ENUMERATE_PORTABILITY_BIT_KHR
         , Vulkan.applicationInfo       = Just appInfo
         , Vulkan.enabledLayerNames     = Boxed.Vector.fromList enabledLayers
         , Vulkan.enabledExtensionNames = mempty

diff --git a/examples/vulkan/Main.hs b/examples/vulkan/Main.hs
@@ -148,10 +148,14 @@ app = do
         , mouseMode  = SDL.AbsoluteLocation
         }
   let
+    compatExtensions =
+      [ Vulkan.KHR_PORTABILITY_ENUMERATION_EXTENSION_NAME
+      ]
     vulkanReqs :: VulkanRequirements
     vulkanReqs =
       VulkanRequirements
         { instanceRequirements = instanceExtensions windowExtensions
+        , instanceRequirementsOpt = instanceExtensions compatExtensions
         , deviceRequirements   = []
         , queueFlags           = Vulkan.QUEUE_GRAPHICS_BIT
         }