From ac7457212143fc816a13abcb31236955259327de Mon Sep 17 00:00:00 2001 From: sheaf Date: Sat, 6 Feb 2021 14:26:28 +0100 Subject: [PATCH] Add tab bar functions (#30) --- Main.hs | 25 +++++++++++++++-- src/DearImGui.hs | 59 ++++++++++++++++++++++++++++++++++++++++ src/DearImGui/Context.hs | 16 ++++++----- 3 files changed, 90 insertions(+), 10 deletions(-) diff --git a/Main.hs b/Main.hs index 1a35d22..841af6c 100644 --- a/Main.hs +++ b/Main.hs @@ -5,6 +5,7 @@ module Main (main) where +import Control.Monad import Data.IORef import DearImGui import DearImGui.OpenGL @@ -33,7 +34,9 @@ main = do pos <- newIORef $ ImVec2 64 64 size' <- newIORef $ ImVec2 512 512 selected <- newIORef 4 - loop w checked color slider r pos size' selected + tab1 <- newIORef True + tab2 <- newIORef True + loop w checked color slider r pos size' selected tab1 tab2 openGL2Shutdown @@ -47,8 +50,10 @@ loop -> IORef ImVec2 -> IORef ImVec2 -> IORef Int + -> IORef Bool + -> IORef Bool -> IO () -loop w checked color slider r pos size' selected = do +loop w checked color slider r pos size' selected tab1Ref tab2Ref = do quit <- pollEvents openGL2NewFrame @@ -70,8 +75,22 @@ loop w checked color slider r pos size' selected = do setNextWindowBgAlpha 0.42 begin "My Window" + text "Hello!" + beginTabBar "My tab bar" ImGuiTabBarFlags_Reorderable >>= whenTrue do + beginTabItem "Tab 1" tab1Ref ImGuiTabBarFlags_None >>= whenTrue do + text "Tab 1 is currently selected." + endTabItem + beginTabItem "Tab 2" tab2Ref ImGuiTabBarFlags_None >>= whenTrue do + text "Tab 2 is selected now." + endTabItem + reOpen <- tabItemButton "ReopenTabs" ImGuiTabItemFlags_Trailing + when reOpen do + writeIORef tab1Ref True + writeIORef tab2Ref True + endTabBar + listBox "Items" r [ "A", "B", "C" ] button "Click me" >>= \case @@ -147,7 +166,7 @@ loop w checked color slider r pos size' selected = do glSwapWindow w - if quit then return () else loop w checked color slider r pos size' selected + if quit then return () else loop w checked color slider r pos size' selected tab1Ref tab2Ref where diff --git a/src/DearImGui.hs b/src/DearImGui.hs index 9224695..6977597 100644 --- a/src/DearImGui.hs +++ b/src/DearImGui.hs @@ -129,6 +129,14 @@ module DearImGui , endMenu , menuItem + -- ** Tabs, tab bar + , beginTabBar + , endTabBar + , beginTabItem + , endTabItem + , tabItemButton + , setTabItemClosed + -- * Tooltips , beginTooltip , endTooltip @@ -754,6 +762,57 @@ menuItem label = liftIO do withCString label \labelPtr -> (0 /=) <$> [C.exp| bool { MenuItem($(char* labelPtr)) } |] +-- | Create a @TabBar@ and start appending to it. +-- +-- Wraps @ImGui::BeginTabBar@. +beginTabBar :: MonadIO m => String -> ImGuiTabBarFlags -> m Bool +beginTabBar tabBarID flags = liftIO do + withCString tabBarID \ptr -> + (0 /=) <$> [C.exp| bool { BeginTabBar($(char* ptr), $(ImGuiTabBarFlags flags) ) } |] + +-- | Finish appending elements to a tab bar. Only call if 'beginTabBar' returns @True@. +-- +-- Wraps @ImGui::EndTabBar@. +endTabBar :: MonadIO m => m () +endTabBar = liftIO do + [C.exp| void { EndTabBar(); } |] + +-- | Create a new tab. Returns @True@ if the tab is selected. +-- +-- Wraps @ImGui::BeginTabItem@. +beginTabItem :: ( MonadIO m, HasGetter ref Bool, HasSetter ref Bool ) => String -> ref -> ImGuiTabBarFlags -> m Bool +beginTabItem tabName ref flags = liftIO do + currentValue <- get ref + with ( bool 0 1 currentValue :: CBool ) \ refPtr -> do + open <- withCString tabName \ ptrName -> + (0 /=) <$> [C.exp| bool { BeginTabItem($(char* ptrName), $(bool* refPtr), $(ImGuiTabBarFlags flags) ) } |] + newValue <- (0 /=) <$> peek refPtr + ref $=! newValue + pure open + +-- | Finish appending elements to a tab. Only call if 'beginTabItem' returns @True@. +-- +-- Wraps @ImGui::EndTabItem@. +endTabItem :: MonadIO m => m () +endTabItem = liftIO do + [C.exp| void { EndTabItem(); } |] + +-- | Create a tab that behaves like a button. Returns @True@ when clicked. Cannot be selected in the tab bar. +-- +-- Wraps @ImGui.TabItemButton@. +tabItemButton :: MonadIO m => String -> ImGuiTabItemFlags -> m Bool +tabItemButton tabName flags = liftIO do + withCString tabName \ namePtr -> + (0 /=) <$> [C.exp| bool { TabItemButton($(char* namePtr), $(ImGuiTabItemFlags flags) ) } |] + +-- | Notify the tab bar (or the docking system) that a tab/window is about to close. +-- Useful to reduce visual flicker on reorderable tab bars. +-- +-- __For tab-bar__: call after 'beginTabBar' and before tab submission. Otherwise, call with a window name. +setTabItemClosed :: MonadIO m => String -> m () +setTabItemClosed tabName = liftIO do + withCString tabName \ namePtr -> + [C.exp| void { SetTabItemClosed($(char* namePtr)); } |] -- | Begin/append a tooltip window to create full-featured tooltip (with any -- kind of items). diff --git a/src/DearImGui/Context.hs b/src/DearImGui/Context.hs index 8b7a582..9e807f3 100644 --- a/src/DearImGui/Context.hs +++ b/src/DearImGui/Context.hs @@ -26,12 +26,14 @@ import DearImGui.Structs imguiContext :: Context imguiContext = mempty { ctxTypesTable = Map.fromList - [ ( TypeName "ImGuiCol" , [t| ImGuiCol |] ) - , ( TypeName "ImGuiCond" , [t| ImGuiCond |] ) - , ( TypeName "ImGuiDir" , [t| ImGuiDir |] ) - , ( TypeName "ImGuiStyleVar", [t| ImGuiStyleVar |] ) - , ( TypeName "ImVec2" , [t| ImVec2 |] ) - , ( TypeName "ImVec3" , [t| ImVec3 |] ) - , ( TypeName "ImVec4" , [t| ImVec4 |] ) + [ ( TypeName "ImGuiCol" , [t| ImGuiCol |] ) + , ( TypeName "ImGuiCond", [t| ImGuiCond |] ) + , ( TypeName "ImGuiDir" , [t| ImGuiDir |] ) + , ( TypeName "ImGuiStyleVar" , [t| ImGuiStyleVar |] ) + , ( TypeName "ImGuiTabBarFlags" , [t| ImGuiTabBarFlags |] ) + , ( TypeName "ImGuiTabItemFlags", [t| ImGuiTabItemFlags |] ) + , ( TypeName "ImVec2", [t| ImVec2 |] ) + , ( TypeName "ImVec3", [t| ImVec3 |] ) + , ( TypeName "ImVec4", [t| ImVec4 |] ) ] }