Add tab bar functions (#30)

This commit is contained in:
sheaf 2021-02-06 14:26:28 +01:00 committed by GitHub
parent 860720e7c2
commit ac74572121
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 90 additions and 10 deletions

25
Main.hs
View File

@ -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

View File

@ -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).

View File

@ -27,11 +27,13 @@ imguiContext :: Context
imguiContext = mempty
{ ctxTypesTable = Map.fromList
[ ( TypeName "ImGuiCol" , [t| ImGuiCol |] )
, ( TypeName "ImGuiCond" , [t| ImGuiCond |] )
, ( 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 "ImGuiStyleVar" , [t| ImGuiStyleVar |] )
, ( TypeName "ImGuiTabBarFlags" , [t| ImGuiTabBarFlags |] )
, ( TypeName "ImGuiTabItemFlags", [t| ImGuiTabItemFlags |] )
, ( TypeName "ImVec2", [t| ImVec2 |] )
, ( TypeName "ImVec3", [t| ImVec3 |] )
, ( TypeName "ImVec4", [t| ImVec4 |] )
]
}