keid-ui-dearimgui 0.1.3.1 → 0.1.3.2
raw patch · 4 files changed
+170/−4 lines, 4 filesdep +geomancydep +geomancy-layoutdep ~dear-imgui
Dependencies added: geomancy, geomancy-layout
Dependency ranges changed: dear-imgui
Files
- ChangeLog.md +7/−0
- keid-ui-dearimgui.cabal +5/−2
- src/Render/ImGui.hs +28/−2
- src/Render/ImGui/Window.hs +130/−0
ChangeLog.md view
@@ -1,5 +1,12 @@ # Changelog for keid-dearimgui +## 0.1.3.2++- Add `Render.ImGui.askWindowBox`, a helper to get a `Box` using dear-imgui coordinates.+- Add `Render.ImGui.Window`:+ - a set of helpers to produce ImGui windows with the requested propeties and run actions inside them.+ - and also a bridge to the experimental `geomancy-layout` "views" layout.+ ## 0.1.3.1 - Update for dear-imgui-2.3.0.
keid-ui-dearimgui.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.37.0.+-- This file has been generated from package.yaml by hpack version 0.38.0. -- -- see: https://github.com/sol/hpack name: keid-ui-dearimgui-version: 0.1.3.1+version: 0.1.3.2 synopsis: DearImGui elements for Keid engine. category: Game Engine author: IC Rainbow@@ -25,6 +25,7 @@ library exposed-modules: Render.ImGui+ Render.ImGui.Window other-modules: Paths_keid_ui_dearimgui hs-source-dirs:@@ -63,6 +64,8 @@ , binary , bytestring , dear-imgui >=2.3.0 && <2.4+ , geomancy+ , geomancy-layout , keid-core >=0.1.8.0 , resourcet , rio >=0.1.12.0
src/Render/ImGui.hs view
@@ -15,23 +15,32 @@ , mkDrawData , draw++ , rootLayout+ , layout+ , askWindowBox ) where import RIO import Control.Monad.Trans.Resource (ReleaseKey, ResourceT, register)+import Data.Type.Equality (type (~)) 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(..), StageRIO)+import Engine.Types (GlobalHandles(..), StageFrameRIO, StageRIO, askWindowSize) import Engine.Vulkan.Types (HasRenderPass(..), HasSwapchain(..), Queues(..), getDevice, getMultisample)+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 RIO.App (appEnv) import Vulkan.Core10 qualified as Vk import Vulkan.Exception (VulkanException(..)) import Vulkan.NamedType (type (:::))@@ -206,3 +215,20 @@ 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}
+ src/Render/ImGui/Window.hs view
@@ -0,0 +1,130 @@+module Render.ImGui.Window+ ( Window(..)+ , pack+ , toView+ , setNextWindowBox+ , run+ ) where++import RIO++import Data.Bits ((.|.))+import Data.ByteString.Unsafe (unsafeInit, unsafeUseAsCString)+import DearImGui.Raw qualified as Raw+import Foreign (castPtr, free, new, nullPtr, peek, with)+import Foreign.C.Types (CFloat(..))+import Geomancy (Vec2, vec2)+import Geomancy.Layout.Box (Box(..))+import Geomancy.Layout.View as LV+import GHC.OverloadedLabels (IsLabel(..))+import GHC.Records (HasField(..))+import GHC.TypeLits (KnownSymbol, symbolVal)++data Window = Window+ { name0 :: ByteString -- ^ NUL-terminated UTF-8 encoded name for less copying.+ , contentSize :: Maybe Vec2 -- ^ Set content size (~ scrollable client area, which enforce the range of scrollbars). Not including window decorations (title bar, menu bar, etc.) nor WindowPadding.+ , sizeConstraints :: Maybe (Vec2, Vec2) -- ^ Set size limits. use -1,-1 on either X/Y axis to preserve the current size. Sizes will be rounded down.+ , collapsed :: Maybe Bool -- ^ Set collapsed state.+ , focus :: Bool -- ^ Set focus state.+ , scroll :: Maybe Vec2 -- ^ Set scrolling value (use < 0.0f to not affect a given axis).+ , bgAlpha :: Maybe Float -- ^ Set background color alpha. helper to easily override the Alpha component of ImGuiCol_WindowBg, ChildBg, PopupBg. you may also use ImGuiWindowFlags_NoBackground.+ , flags :: Raw.ImGuiWindowFlags -- ^ Set window flags.+ , onClose :: Maybe (IO ()) -- ^ Allow window to be closed and set a callback.+ }++instance HasField "name" Window Text where+ getField Window{name0} = decodeUtf8Lenient (unsafeInit name0)++instance IsString Window where+ fromString = pack . fromString++instance KnownSymbol label => IsLabel label Window where+ fromLabel = base{flags = base.flags .|. Raw.ImGuiWindowFlags_NoTitleBar}+ where+ base = pack . fromString . ("##" ++) . symbolVal $ Proxy @label++pack :: Text -> Window+pack name = Window+ { name0 = encodeUtf8 $ name <> "\0"+ , contentSize = Nothing+ , sizeConstraints = Nothing+ , collapsed = Nothing+ , scroll = Nothing+ , focus = False+ , bgAlpha = Nothing+ , flags = Raw.ImGuiWindowFlags_NoSavedSettings+ , onClose = Nothing+ }++{- | ImGui windows as Views++@+hstack_ -- Split-screen with equally-sized windows+ [ Window.toView "Hi" $ ImGui.text "hi" -- title and default options+ , Window.toView #AnonWithID $ ImGui.text "hi" -- empty title with a hidden ID (and default options)+ , Window.toView example $ ImGui.text "hi" -- reusable window value+ ]+@+-}+toView :: Window -> m () -> View () (Windowed m)+toView config action = LV.view_ Windowed{..}++data Windowed m = Windowed+ { config :: Window+ , action :: m ()+ }++instance MonadUnliftIO m => LayoutView (Windowed m) where+ type Placed (Windowed m) = m ()+ placeView box Windowed{..} = do+ setNextWindowBox box+ let+ flags =+ config.flags .|.+ Raw.ImGuiWindowFlags_NoMove .|.+ Raw.ImGuiWindowFlags_NoResize .|.+ Raw.ImGuiWindowFlags_NoCollapse+ run (config{flags}) action++run :: MonadUnliftIO m => Window -> m () -> m ()+run window action = do+ liftIO do+ for_ window.contentSize \size ->+ with size $ Raw.setNextWindowContentSize . castPtr+ for_ (window.sizeConstraints <|> (Just (-1, -1))) \(minSize, maxSize) ->+ with minSize \minPtr ->+ with maxSize \maxPtr ->+ Raw.setNextWindowSizeConstraints (castPtr minPtr) (castPtr maxPtr)+ for_ window.collapsed $ \collapsed ->+ Raw.setNextWindowCollapsed (bool 0 1 collapsed) Raw.ImGuiCond_Always+ when window.focus Raw.setNextWindowFocus+ for_ window.scroll \scroll ->+ with scroll $ Raw.setNextWindowScroll . castPtr+ for_ window.bgAlpha $+ Raw.setNextWindowBgAlpha . CFloat++ bracket+ ( liftIO do+ open_ <- for window.onClose \callback -> (callback,) <$> new 1+ unsafeUseAsCString window.name0 \namePtr ->+ (open_,) <$> Raw.begin namePtr (Just $ maybe nullPtr snd open_) (Just window.flags)+ )+ ( \(open_, _) -> liftIO do+ case open_ of+ Just (callback, openPtr) | openPtr /= nullPtr -> do+ stillOpen <- peek openPtr+ Raw.end+ free openPtr+ when (stillOpen == 0) callback+ _ -> Raw.end+ )+ (\(_openPtr, visible) -> when visible action)++{-# INLINE setNextWindowBox #-}+setNextWindowBox :: MonadIO m => Box -> m ()+setNextWindowBox box = liftIO do+ with box.position \pos ->+ with (vec2 0.5 0.5) \pivot ->+ Raw.setNextWindowPos (castPtr pos) Raw.ImGuiCond_Always (Just $ castPtr pivot)+ with box.size \size ->+ Raw.setNextWindowSize (castPtr size) Raw.ImGuiCond_Always