Add withXxx and withXxxOpen wrappers for begin/end pairs (#49)

Adds dependency on unliftio for monad-preserving brackets.

Fixes #32
This commit is contained in:
Alexander Bondarenko 2021-04-18 13:10:20 +03:00 committed by GitHub
parent b921a72960
commit 8723ac2625
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 202 additions and 2 deletions

View File

@ -92,6 +92,7 @@ library
, inline-c , inline-c
, inline-c-cpp , inline-c-cpp
, StateVar , StateVar
, unliftio
if flag(opengl2) if flag(opengl2)
exposed-modules: exposed-modules:

View File

@ -55,7 +55,7 @@ mainLoop w = do
newFrame newFrame
-- Build the GUI -- Build the GUI
bracket_ (begin "Hello, ImGui!") end do withWindowOpen "Hello, ImGui!" do
-- Add a text widget -- Add a text widget
text "Hello, ImGui!" text "Hello, ImGui!"

View File

@ -41,6 +41,8 @@ module DearImGui
, Raw.styleColorsClassic , Raw.styleColorsClassic
-- * Windows -- * Windows
, withWindow
, withWindowOpen
, begin , begin
, Raw.end , Raw.end
, setNextWindowPos , setNextWindowPos
@ -51,6 +53,8 @@ module DearImGui
, setNextWindowBgAlpha , setNextWindowBgAlpha
-- * Child Windows -- * Child Windows
, withChild
, withChildOpen
, beginChild , beginChild
, Raw.endChild , Raw.endChild
@ -71,8 +75,11 @@ module DearImGui
, setNextItemWidth , setNextItemWidth
, pushItemWidth , pushItemWidth
, Raw.popItemWidth , Raw.popItemWidth
, withGroup
, Raw.beginGroup , Raw.beginGroup
, Raw.endGroup , Raw.endGroup
, setCursorPos , setCursorPos
, Raw.alignTextToFramePadding , Raw.alignTextToFramePadding
@ -89,6 +96,8 @@ module DearImGui
, Raw.bullet , Raw.bullet
-- ** Combo Box -- ** Combo Box
, withCombo
, withComboOpen
, beginCombo , beginCombo
, Raw.endCombo , Raw.endCombo
, combo , combo
@ -127,30 +136,52 @@ module DearImGui
, plotHistogram , plotHistogram
-- ** Menus -- ** Menus
, withMenuBar
, withMenuBarOpen
, Raw.beginMenuBar , Raw.beginMenuBar
, Raw.endMenuBar , Raw.endMenuBar
, withMainMenuBar
, withMainMenuBarOpen
, Raw.beginMainMenuBar , Raw.beginMainMenuBar
, Raw.endMainMenuBar , Raw.endMainMenuBar
, withMenu
, withMenuOpen
, beginMenu , beginMenu
, Raw.endMenu , Raw.endMenu
, menuItem , menuItem
-- ** Tabs, tab bar -- ** Tabs, tab bar
, withTabBar
, withTabBarOpen
, beginTabBar , beginTabBar
, Raw.endTabBar , Raw.endTabBar
, withTabItem
, withTabItemOpen
, beginTabItem , beginTabItem
, Raw.endTabItem , Raw.endTabItem
, tabItemButton , tabItemButton
, setTabItemClosed , setTabItemClosed
-- * Tooltips -- * Tooltips
, withTooltip
, Raw.beginTooltip , Raw.beginTooltip
, Raw.endTooltip , Raw.endTooltip
-- * Popups/Modals -- * Popups/Modals
, withPopup
, withPopupOpen
, beginPopup , beginPopup
, withPopupModal
, withPopupModalOpen
, beginPopupModal , beginPopupModal
, Raw.endPopup , Raw.endPopup
, openPopup , openPopup
, Raw.closeCurrentPopup , Raw.closeCurrentPopup
@ -185,6 +216,10 @@ import Data.StateVar
import Control.Monad.IO.Class import Control.Monad.IO.Class
( MonadIO, liftIO ) ( MonadIO, liftIO )
-- unliftio
import UnliftIO (MonadUnliftIO)
import UnliftIO.Exception (bracket, bracket_)
import qualified DearImGui.Raw as Raw import qualified DearImGui.Raw as Raw
@ -206,12 +241,42 @@ begin :: MonadIO m => String -> m Bool
begin name = liftIO do begin name = liftIO do
withCString name Raw.begin withCString name Raw.begin
-- | Append items to a window.
--
-- Action will get 'False' if the window is collapsed or fully clipped.
--
-- You may append multiple times to the same window during the same frame
-- by calling 'withWindow' in multiple places.
withWindow :: MonadUnliftIO m => String -> (Bool -> m a) -> m a
withWindow name = bracket (begin name) (const Raw.end)
-- | Append items to a window unless it is collapsed or fully clipped.
--
-- You may append multiple times to the same window during the same frame
-- by calling 'withWindowOpen' in multiple places.
withWindowOpen :: MonadUnliftIO m => String -> m () -> m ()
withWindowOpen name action =
withWindow name (`when` action)
-- | Wraps @ImGui::BeginChild()@. -- | Wraps @ImGui::BeginChild()@.
beginChild :: MonadIO m => String -> m Bool beginChild :: MonadIO m => String -> m Bool
beginChild name = liftIO do beginChild name = liftIO do
withCString name Raw.beginChild withCString name Raw.beginChild
-- | Child windows used for self-contained independent scrolling/clipping regions
-- within a host window. Child windows can embed their own child.
--
-- Action will get 'False' if the child region is collapsed or fully clipped.
withChild :: MonadUnliftIO m => String -> (Bool -> m a) -> m a
withChild name = bracket (beginChild name) (const Raw.endChild)
-- | Child windows used for self-contained independent scrolling/clipping regions
-- within a host window. Child windows can embed their own child.
--
-- Action will be skipped if the child region is collapsed or fully clipped.
withChildOpen :: MonadUnliftIO m => String -> m () -> m ()
withChildOpen name action =
withChild name (`when` action)
-- | Formatted text. -- | Formatted text.
-- --
@ -272,6 +337,8 @@ progressBar progress overlay = liftIO do
-- Returns 'True' if the combo box is open. In this state, you should populate -- Returns 'True' if the combo box is open. In this state, you should populate
-- the contents of the combo box - for example, by calling 'selectable'. -- the contents of the combo box - for example, by calling 'selectable'.
-- --
-- Only call 'endCombo' if 'beginCombo' returns 'True'!
--
-- Wraps @ImGui::BeginCombo()@. -- Wraps @ImGui::BeginCombo()@.
beginCombo :: MonadIO m => String -> String -> m Bool beginCombo :: MonadIO m => String -> String -> m Bool
beginCombo label previewValue = liftIO $ beginCombo label previewValue = liftIO $
@ -279,6 +346,21 @@ beginCombo label previewValue = liftIO $
withCString previewValue \previewValuePtr -> withCString previewValue \previewValuePtr ->
Raw.beginCombo labelPtr previewValuePtr Raw.beginCombo labelPtr previewValuePtr
-- | Create a combo box with a given label and preview value.
--
-- Action will get 'True' if the combo box is open.
-- In this state, you should populate the contents of the combo box - for example, by calling 'selectable'.
withCombo :: MonadUnliftIO m => String -> String -> (Bool -> m a) -> m a
withCombo label previewValue =
bracket (beginCombo label previewValue) (`when` Raw.endCombo)
-- | Create a combo box with a given label and preview value.
--
-- Action will be called if the combo box is open to populate the contents
-- of the combo box - for example, by calling 'selectable'.
withComboOpen :: MonadUnliftIO m => String -> String -> m () -> m ()
withComboOpen label previewValue action =
withCombo label previewValue (`when` action)
-- | Wraps @ImGui::Combo()@. -- | Wraps @ImGui::Combo()@.
combo :: (MonadIO m, HasGetter ref Int, HasSetter ref Int) => String -> ref -> [String] -> m Bool combo :: (MonadIO m, HasGetter ref Int, HasSetter ref Int) => String -> ref -> [String] -> m Bool
@ -513,6 +595,31 @@ plotHistogram label values = liftIO $
withCString label \labelPtr -> withCString label \labelPtr ->
Raw.plotHistogram labelPtr valuesPtr (fromIntegral len) Raw.plotHistogram labelPtr valuesPtr (fromIntegral len)
-- | Create a menu bar at the top of the screen and append to it.
--
-- The action will get 'False' if the menu is not visible.
withMainMenuBar :: MonadUnliftIO m => (Bool -> m a) -> m a
withMainMenuBar = bracket Raw.beginMainMenuBar (`when` Raw.endMainMenuBar)
-- | Create a menu bar at the top of the screen and append to it.
--
-- The action will be skipped if the menu is not visible.
withMainMenuBarOpen :: MonadUnliftIO m => m () -> m ()
withMainMenuBarOpen action =
withMainMenuBar (`when` action)
-- | Append items to a window with MenuBar flag.
--
-- The action will get 'False' if the menu is not visible.
withMenuBar :: MonadUnliftIO m => (Bool -> m a) -> m a
withMenuBar = bracket Raw.beginMenuBar (`when` Raw.endMenuBar)
-- | Append items to a window with MenuBar flag.
--
-- The action will be skipped if the menu is not visible.
withMenuBarOpen :: MonadUnliftIO m => m () -> m ()
withMenuBarOpen action =
withMenuBar (`when` action)
-- | Create a sub-menu entry. -- | Create a sub-menu entry.
-- --
@ -521,6 +628,18 @@ beginMenu :: MonadIO m => String -> m Bool
beginMenu label = liftIO do beginMenu label = liftIO do
withCString label Raw.beginMenu withCString label Raw.beginMenu
-- | Create a sub-menu entry.
--
-- The action will get 'False' if the entry is not visible.
withMenu :: MonadUnliftIO m => String -> (Bool -> m a) -> m a
withMenu label = bracket (beginMenu label) (`when` Raw.endMenu)
-- | Create a sub-menu entry.
--
-- The action will be skipped if the entry is not visible.
withMenuOpen :: MonadUnliftIO m => String -> m () -> m ()
withMenuOpen label action =
withMenu label (`when` action)
-- | Return true when activated. Shortcuts are displayed for convenience but not -- | Return true when activated. Shortcuts are displayed for convenience but not
-- processed by ImGui at the moment -- processed by ImGui at the moment
@ -539,6 +658,19 @@ beginTabBar tabBarID flags = liftIO do
withCString tabBarID \ptr -> withCString tabBarID \ptr ->
Raw.beginTabBar ptr flags Raw.beginTabBar ptr flags
-- | Create a @TabBar@ and start appending to it.
--
-- The action will get 'False' if the Tab bar is not visible.
withTabBar :: MonadUnliftIO m => String -> ImGuiTabBarFlags -> (Bool -> m a) -> m a
withTabBar tabBarID flags =
bracket (beginTabBar tabBarID flags) (`when` Raw.endTabBar)
-- | Create a @TabBar@ and start appending to it.
--
-- The action will be skipped if the Tab bar is not visible.
withTabBarOpen :: MonadUnliftIO m => String -> ImGuiTabBarFlags -> m () -> m ()
withTabBarOpen tabBarID flags action =
withTabBar tabBarID flags (`when` action)
-- | Create a new tab. Returns @True@ if the tab is selected. -- | Create a new tab. Returns @True@ if the tab is selected.
-- --
@ -556,6 +688,19 @@ beginTabItem tabName ref flags = liftIO do
pure open pure open
-- | Create a new tab.
--
-- The action will get 'True' if the tab is selected.
withTabItem :: (MonadUnliftIO m, HasGetter ref Bool, HasSetter ref Bool) => String -> ref -> ImGuiTabBarFlags -> (Bool -> m a) -> m a
withTabItem tabName ref flags =
bracket (beginTabItem tabName ref flags) (`when` Raw.endTabItem)
-- | Create a new tab.
--
-- The action will be skipped unless the tab is selected.
withTabItemOpen :: (MonadUnliftIO m, HasGetter ref Bool, HasSetter ref Bool) => String -> ref -> ImGuiTabBarFlags -> m () -> m ()
withTabItemOpen tabName ref flags action =
withTabItem tabName ref flags (`when` action)
-- | Create a tab that behaves like a button. Returns @True@ when clicked. Cannot be selected in the tab bar. -- | Create a tab that behaves like a button. Returns @True@ when clicked. Cannot be selected in the tab bar.
-- --
@ -574,6 +719,12 @@ setTabItemClosed :: MonadIO m => String -> m ()
setTabItemClosed tabName = liftIO do setTabItemClosed tabName = liftIO do
withCString tabName Raw.setTabItemClosed withCString tabName Raw.setTabItemClosed
-- | Create a tooltip.
--
-- Those are windows that follow a mouse and don't take focus away.
-- Can contain any kind of items.
withTooltip :: MonadUnliftIO m => m a -> m a
withTooltip = bracket_ Raw.beginTooltip Raw.endTooltip
-- | Returns 'True' if the popup is open, and you can start outputting to it. -- | Returns 'True' if the popup is open, and you can start outputting to it.
-- --
@ -582,6 +733,28 @@ beginPopup :: MonadIO m => String -> m Bool
beginPopup popupId = liftIO do beginPopup popupId = liftIO do
withCString popupId Raw.beginPopup withCString popupId Raw.beginPopup
-- | Append intems to a non-modal Popup.
--
-- Non-modal popups can be closed by clicking anywhere outside them,
-- or by pressing ESCAPE.
--
-- Visibility state is held internally instead of being held by the programmer.
--
-- The action will get 'True' if the popup is open.
withPopup :: MonadUnliftIO m => String -> (Bool -> m a) -> m a
withPopup popupId = bracket (beginPopup popupId) (`when` Raw.endPopup)
-- | Append intems to a non-modal Popup.
--
-- Non-modal popups can be closed by clicking anywhere outside them,
-- or by pressing ESCAPE.
--
-- Visibility state is held internally instead of being held by the programmer.
--
-- The action will be called only if the popup is open.
withPopupOpen :: MonadUnliftIO m => String -> m () -> m ()
withPopupOpen popupId action =
withPopup popupId (`when` action)
-- | Returns 'True' if the modal is open, and you can start outputting to it. -- | Returns 'True' if the modal is open, and you can start outputting to it.
-- --
@ -590,6 +763,26 @@ beginPopupModal :: MonadIO m => String -> m Bool
beginPopupModal popupId = liftIO do beginPopupModal popupId = liftIO do
withCString popupId Raw.beginPopupModal withCString popupId Raw.beginPopupModal
-- | Append intems to a modal Popup.
--
-- Modal popups can be closed only with 'closeCurrentPopup'.
--
-- Visibility state is held internally instead of being held by the programmer.
--
-- The action will get 'True' if the popup is open.
withPopupModal :: MonadUnliftIO m => String -> (Bool -> m a) -> m a
withPopupModal popupId = bracket (beginPopupModal popupId) (`when` Raw.endPopup)
-- | Append intems to a modal Popup.
--
-- Modal popups can be closed only with 'closeCurrentPopup'.
--
-- Visibility state is held internally instead of being held by the programmer.
--
-- The action will be called only if the popup is open.
withPopupModalOpen :: MonadUnliftIO m => String -> m () -> m ()
withPopupModalOpen popupId action =
withPopupModal popupId (`when` action)
-- | Call to mark popup as open (don't call every frame!). -- | Call to mark popup as open (don't call every frame!).
-- --
@ -704,6 +897,12 @@ pushItemWidth itemWidth = liftIO do
Raw.pushItemWidth (CFloat itemWidth) Raw.pushItemWidth (CFloat itemWidth)
-- | Lock horizontal starting position
--
-- Wraps @ImGui::BeginGroup()@ and @ImGui::EndGroup()@
withGroup :: MonadUnliftIO m => m a -> m a
withGroup = bracket_ Raw.beginGroup Raw.endGroup
-- | Set cursor position in window-local coordinates -- | Set cursor position in window-local coordinates
-- --
-- Wraps @ImGui::SetCursorPos()@ -- Wraps @ImGui::SetCursorPos()@