Merge branch 'main' into moltenvk

haskell-game · Jun 24, 2024 · 78678fe · 78678fe
2 parents 40a6654 + 10cca44
commit 78678fe
Show file tree

Hide file tree

Showing 3 changed files with 32 additions and 21 deletions.
diff --git a/examples/vulkan/Main.hs b/examples/vulkan/Main.hs
@@ -391,14 +391,16 @@ 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
-      , checkResult    = \case { Vulkan.SUCCESS -> pure (); e -> throw $ Vulkan.VulkanException e }
+      , msaaSamples           = Vulkan.SAMPLE_COUNT_1_BIT
+      , mbAllocator           = Nothing
+      , useDynamicRendering   = False
+      , colorAttachmentFormat = Nothing
+      , checkResult           = \case { Vulkan.SUCCESS -> pure (); e -> throw $ Vulkan.VulkanException e }
       }
 
   logDebug "Initialising ImGui SDL2 for Vulkan"

diff --git a/src/DearImGui/Vulkan.hs b/src/DearImGui/Vulkan.hs
@@ -31,6 +31,8 @@ import Data.Word
   ( Word32 )
 import Foreign.Marshal.Alloc
   ( alloca )
+import Foreign.Marshal.Utils
+  ( fromBool )
 import Foreign.Ptr
   ( FunPtr, Ptr, freeHaskellFunPtr, nullPtr )
 import Foreign.Storable
@@ -70,19 +72,21 @@ 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
-  , 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
+  , colorAttachmentFormat :: !(Maybe Vulkan.Format)
+  , useDynamicRendering   :: !Bool
+  , mbAllocator           :: Maybe Vulkan.AllocationCallbacks
+  , checkResult           :: Vulkan.Result -> IO ()
   }
 
 -- | Wraps @ImGui_ImplVulkan_Init@ and @ImGui_ImplVulkan_Shutdown@.
@@ -112,6 +116,10 @@ vulkanInit ( InitInfo {..} ) renderPass = do
     withCallbacks f = case mbAllocator of
       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
     checkResultFunPtr <- $( C.mkFunPtr [t| Vulkan.Result -> IO () |] ) checkResult
     initResult <- withCallbacks \ callbacksPtr ->
@@ -134,8 +142,8 @@ vulkanInit ( InitInfo {..} ) renderPass = do
           initInfo.MSAASamples = $(VkSampleCountFlagBits msaaSamples);
           initInfo.Allocator = $(VkAllocationCallbacks* callbacksPtr);
           initInfo.CheckVkResultFn = $( void (*checkResultFunPtr)(VkResult) );
-          initInfo.UseDynamicRendering = false;
-          // TODO: initInfo.ColorAttachmentFormat
+          initInfo.UseDynamicRendering = $(bool useDynamicRendering');
+          initInfo.ColorAttachmentFormat = $(VkFormat colorAttachmentFormat');
           return ImGui_ImplVulkan_Init(&initInfo, $(VkRenderPass renderPass) );
         }|]
     pure ( checkResultFunPtr, initResult /= 0 )

diff --git a/src/DearImGui/Vulkan/Types.hs b/src/DearImGui/Vulkan/Types.hs
@@ -35,6 +35,7 @@ vulkanTypesTable = Map.fromList
   , ( C.TypeName "VkImageView"          , [t| Vulkan.ImageView           |] )
   , ( C.TypeName "VkImageLayout"        , [t| Vulkan.ImageLayout         |] )
   , ( C.TypeName "VkDescriptorSet"      , [t| Vulkan.DescriptorSet       |] )
+  , ( C.TypeName "VkFormat"             , [t| Vulkan.Format              |])
   ]
 
 vulkanCtx :: C.Context