From 71572a7412547f12567109d90b88a2578fd48a3b Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Sat, 13 Apr 2024 15:26:25 +0300
Subject: [PATCH] Add MoltenVK compat to vulkan example

---
 examples/vulkan/Backend.hs | 15 ++++++++-------
 examples/vulkan/Main.hs    |  4 ++++
 2 files changed, 12 insertions(+), 7 deletions(-)

diff --git a/examples/vulkan/Backend.hs b/examples/vulkan/Backend.hs
index a6d446f..6876add 100644
--- 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
index 6c0ffd6..ddcad4c 100644
--- 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
         }