Fix font and dynamic rendering breakage in vulkan backend

examples/vulkan/Main.hs

@@ -391,16 +391,15 @@ app = do
       , device
       , queueFamily
       , queue
-      , pipelineCache         = Vulkan.NULL_HANDLE
-      , descriptorPool        = imGuiDescriptorPool
-      , subpass               = 0
+      , pipelineCache  = Vulkan.NULL_HANDLE
+      , descriptorPool = imGuiDescriptorPool
+      , subpass        = 0
       , minImageCount
       , imageCount
-      , msaaSamples           = Vulkan.SAMPLE_COUNT_1_BIT
-      , mbAllocator           = Nothing
-      , useDynamicRendering   = False
-      , colorAttachmentFormat = Nothing
-      , checkResult           = \case { Vulkan.SUCCESS -> pure (); e -> throw $ Vulkan.VulkanException e }
+      , msaaSamples    = Vulkan.SAMPLE_COUNT_1_BIT
+      , mbAllocator    = Nothing
+      , rendering      = Left imGuiRenderPass
+      , checkResult    = \case { Vulkan.SUCCESS -> pure (); e -> throw $ Vulkan.VulkanException e }
       }
 
   logDebug "Initialising ImGui SDL2 for Vulkan"
@@ -409,7 +408,7 @@ app = do
     ( const ImGui.SDL.sdl2Shutdown )
 
   logDebug "Initialising ImGui for Vulkan"
-  ImGui.Vulkan.withVulkan initInfo imGuiRenderPass \ _ -> do
+  ImGui.Vulkan.withVulkan initInfo \ _ -> do
 
     logDebug "Running one-shot commands to upload ImGui textures"
     logDebug "Creating fence"
@@ -421,7 +420,9 @@ app = do
 
     logDebug "Recording one-shot commands"
     beginCommandBuffer oneshotCommandBuffer
-    _ <- ImGui.Vulkan.vulkanCreateFontsTexture oneshotCommandBuffer
+
+    logDebug "ImGui preparing fonts texture"
+    _ <- ImGui.Vulkan.vulkanCreateFontsTexture
 
     logDebug "Uploading texture"
     let textureSubresource = Vulkan.ImageSubresourceRange
@@ -497,8 +498,6 @@ app = do
     waitForFences device ( WaitAll [ fence ] )
 
     logDebug "Finished uploading font objects"
-    logDebug "Cleaning up one-shot commands"
-    ImGui.Vulkan.vulkanDestroyFontUploadObjects
     traverse_ ResourceT.release [ fenceKey, oneshotCommandBufferKey, stageKey ]
 
     logDebug "Adding imgui texture"

src/DearImGui/Vulkan.hs

@@ -17,7 +17,7 @@ module DearImGui.Vulkan
   , vulkanNewFrame
   , vulkanRenderDrawData
   , vulkanCreateFontsTexture
-  , vulkanDestroyFontUploadObjects
+  , vulkanDestroyFontsTexture
   , vulkanSetMinImageCount
 
   , vulkanAddTexture
@@ -27,6 +27,8 @@ module DearImGui.Vulkan
 -- base
 import Data.Maybe
   ( fromMaybe )
+import Data.Either
+  ( isRight )
 import Data.Word
   ( Word32 )
 import Foreign.Marshal.Alloc
@@ -56,53 +58,54 @@ import UnliftIO.Exception
 
 -- vulkan
 import qualified Vulkan
+import Vulkan.Zero
+  ( zero )
 
 -- DearImGui
 import DearImGui
   ( DrawData(..) )
 import DearImGui.Vulkan.Types
   ( vulkanCtx )
 
-
 C.context ( Cpp.cppCtx <> C.funCtx <> vulkanCtx )
+C.include "string.h"
 C.include "imgui.h"
 C.include "backends/imgui_impl_vulkan.h"
 Cpp.using "namespace ImGui"
 
 
 data InitInfo =
   InitInfo
