module Render.ImGui
( allocate
, allocateWithFonts
, allocateWith
, renderWith
, allocateLoop
, beforeLoop
, afterLoop
, capturingKeyboard
, capturingMouse
, mkDrawData
, draw
, rootLayout
, layout
, askWindowBox
) where
import RIO
import Control.Monad.Trans.Resource (ReleaseKey, ResourceT, MonadResource)
import Control.Monad.Trans.Resource qualified as Resource
import Data.Vector qualified as Vector
import DearImGui qualified as ImGui
import DearImGui.FontAtlas qualified as FontAtlas
import DearImGui.GLFW (glfwNewFrame, glfwShutdown)
import DearImGui.GLFW.Vulkan (glfwInitForVulkan)
import DearImGui.Vulkan (InitInfo(..))
import DearImGui.Vulkan qualified as ImGui
import Engine.Setup.Window qualified as Window
import Engine.Stage.Component qualified as Stage
import Engine.Types (GlobalHandles(..), StageFrameRIO, StageRIO, askWindowSize)
import Engine.Vulkan.Types (HasRenderPass(..), HasSwapchain(..), Queues(..), getDevice, getMultisample, MonadVulkan)
import Engine.Worker qualified as Worker
import Geomancy.Layout.Box as Box
import Geomancy.Layout.View as View
import RIO.App (appEnv)
import Resource.Region qualified as Region
import Resource.Vulkan.Named qualified as Named
import Vulkan.Core10 qualified as Vk
import Vulkan.Exception (VulkanException(..))
import Vulkan.NamedType (type (:::))
import Vulkan.Utils.QueueAssignment (QueueFamilyIndex(..))
import Vulkan.Zero (zero)
allocate
:: ( HasSwapchain swapchain
, HasRenderPass renderpass
)
=> swapchain
-> renderpass
-> Word32
-> ResourceT (StageRIO st) ReleaseKey
allocate swapchain renderpass subpassIx =
fmap fst $
allocateWith swapchain renderpass subpassIx $
pure ()
allocateWithFonts
:: ( HasSwapchain swapchain
, HasRenderPass renderpass
, Traversable t
)
=> swapchain
-> renderpass
-> Word32
-> t FontAtlas.FontSource
-> ResourceT (StageRIO st) (ReleaseKey, t ImGui.Font)
allocateWithFonts swapchain renderpass subpassIx fonts =
allocateWith swapchain renderpass subpassIx do
loaded <- FontAtlas.rebuild fonts
_atlasKey <- Resource.register FontAtlas.clear
pure loaded
allocateWith
:: ( HasSwapchain swapchain
, HasRenderPass renderpass
)
=> swapchain
-> renderpass
-> Word32
-> ResourceT (StageRIO st) a
-> ResourceT (StageRIO st) (ReleaseKey, a)
allocateWith swapchain renderpass subpassIx action = do
logDebug "Initializing DearImGui"
debugReleaseFinished <- toIO (logDebug "Released DearImGui")
void $! Resource.register debugReleaseFinished
ctx <- ImGui.createContext
Region.register_ $ ImGui.destroyContext ctx
GlobalHandles{..} <- asks appEnv
let (QueueFamilyIndex queueFamily, queue) = qGraphics ghQueues
pool <- Region.local allocateDescPool
let
initInfo = InitInfo
{ instance' = ghInstance
, physicalDevice = ghPhysicalDevice
, device = ghDevice
, queueFamily = queueFamily
, queue = queue
, rendering = Left (getRenderPass renderpass)
, minImageCount = getMinImageCount swapchain
, imageCount = getImageCount swapchain
, msaaSamples = getMultisample swapchain
, subpass = subpassIx
, pipelineCache = Vk.NULL_HANDLE
, descriptorPool = pool
, mbAllocator = Nothing
, checkResult = \case { Vk.SUCCESS -> pure (); e -> throwM $ VulkanException e }
}
res@(_cb, initOk) <- ImGui.vulkanInit initInfo
unless initOk do
logError "DearImGui vulkan initialization failed"
exitFailure
key <- Resource.register $ ImGui.vulkanShutdown res
actionRes <- action
debugReleaseStart <- toIO (logDebug "Releasing DearImGui")
void $! Resource.register debugReleaseStart
pure (key, actionRes)
allocateDescPool
:: ( MonadVulkan env m
, MonadResource m
)
=> m (ReleaseKey, Vk.DescriptorPool)
allocateDescPool = do
device <- asks getDevice
res <- Vk.withDescriptorPool
device
poolCI
Nothing
Resource.allocate
Named.object (snd res) "ImGui"
pure res
where
poolCI = zero
{ Vk.flags =
Vk.DESCRIPTOR_POOL_CREATE_FREE_DESCRIPTOR_SET_BIT
, Vk.maxSets =
8
, Vk.poolSizes =
Vector.fromList $
map (uncurry Vk.DescriptorPoolSize) dsSizes
}
dsSizes :: [(Vk.DescriptorType, Word32)]
dsSizes = map (, 128)
[ Vk.DESCRIPTOR_TYPE_SAMPLER
, Vk.DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER
, Vk.DESCRIPTOR_TYPE_SAMPLED_IMAGE
, Vk.DESCRIPTOR_TYPE_STORAGE_IMAGE
, Vk.DESCRIPTOR_TYPE_UNIFORM_TEXEL_BUFFER
, Vk.DESCRIPTOR_TYPE_STORAGE_TEXEL_BUFFER
, Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
, Vk.DESCRIPTOR_TYPE_STORAGE_BUFFER
, Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER_DYNAMIC
, Vk.DESCRIPTOR_TYPE_STORAGE_BUFFER_DYNAMIC
, Vk.DESCRIPTOR_TYPE_INPUT_ATTACHMENT
]
allocateLoop :: Bool -> ResourceT (StageRIO st) ()
allocateLoop installCallbacks = do
lift $ beforeLoop installCallbacks
shutdownImGui <- lift $ toIO afterLoop
void $! Resource.register shutdownImGui
{- | Initialize context to serve the draws in the current render loop.
You will need to trigger callbacks from DearImGui.GLFW if you're opting out of them here.
DearImgui will run your previously installed GLFW callbacks.
-}
beforeLoop :: Bool -> StageRIO st ()
beforeLoop installCallbacks = do
logDebug "glfwInitForVulkan"
window <- asks $ ghWindow . appEnv
success <- glfwInitForVulkan window installCallbacks
unless success do
logWarn "glfwInitForVulkan failed"
afterLoop :: StageRIO st ()
afterLoop = do
logDebug "glfwShutdown"
asks getDevice >>= Vk.deviceWaitIdle
logDebug "glfwShutdown: Device idle"
glfwShutdown
logDebug "glfwShutdown finished"
mkDrawData :: MonadIO m => m a -> m (a, ImGui.DrawData)
mkDrawData action = do
ImGui.vulkanNewFrame
glfwNewFrame
ImGui.newFrame
result <- action
ImGui.render
drawData <- ImGui.getDrawData
pure (result, drawData)
draw :: MonadIO m => ImGui.DrawData -> Vk.CommandBuffer -> m ()
draw drawData commandBuffer = do
ImGui.vulkanRenderDrawData drawData commandBuffer Nothing
capturingKeyboard :: MonadIO m => m () -> m ()
capturingKeyboard action =
ImGui.wantCaptureKeyboard >>= (`unless` action)
capturingMouse :: MonadIO m => m () -> m ()
capturingMouse action =
ImGui.wantCaptureMouse >>= (`unless` action)
renderWith
:: HasRenderPass renderpass
=> (t -> renderpass)
-> "subpass index" ::: Word32
-> Stage.Rendering t p st
-> Stage.Rendering t p st
renderWith getRP subpassIx Stage.Rendering{..} = Stage.Rendering
{ rAllocateRP
, rAllocateP = \swapchain rps -> do
void $! allocate swapchain (getRP rps) subpassIx
rAllocateP swapchain rps
}
-- | Run a full-screen layout using ImGui coordinates (origin at top-left)
{-# INLINE rootLayout #-}
rootLayout
:: (LayoutView stuff, Placed stuff ~ StageFrameRIO rp p rr st ())
=> View () stuff
-> StageFrameRIO rp p rr st ()
rootLayout viewTree = do
root <- askWindowBox
View.foldWith id root viewTree
-- | Get a window box using ImGui coordinates (origin at top-left)
{-# INLINE askWindowBox #-}
askWindowBox :: StageFrameRIO rp p rr st Box
askWindowBox = do
Window.Size{window} <- mapRIO fst askWindowSize >>= Worker.getOutputData
pure Box{size=window, position=window/2}