diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,15 @@ # Changelog for keid-dearimgui +## 0.1.5.0 + +- Bump upstream to `dear-imgui-2.5.0'. + * Breaking change around DrawList API. + +## 0.1.4.0 + +- Add `Render.ImGui.Widget`, building composable widgets on top of keid-frp-banana. + * Mini-breaking by bringing in a whole new dependency set, but not much. + ## 0.1.3.2 - Add `Render.ImGui.askWindowBox`, a helper to get a `Box` using dear-imgui coordinates. diff --git a/keid-ui-dearimgui.cabal b/keid-ui-dearimgui.cabal --- a/keid-ui-dearimgui.cabal +++ b/keid-ui-dearimgui.cabal @@ -1,16 +1,16 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.38.0. +-- This file has been generated from package.yaml by hpack version 0.39.6. -- -- see: https://github.com/sol/hpack name: keid-ui-dearimgui -version: 0.1.3.2 +version: 0.1.5.0 synopsis: DearImGui elements for Keid engine. category: Game Engine author: IC Rainbow -maintainer: keid@aenor.ru -copyright: 2024 IC Rainbow +maintainer: keid@haskell-game.dev +copyright: 2026 IC Rainbow license: BSD3 license-file: LICENSE build-type: Simple @@ -25,6 +25,7 @@ library exposed-modules: Render.ImGui + Render.ImGui.Widget Render.ImGui.Window other-modules: Paths_keid_ui_dearimgui @@ -63,12 +64,14 @@ , base >=4.7 && <5 , binary , bytestring - , dear-imgui >=2.3.0 && <2.4 + , dear-imgui >=2.5.0 && <3 , geomancy , geomancy-layout , keid-core >=0.1.8.0 + , keid-frp-banana + , reactive-banana , resourcet - , rio >=0.1.12.0 + , rio >=0.1.24.0 , rio-app , unliftio , vector diff --git a/src/Render/ImGui.hs b/src/Render/ImGui.hs --- a/src/Render/ImGui.hs +++ b/src/Render/ImGui.hs @@ -23,8 +23,9 @@ import RIO -import Control.Monad.Trans.Resource (ReleaseKey, ResourceT, register) -import Data.Type.Equality (type (~)) +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) @@ -34,17 +35,18 @@ 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) +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.DescriptorPool qualified as DescriptorPool +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 @@ -72,7 +74,7 @@ allocateWithFonts swapchain renderpass subpassIx fonts = allocateWith swapchain renderpass subpassIx do loaded <- FontAtlas.rebuild fonts - _atlasKey <- register FontAtlas.clear + _atlasKey <- Resource.register FontAtlas.clear pure loaded allocateWith @@ -87,7 +89,7 @@ allocateWith swapchain renderpass subpassIx action = do logDebug "Initializing DearImGui" debugReleaseFinished <- toIO (logDebug "Released DearImGui") - void $! register debugReleaseFinished + void $! Resource.register debugReleaseFinished ctx <- ImGui.createContext Region.register_ $ ImGui.destroyContext ctx @@ -96,8 +98,7 @@ let (QueueFamilyIndex queueFamily, queue) = qGraphics ghQueues - pool <- Region.local $ - DescriptorPool.allocate (Just "ImGui") 1 dsSizes + pool <- Region.local allocateDescPool let initInfo = InitInfo @@ -124,22 +125,43 @@ unless initOk do logError "DearImGui vulkan initialization failed" exitFailure - key <- register $ ImGui.vulkanShutdown res + key <- Resource.register $ ImGui.vulkanShutdown res actionRes <- action - fontsOk <- ImGui.vulkanCreateFontsTexture - unless fontsOk do - logError "ImGui.vulkanCreateFontsTexture failed" - exitFailure - debugReleaseStart <- toIO (logDebug "Releasing DearImGui") - void $! register debugReleaseStart + 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 (, 100) +dsSizes = map (, 128) [ Vk.DESCRIPTOR_TYPE_SAMPLER , Vk.DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER , Vk.DESCRIPTOR_TYPE_SAMPLED_IMAGE @@ -157,7 +179,7 @@ allocateLoop installCallbacks = do lift $ beforeLoop installCallbacks shutdownImGui <- lift $ toIO afterLoop - void $! register shutdownImGui + void $! Resource.register shutdownImGui {- | Initialize context to serve the draws in the current render loop. diff --git a/src/Render/ImGui/Widget.hs b/src/Render/ImGui/Widget.hs new file mode 100644 --- /dev/null +++ b/src/Render/ImGui/Widget.hs @@ -0,0 +1,186 @@ +module Render.ImGui.Widget + ( separator + , sliderFloat + , sliderFloat2 + , sliderAngle + , sliderUVec2 + , button + , text + , render_ + ) where + +import RIO + +-- import Engine.Types (HKD) +-- import Data.These (These(..)) +-- import Data.These.Combinators (justHere, justThere) +import DearImGui.Internal.Text (withCString) +import DearImGui.Raw qualified +import Engine.ReactiveBanana.Widget (Widget(..), Widget', draw_) +import Foreign (withForeignPtr, mallocForeignPtr) +import Foreign qualified +import Foreign.C.Types (CFloat(..)) +import Geomancy (Vec2, UVec2) +import Reactive.Banana qualified as RB +import Reactive.Banana.Frameworks qualified as RBF +import DearImGui qualified + +separator :: Widget Void () +separator = draw_ DearImGui.Raw.separator + +sliderFloat + :: MonadIO m + => Text + -> Float + -> (Float, Float) -- TODO: use Behavior somehow + -> m (Widget' Float) +sliderFloat label initial (start, end) = liftIO do + (ah, fire) <- RBF.newAddHandler + + ref <- mallocForeignPtr + withForeignPtr ref \ptr -> + Foreign.poke ptr (CFloat initial) + + pure Widget + { plug = do + event <- RBF.fromAddHandler ah + beh <- RB.stepper initial event + pure (event, beh) + , draw = + withCString label \labelPtr -> -- FIXME: make this static + withForeignPtr ref \refPtr -> do + changed <- DearImGui.Raw.sliderFloat + labelPtr + refPtr + (CFloat start) + (CFloat end) + Foreign.nullPtr + when changed do + CFloat current <- Foreign.peek refPtr + fire current + } + +sliderFloat2 + :: MonadIO m + => Text + -> Vec2 + -> (Float, Float) + -> m (Widget' Vec2) +sliderFloat2 label initial (start, end) = liftIO do + (ah, fire) <- RBF.newAddHandler + + ref <- mallocForeignPtr + withForeignPtr ref \ptr -> + Foreign.poke ptr initial + + pure Widget + { plug = do + event <- RBF.fromAddHandler ah + beh <- RB.stepper initial event + pure (event, beh) + , draw = + withCString label \labelPtr -> -- FIXME: make this static + withForeignPtr ref \refPtr -> do + changed <- DearImGui.Raw.sliderFloat2 + labelPtr + (Foreign.castPtr refPtr) + (CFloat start) + (CFloat end) + Foreign.nullPtr + when changed do + current <- Foreign.peek refPtr + fire current + } + +sliderAngle + :: MonadIO m + => Text + -> Float + -> (Float, Float) + -> m (Widget' Float) +sliderAngle label initial (start, end) = liftIO do + (ah, fire) <- RBF.newAddHandler + + ref <- mallocForeignPtr + withForeignPtr ref \ptr -> + Foreign.poke ptr (CFloat initial) + + pure Widget + { plug = do + event <- RBF.fromAddHandler ah + beh <- RB.stepper initial event + pure (event, beh) + , draw = + withCString label \labelPtr -> -- FIXME: make this static + withForeignPtr ref \refPtr -> do + changed <- DearImGui.Raw.sliderAngle + labelPtr + refPtr + (CFloat start) + (CFloat end) + Foreign.nullPtr + DearImGui.Raw.ImGuiSliderFlags_None + when changed do + CFloat current <- Foreign.peek refPtr + fire current + } + +sliderUVec2 + :: MonadIO m + => Text + -> UVec2 + -> (Word32, Word32) + -> m (Widget' UVec2) +sliderUVec2 label initial (start, end) = liftIO do + (ah, fire) <- RBF.newAddHandler + + ref <- mallocForeignPtr + withForeignPtr ref \ptr -> + Foreign.poke ptr initial + + pure Widget + { plug = do + event <- RBF.fromAddHandler ah + beh <- RB.stepper initial event + pure (event, beh) + , draw = + withCString label \labelPtr -> -- FIXME: make this static + withForeignPtr ref \refPtr -> do + changed <- DearImGui.Raw.sliderInt2 + labelPtr + (Foreign.castPtr refPtr) + (fromIntegral start) + (fromIntegral end) + Foreign.nullPtr + DearImGui.Raw.ImGuiSliderFlags_None + when changed do + current <- Foreign.peek refPtr + fire current + } + +button + :: MonadIO m + => Text + -> m (Widget' ()) +button label = liftIO do + (ah, fire) <- RBF.newAddHandler + pure Widget + { plug = do + event <- RBF.fromAddHandler ah + pure (event, pure ()) + , draw = + withCString label \labelPtr -> do + clicked <- DearImGui.Raw.button labelPtr + when clicked do + fire () + } + +text :: RB.Event Text -> RBF.MomentIO (Widget Void ()) +text bodyE = render_ bodyE DearImGui.text + +-- | Lift rendering fuction into 'Event' handler and wrap in a 'Widget'. +render_ :: RB.Event a -> (a -> IO ()) -> RBF.MomentIO (Widget Void ()) +render_ srcE f = do + drawer <- newIORef $ pure () + RBF.reactimate $ srcE <&> writeIORef drawer . f + pure $ draw_ (join $ readIORef drawer)