-  { instance'             :: !Vulkan.Instance
-  , physicalDevice        :: !Vulkan.PhysicalDevice
-  , device                :: !Vulkan.Device
-  , queueFamily           :: !Word32
-  , queue                 :: !Vulkan.Queue
-  , pipelineCache         :: !Vulkan.PipelineCache
-  , descriptorPool        :: !Vulkan.DescriptorPool
-  , subpass               :: !Word32
-  , minImageCount         :: !Word32
-  , imageCount            :: !Word32
-  , msaaSamples           :: !Vulkan.SampleCountFlagBits
-  , colorAttachmentFormat :: !(Maybe Vulkan.Format)
-  , useDynamicRendering   :: !Bool
-  , mbAllocator           :: Maybe Vulkan.AllocationCallbacks
-  , checkResult           :: Vulkan.Result -> IO ()
+  { instance'      :: !Vulkan.Instance
+  , physicalDevice :: !Vulkan.PhysicalDevice
+  , device         :: !Vulkan.Device
+  , queueFamily    :: !Word32
+  , queue          :: !Vulkan.Queue
+  , pipelineCache  :: !Vulkan.PipelineCache
+  , descriptorPool :: !Vulkan.DescriptorPool
+  , subpass        :: !Word32
+  , minImageCount  :: !Word32
+  , imageCount     :: !Word32
+  , msaaSamples    :: !Vulkan.SampleCountFlagBits
+  , rendering      :: Either Vulkan.RenderPass Vulkan.PipelineRenderingCreateInfo
+  , mbAllocator    :: Maybe Vulkan.AllocationCallbacks
+  , checkResult    :: Vulkan.Result -> IO ()
   }
 
 -- | Wraps @ImGui_ImplVulkan_Init@ and @ImGui_ImplVulkan_Shutdown@.
-withVulkan :: MonadUnliftIO m => InitInfo -> Vulkan.RenderPass -> ( Bool -> m a ) -> m a
-withVulkan initInfo renderPass action =
+withVulkan :: MonadUnliftIO m => InitInfo -> ( Bool -> m a ) -> m a
+withVulkan initInfo action =
   bracket
-    ( vulkanInit initInfo renderPass )
+    ( vulkanInit initInfo )
     vulkanShutdown
     ( \ ( _, initResult ) -> action initResult )
 
 -- | Wraps @ImGui_ImplVulkan_Init@.
 --
 -- Use 'vulkanShutdown' to clean up on shutdown.
 -- Prefer using 'withVulkan' when possible, as it automatically handles cleanup.
-vulkanInit :: MonadIO m => InitInfo -> Vulkan.RenderPass -> m (FunPtr (Vulkan.Result -> IO ()), Bool)
-vulkanInit ( InitInfo {..} ) renderPass = do
+vulkanInit :: MonadIO m => InitInfo -> m (FunPtr (Vulkan.Result -> IO ()), Bool)
+vulkanInit ( InitInfo {..} ) = liftIO do
   let
     instancePtr :: Ptr Vulkan.Instance_T
     instancePtr = Vulkan.instanceHandle instance'
@@ -117,14 +120,20 @@ vulkanInit ( InitInfo {..} ) renderPass = do
       Nothing        -> f nullPtr
       Just callbacks -> alloca ( \ ptr -> poke ptr callbacks *> f ptr )
     useDynamicRendering' :: Cpp.CBool
-    useDynamicRendering' = fromBool useDynamicRendering
-    colorAttachmentFormat' :: Vulkan.Format
-    colorAttachmentFormat' = fromMaybe Vulkan.FORMAT_UNDEFINED colorAttachmentFormat
-  liftIO do
+    useDynamicRendering' = fromBool (isRight rendering)
+    renderPass :: Vulkan.RenderPass
+    renderPass = either id (const zero) rendering
+  Vulkan.withCStruct (either (const zero) id rendering) \pipelineRenderingCIPtr -> do
     checkResultFunPtr <- $( C.mkFunPtr [t| Vulkan.Result -> IO () |] ) checkResult
-    initResult <- withCallbacks \ callbacksPtr ->
+    initResult <- withCallbacks \ callbacksPtr -> do
         [C.block| bool {
-          ImGui_ImplVulkan_InitInfo initInfo;
+          ImGui_ImplVulkan_InitInfo initInfo = {0,};
+
+          #ifdef IMGUI_IMPL_VULKAN_HAS_DYNAMIC_RENDERING
+          VkPipelineRenderingCreateInfoKHR pipelineRenderingCI;
+          memset(&pipelineRenderingCI, 0, sizeof(VkPipelineRenderingCreateInfoKHR));
+          #endif
+
           VkInstance instance = { $( VkInstance_T* instancePtr ) };
           initInfo.Instance = instance;
           VkPhysicalDevice physicalDevice = { $( VkPhysicalDevice_T* physicalDevicePtr ) };
@@ -142,9 +151,12 @@ vulkanInit ( InitInfo {..} ) renderPass = do
           initInfo.MSAASamples = $(VkSampleCountFlagBits msaaSamples);
           initInfo.Allocator = $(VkAllocationCallbacks* callbacksPtr);
           initInfo.CheckVkResultFn = $( void (*checkResultFunPtr)(VkResult) );
+
           initInfo.UseDynamicRendering = $(bool useDynamicRendering');
-          initInfo.ColorAttachmentFormat = $(VkFormat colorAttachmentFormat');
-          return ImGui_ImplVulkan_Init(&initInfo, $(VkRenderPass renderPass) );
+          initInfo.RenderPass = $(VkRenderPass renderPass);
+          if ($(VkPipelineRenderingCreateInfo* pipelineRenderingCIPtr))
+            memcpy(&initInfo.PipelineRenderingCreateInfo, $(VkPipelineRenderingCreateInfo* pipelineRenderingCIPtr), sizeof(VkPipelineRenderingCreateInfo));
+          return ImGui_ImplVulkan_Init(&initInfo);
         }|]
     pure ( checkResultFunPtr, initResult /= 0 )
 
@@ -175,22 +187,21 @@ vulkanRenderDrawData (DrawData dataPtr) commandBuffer mbPipeline = liftIO do
   }|]
 
 -- | Wraps @ImGui_ImplVulkan_CreateFontsTexture@.
-vulkanCreateFontsTexture :: MonadIO m => Vulkan.CommandBuffer -> m Bool
-vulkanCreateFontsTexture commandBuffer = liftIO do
-  let
-    commandBufferPtr :: Ptr Vulkan.CommandBuffer_T
-    commandBufferPtr = Vulkan.commandBufferHandle commandBuffer
+vulkanCreateFontsTexture :: MonadIO m => m Bool
+vulkanCreateFontsTexture = liftIO do
   res <-
     [C.block| bool {
-      VkCommandBuffer commandBuffer = { $( VkCommandBuffer_T* commandBufferPtr ) };
-      return ImGui_ImplVulkan_CreateFontsTexture(commandBuffer);
+      return ImGui_ImplVulkan_CreateFontsTexture();
     }|]
   pure ( res /= 0 )
 
--- | Wraps @ImGui_ImplVulkan_DestroyFontUploadObjects@.
-vulkanDestroyFontUploadObjects :: MonadIO m => m ()
-vulkanDestroyFontUploadObjects = liftIO do
-  [C.exp| void { ImGui_ImplVulkan_DestroyFontUploadObjects(); } |]
+-- | You probably never need to call this, as it is called by ImGui_ImplVulkan_CreateFontsTexture() and ImGui_ImplVulkan_Shutdown().
+-- | Wraps @ImGui_ImplVulkan_DestroyFontsTexture@.
+vulkanDestroyFontsTexture :: MonadIO m => m ()
+vulkanDestroyFontsTexture = liftIO do
+  [C.block| void {
+    return ImGui_ImplVulkan_DestroyFontsTexture();
+  }|]
 
 -- | Wraps @ImGui_ImplVulkan_SetMinImageCount@.
 vulkanSetMinImageCount :: MonadIO m => Word32 -> m ()

src/DearImGui/Vulkan/Types.hs

@@ -19,23 +19,24 @@ import qualified Vulkan
 
 vulkanTypesTable :: C.TypesTable
 vulkanTypesTable = Map.fromList
-  [ ( C.TypeName "VkAllocationCallbacks", [t| Vulkan.AllocationCallbacks |] )
-  , ( C.TypeName "VkCommandBuffer_T"    , [t| Vulkan.CommandBuffer_T     |] )
-  , ( C.TypeName "VkDescriptorPool"     , [t| Vulkan.DescriptorPool      |] )
-  , ( C.TypeName "VkDevice_T"           , [t| Vulkan.Device_T            |] )
-  , ( C.TypeName "VkInstance_T"         , [t| Vulkan.Instance_T          |] )
-  , ( C.TypeName "VkPhysicalDevice_T"   , [t| Vulkan.PhysicalDevice_T    |] )
-  , ( C.TypeName "VkPipeline"           , [t| Vulkan.Pipeline            |] )
-  , ( C.TypeName "VkPipelineCache"      , [t| Vulkan.PipelineCache       |] )
-  , ( C.TypeName "VkQueue_T"            , [t| Vulkan.Queue_T             |] )
-  , ( C.TypeName "VkRenderPass"         , [t| Vulkan.RenderPass          |] )
-  , ( C.TypeName "VkResult"             , [t| Vulkan.Result              |] )
-  , ( C.TypeName "VkSampleCountFlagBits", [t| Vulkan.SampleCountFlagBits |] )
-  , ( C.TypeName "VkSampler"            , [t| Vulkan.Sampler             |] )
-  , ( C.TypeName "VkImageView"          , [t| Vulkan.ImageView           |] )
-  , ( C.TypeName "VkImageLayout"        , [t| Vulkan.ImageLayout         |] )
-  , ( C.TypeName "VkDescriptorSet"      , [t| Vulkan.DescriptorSet       |] )
-  , ( C.TypeName "VkFormat"             , [t| Vulkan.Format              |])
+  [ ( C.TypeName "VkAllocationCallbacks"        , [t| Vulkan.AllocationCallbacks         |] )
+  , ( C.TypeName "VkCommandBuffer_T"            , [t| Vulkan.CommandBuffer_T             |] )
+  , ( C.TypeName "VkDescriptorPool"             , [t| Vulkan.DescriptorPool              |] )
+  , ( C.TypeName "VkDevice_T"                   , [t| Vulkan.Device_T                    |] )
+  , ( C.TypeName "VkInstance_T"                 , [t| Vulkan.Instance_T                  |] )
+  , ( C.TypeName "VkPhysicalDevice_T"           , [t| Vulkan.PhysicalDevice_T            |] )
+  , ( C.TypeName "VkPipeline"                   , [t| Vulkan.Pipeline                    |] )
+  , ( C.TypeName "VkPipelineCache"              , [t| Vulkan.PipelineCache               |] )
+  , ( C.TypeName "VkQueue_T"                    , [t| Vulkan.Queue_T                     |] )
+  , ( C.TypeName "VkRenderPass"                 , [t| Vulkan.RenderPass                  |] )
+  , ( C.TypeName "VkResult"                     , [t| Vulkan.Result                      |] )
+  , ( C.TypeName "VkSampleCountFlagBits"        , [t| Vulkan.SampleCountFlagBits         |] )
+  , ( C.TypeName "VkSampler"                    , [t| Vulkan.Sampler                     |] )
+  , ( C.TypeName "VkImageView"                  , [t| Vulkan.ImageView                   |] )
+  , ( C.TypeName "VkImageLayout"                , [t| Vulkan.ImageLayout                 |] )
+  , ( C.TypeName "VkDescriptorSet"              , [t| Vulkan.DescriptorSet               |] )
+  , ( C.TypeName "VkFormat"                     , [t| Vulkan.Format                      |] )
+  , ( C.TypeName "VkPipelineRenderingCreateInfo", [t| Vulkan.PipelineRenderingCreateInfo |] )
   ]
 
 vulkanCtx :: C.Context