{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PatternSynonyms #-}
{- | Convenience helpers for the standard imgui Vulkan-backend init dance.
The C-side @ImGui_ImplVulkan_InitInfo@ struct is mostly default-zero; this
module @allocaBytes@'s it, zeroes it, pokes only the app-supplied 'InitArgs'
fields (the way a C app does @info.Instance = ...; ...; Init(&info)@) and
calls @ImGui_ImplVulkan_Init@. The descriptor pool layout dear-imgui-vulkan
expects is also boilerplate, so 'mkDescriptorPool' supplies it; 'withBackend'
composes the two for the common one-shot case.
The main pipeline renders either into a classic 'RenderPassTarget' or, with
'DynamicRenderingTarget', straight into a colour attachment of the given format
(@VK_KHR_dynamic_rendering@ / Vulkan 1.3). The backend resolves
@vkCmdBeginRendering@ itself through @vkGetDeviceProcAddr@, so no
@LoadFunctions@ call is needed for either target.
Caller still invokes 'ImplVulkan.shutdown' manually before destroying the
imgui context — shutdown order is context-dependent and can't auto-wire
into the resource region.
-}
module DearImGui.Impl.Vulkan
( InitArgs (..)
, Target (..)
, init
, withBackend
, mkDescriptorPool
, surfaceFormatPreference
, ensureDrawableMatchesSwapchain
, ImplVulkan.addTexture
, ImplVulkan.newFrame
, ImplVulkan.removeTexture
, ImplVulkan.renderDrawData
, ImplVulkan.setMinImageCount
, ImplVulkan.shutdown
, ImplVulkan.updateTexture
) where
import Prelude hiding (init)
import Control.Exception (throwIO)
import Control.Monad (unless)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.Resource (MonadResource, allocate)
import Data.Vector qualified as V
import Data.Word (Word32)
import Foreign.C.Types (CBool (..))
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Utils (fillBytes, fromBool, toBool)
import Foreign.Ptr (Ptr, castPtr, plusPtr)
import Foreign.Storable (pokeByteOff)
import Vulkan.CStruct (ToCStruct (..))
import Vulkan.Core10
import Vulkan.Core13 (PipelineRenderingCreateInfo (..))
import Vulkan.Exception (VulkanException (..))
import Vulkan.Extensions.VK_KHR_surface (SurfaceFormatKHR (..), pattern COLOR_SPACE_SRGB_NONLINEAR_KHR)
import Vulkan.Zero (zero)
import DearImGui.Impl.Init (InitFailed (..))
import DearImGui.Raw.Impl.Vulkan (ImGui_ImplVulkan_PipelineInfo)
import DearImGui.Raw.Impl.Vulkan qualified as ImplVulkan
#include "dcimgui_impl_vulkan.h"
-- | App-supplied slice of @ImGui_ImplVulkan_InitInfo@; everything else
-- stays default-zero.
data InitArgs = InitArgs
{ apiVersion :: Word32
, inst :: Instance
, physicalDevice :: PhysicalDevice
, device :: Device
, queueFamily :: Word32
, queue :: Queue
, imageCount :: Word32
-- ^ Used for both min and current image count
, target :: Target
, msaaSamples :: SampleCountFlagBits
-- ^ Rasterization sample count for the main pipeline. Only the main
-- pipeline honours this — secondary viewports render into a
-- single-sample render pass the backend creates for itself, so their
-- pipeline is always kept at 'SAMPLE_COUNT_1_BIT' regardless of this
-- setting.
}
-- | Where the backend's main pipeline renders.
data Target
= RenderPassTarget RenderPass Word32
-- ^ Render pass and the subpass index the main pipeline renders into
| DynamicRenderingTarget Format
-- ^ Colour attachment format handed to @vkCmdBeginRendering@
{- | One-shot @ImGui_ImplVulkan_Init@ for the common case: one queue
family, one 'Target' shared between main and secondary viewports, no
custom shaders.
Must run AFTER 'imGui_CreateContext' and the platform-side
@InitForVulkan@. Throws 'InitFailed' if the C call returns false.
-}
init :: DescriptorPool -> InitArgs -> IO ()
init pool args =
allocaBytes #{size ImGui_ImplVulkan_InitInfo} \p -> do
fillBytes p 0 #{size ImGui_ImplVulkan_InitInfo}
#{poke ImGui_ImplVulkan_InitInfo, ApiVersion} p args.apiVersion
#{poke ImGui_ImplVulkan_InitInfo, Instance} p (instanceHandle args.inst)
#{poke ImGui_ImplVulkan_InitInfo, PhysicalDevice} p (physicalDeviceHandle args.physicalDevice)
#{poke ImGui_ImplVulkan_InitInfo, Device} p (deviceHandle args.device)
#{poke ImGui_ImplVulkan_InitInfo, QueueFamily} p args.queueFamily
#{poke ImGui_ImplVulkan_InitInfo, Queue} p (queueHandle args.queue)
#{poke ImGui_ImplVulkan_InitInfo, DescriptorPool} p pool
#{poke ImGui_ImplVulkan_InitInfo, MinImageCount} p args.imageCount
#{poke ImGui_ImplVulkan_InitInfo, ImageCount} p args.imageCount
#{poke ImGui_ImplVulkan_InitInfo, UseDynamicRendering} p (fromBool dynamic :: CBool)
pokePipelineInfo (p `plusPtr` #{offset ImGui_ImplVulkan_InitInfo, PipelineInfoMain}) mainSubpass args.msaaSamples args.target $
pokePipelineInfo (p `plusPtr` #{offset ImGui_ImplVulkan_InitInfo, PipelineInfoForViewports}) 0 SAMPLE_COUNT_1_BIT args.target do
ok <- ImplVulkan.init (castPtr p)
unless (toBool ok) (throwIO (InitFailed "ImGui_ImplVulkan_Init"))
where
dynamic = case args.target of
RenderPassTarget _ _ -> False
DynamicRenderingTarget _ -> True
mainSubpass = case args.target of
RenderPassTarget _ subpass -> subpass
DynamicRenderingTarget _ -> 0
pokePipelineInfo :: Ptr ImGui_ImplVulkan_PipelineInfo -> Word32 -> SampleCountFlagBits -> Target -> IO a -> IO a
pokePipelineInfo p subpass samples target continue = do
#{poke ImGui_ImplVulkan_PipelineInfo, SwapChainImageUsage} p IMAGE_USAGE_COLOR_ATTACHMENT_BIT
#{poke ImGui_ImplVulkan_PipelineInfo, MSAASamples} p samples
case target of
RenderPassTarget rp _ -> do
#{poke ImGui_ImplVulkan_PipelineInfo, RenderPass} p rp
#{poke ImGui_ImplVulkan_PipelineInfo, Subpass} p subpass
continue
DynamicRenderingTarget format ->
pokeCStruct
(p `plusPtr` #{offset ImGui_ImplVulkan_PipelineInfo, PipelineRenderingCreateInfo})
(zero { colorAttachmentFormats = V.singleton format } :: PipelineRenderingCreateInfo)
continue
{- | 'mkDescriptorPool' + 'init' composed: allocates the standard pool in
the caller's 'ResourceT' scope, then runs the init for the common
single-target setup. Returns the pool in case the caller wants to
do their own 'ImplVulkan.addTexture' bookkeeping against it.
-}
withBackend
:: (MonadResource m, MonadIO m)
=> Word32
-- ^ Extra sampled-image sets beyond the font atlas minimum, for
-- 'ImplVulkan.addTexture' textures; sizes the pool
-> InitArgs
-> m DescriptorPool
withBackend extraTextures args = do
pool <- mkDescriptorPool args.device extraTextures
liftIO $ init pool args
pure pool
{- | Allocate the standard descriptor pool dear-imgui-vulkan needs,
mirroring the backend's own layout: sampled-image slots for the font
atlas(es) plus @extraSets@ for any 'ImplVulkan.addTexture' textures the
app binds, and the backend's fixed linear/nearest samplers. Pool is
freed when the caller's 'ResourceT' scope exits — make sure that scope
tears down AFTER 'ImplVulkan.shutdown'.
-}
mkDescriptorPool
:: (MonadResource m)
=> Device
-> Word32
-- ^ Extra sets beyond the font atlas minimum
-> m DescriptorPool
mkDescriptorPool dev extra = do
let
images = #{const IMGUI_IMPL_VULKAN_MINIMUM_SAMPLED_IMAGE_POOL_SIZE} + extra
samplers = #{const IMGUI_IMPL_VULKAN_MINIMUM_SAMPLER_POOL_SIZE}
poolCI :: DescriptorPoolCreateInfo '[]
poolCI = zero
{ flags = DESCRIPTOR_POOL_CREATE_FREE_DESCRIPTOR_SET_BIT
, maxSets = images + samplers
, poolSizes = V.fromList
[ zero { type' = DESCRIPTOR_TYPE_SAMPLED_IMAGE, descriptorCount = images }
, zero { type' = DESCRIPTOR_TYPE_SAMPLER, descriptorCount = samplers }
]
}
snd <$> withDescriptorPool dev poolCI Nothing allocate
{- | Surface-format predicate for the swapchain imgui renders into: a UNORM
format in the sRGB colorspace. imgui ships sRGB-encoded vertex colors, so an
@*_SRGB@ surface format would re-encode them and wash out the UI. Matches the
formats the backend's own @ImGui_ImplVulkanH_SelectSurfaceFormat@ requests.
-}
surfaceFormatPreference :: SurfaceFormatKHR -> Bool
surfaceFormatPreference sf =
sf.colorSpace == COLOR_SPACE_SRGB_NONLINEAR_KHR && sf.format `elem` unormFormats
where
unormFormats =
[ FORMAT_B8G8R8A8_UNORM
, FORMAT_R8G8B8A8_UNORM
, FORMAT_B8G8R8_UNORM
, FORMAT_R8G8B8_UNORM
]
{- | Throw @ERROR_OUT_OF_DATE_KHR@ when the drawable size no longer matches
the swapchain extent, forcing a swapchain rebuild before imgui renders.
@RenderDrawData@ sets the viewport from imgui's own DisplaySize ×
FramebufferScale — the live framebuffer in physical pixels — so rendering
into a pre-resize swapchain image clips the UI and the compositor then
stretches the result. Some drivers don't reliably surface
SUBOPTIMAL\/OUT_OF_DATE on resize, so the post-present signal alone can't be
relied on.
-}
ensureDrawableMatchesSwapchain :: Extent2D -> Extent2D -> IO ()
ensureDrawableMatchesSwapchain drawable swapchainExtent =
unless (drawable == swapchainExtent) $
throwIO (VulkanException ERROR_OUT_OF_DATE_KHR)