From 0d024661da41ece687f106a7a180734e2f458c61 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

---
 dear-imgui.cabal           |  4 ++--
 examples/vulkan/Backend.hs | 17 ++++++++++-------
 examples/vulkan/Main.hs    |  4 ++++
 3 files changed, 16 insertions(+), 9 deletions(-)

diff --git a/dear-imgui.cabal b/dear-imgui.cabal
index d058911..ec8fea4 100644
--- a/dear-imgui.cabal
+++ b/dear-imgui.cabal
@@ -233,7 +233,7 @@ library
     other-modules:
       DearImGui.Vulkan.Types
     build-depends:
-        vulkan
+        vulkan >= 3.20
       , unliftio
     cxx-sources:
       imgui/backends/imgui_impl_vulkan.cpp
@@ -415,7 +415,7 @@ executable vulkan
       , vector
          >= 0.12.1.2 && < 0.14
       , vulkan
-         >= 3.12
+         >= 3.20
       , vulkan-utils
          >= 0.5
       , VulkanMemoryAllocator
diff --git a/examples/vulkan/Backend.hs b/examples/vulkan/Backend.hs
index a6d446f..2a3df64 100644
--- a/examples/vulkan/Backend.hs
+++ b/examples/vulkan/Backend.hs
@@ -9,6 +9,7 @@
 {-# LANGUAGE MonoLocalBinds #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -99,6 +100,7 @@ import qualified Data.Vector as Boxed.Vector
 
 -- vulkan
 import qualified Vulkan
+import Vulkan.Core10.DeviceInitialization (pattern INSTANCE_CREATE_ENUMERATE_PORTABILITY_BIT_KHR)
 import qualified Vulkan.CStruct.Extends as Vulkan
 import qualified Vulkan.Requirement     as Vulkan
 import qualified Vulkan.Zero            as Vulkan
@@ -156,9 +158,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 +170,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 +239,7 @@ vulkanInstanceInfo appName = do
     createInfo =
       Vulkan.InstanceCreateInfo
         { Vulkan.next                  = ()
-        , Vulkan.flags                 = Vulkan.zero
+        , Vulkan.flags                 = 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
         }