2021-01-24 15:27:03 +00:00
{- # LANGUAGE BlockArguments # -}
2021-01-25 09:11:46 +00:00
{- # LANGUAGE DuplicateRecordFields # -}
2021-01-24 15:56:14 +00:00
{- # LANGUAGE FlexibleContexts # -}
2021-01-28 23:38:59 +00:00
{- # LANGUAGE LambdaCase # -}
2021-01-24 15:27:03 +00:00
{- # LANGUAGE NamedFieldPuns # -}
{- # LANGUAGE OverloadedStrings # -}
2021-01-24 15:54:39 +00:00
{- # LANGUAGE PatternSynonyms # -}
2021-01-24 15:27:03 +00:00
{- # LANGUAGE QuasiQuotes # -}
{- # LANGUAGE TemplateHaskell # -}
2021-01-24 19:25:40 +01:00
{- |
Module : DearImGui
Main ImGui module , e x p o r t i n g t h e f u n c t i o n s t o c r e a t e a GUI.
- }
2021-01-24 15:27:03 +00:00
module DearImGui
( -- * Context Creation and Access
2021-04-05 20:16:09 +03:00
Raw . Context ( .. )
, Raw . createContext
, Raw . destroyContext
2021-01-24 15:27:03 +00:00
-- * Main
2021-04-05 20:16:09 +03:00
, Raw . newFrame
, Raw . endFrame
, Raw . render
, Raw . DrawData ( .. )
, Raw . getDrawData
, Raw . checkVersion
2021-01-24 15:27:03 +00:00
-- * Demo, Debug, Information
2021-04-05 20:16:09 +03:00
, Raw . showDemoWindow
, Raw . showMetricsWindow
, Raw . showAboutWindow
, Raw . showUserGuide
2021-01-24 15:27:03 +00:00
, getVersion
-- * Styles
2021-04-05 20:16:09 +03:00
, Raw . styleColorsDark
, Raw . styleColorsLight
, Raw . styleColorsClassic
2021-01-24 15:27:03 +00:00
-- * Windows
2021-04-18 13:10:20 +03:00
, withWindow
, withWindowOpen
2021-01-24 15:27:03 +00:00
, begin
2021-04-05 20:16:09 +03:00
, Raw . end
2021-02-05 23:46:48 +00:00
, setNextWindowPos
, setNextWindowSize
, setNextWindowContentSize
, setNextWindowSizeConstraints
, setNextWindowCollapsed
, setNextWindowBgAlpha
2021-01-24 15:27:03 +00:00
2021-01-28 22:38:25 +00:00
-- * Child Windows
2021-04-18 13:10:20 +03:00
, withChild
, withChildOpen
2021-01-28 22:38:25 +00:00
, beginChild
2021-04-05 20:16:09 +03:00
, Raw . endChild
2021-01-28 22:38:25 +00:00
2021-02-06 11:17:37 +01:00
-- * Parameter stacks
, pushStyleColor
2021-04-05 20:16:09 +03:00
, Raw . popStyleColor
2021-02-06 11:17:37 +01:00
, pushStyleVar
, popStyleVar
2021-01-24 16:58:52 +00:00
-- * Cursor/Layout
2021-04-05 20:16:09 +03:00
, Raw . separator
, Raw . sameLine
, Raw . newLine
, Raw . spacing
2021-02-06 11:17:37 +01:00
, dummy
, indent
, unindent
2021-04-05 20:16:09 +03:00
, setNextItemWidth
2021-02-21 03:39:17 -08:00
, pushItemWidth
2021-04-05 20:16:09 +03:00
, Raw . popItemWidth
2021-04-18 13:10:20 +03:00
, withGroup
2021-04-05 20:16:09 +03:00
, Raw . beginGroup
, Raw . endGroup
2021-04-18 13:10:20 +03:00
2021-02-06 11:17:37 +01:00
, setCursorPos
2021-04-05 20:16:09 +03:00
, Raw . alignTextToFramePadding
2021-01-24 16:58:52 +00:00
2021-01-24 15:27:03 +00:00
-- * Widgets
-- ** Text
, text
-- ** Main
, button
, smallButton
2021-01-24 15:54:39 +00:00
, arrowButton
2021-01-24 15:56:14 +00:00
, checkbox
2021-01-24 16:03:18 +00:00
, progressBar
2021-04-05 20:16:09 +03:00
, Raw . bullet
2021-01-24 15:54:39 +00:00
2021-01-24 16:14:51 +00:00
-- ** Combo Box
2021-04-18 13:10:20 +03:00
, withCombo
, withComboOpen
2021-01-24 16:14:51 +00:00
, beginCombo
2021-04-05 20:16:09 +03:00
, Raw . endCombo
2021-02-05 23:20:32 +02:00
, combo
2021-01-24 16:14:51 +00:00
2021-01-28 23:10:58 +00:00
-- ** Drag Sliders
, dragFloat
, dragFloat2
, dragFloat3
, dragFloat4
2021-01-28 23:02:04 +00:00
-- ** Slider
, sliderFloat
, sliderFloat2
, sliderFloat3
, sliderFloat4
2021-02-21 03:39:17 -08:00
-- ** Text Input
, inputText
2021-01-24 20:46:01 +00:00
-- * Color Editor/Picker
2021-01-25 09:11:46 +00:00
, colorPicker3
2021-01-24 20:46:01 +00:00
, colorButton
2021-01-28 23:28:45 +00:00
-- * Trees
, treeNode
, treePush
2021-04-05 20:16:09 +03:00
, Raw . treePop
2021-01-28 23:28:45 +00:00
2021-01-24 16:14:51 +00:00
-- ** Selectables
, selectable
2021-01-28 23:38:59 +00:00
-- ** List Boxes
, listBox
2021-01-24 20:23:58 +00:00
-- * Data Plotting
, plotHistogram
2021-01-24 16:49:28 +00:00
-- ** Menus
2021-04-18 13:10:20 +03:00
, withMenuBar
, withMenuBarOpen
2021-04-05 20:16:09 +03:00
, Raw . beginMenuBar
, Raw . endMenuBar
2021-04-18 13:10:20 +03:00
, withMainMenuBar
, withMainMenuBarOpen
2021-04-05 20:16:09 +03:00
, Raw . beginMainMenuBar
, Raw . endMainMenuBar
2021-04-18 13:10:20 +03:00
, withMenu
, withMenuOpen
2021-01-24 16:49:28 +00:00
, beginMenu
2021-04-05 20:16:09 +03:00
, Raw . endMenu
2021-04-18 13:10:20 +03:00
2021-01-24 16:49:28 +00:00
, menuItem
2021-02-06 14:26:28 +01:00
-- ** Tabs, tab bar
2021-04-18 13:10:20 +03:00
, withTabBar
, withTabBarOpen
2021-02-06 14:26:28 +01:00
, beginTabBar
2021-04-05 20:16:09 +03:00
, Raw . endTabBar
2021-04-18 13:10:20 +03:00
, withTabItem
, withTabItemOpen
2021-02-06 14:26:28 +01:00
, beginTabItem
2021-04-05 20:16:09 +03:00
, Raw . endTabItem
2021-02-06 14:26:28 +01:00
, tabItemButton
, setTabItemClosed
2021-01-24 17:39:44 +00:00
-- * Tooltips
2021-04-18 13:10:20 +03:00
, withTooltip
2021-04-05 20:16:09 +03:00
, Raw . beginTooltip
, Raw . endTooltip
2021-01-24 17:39:44 +00:00
2021-01-24 17:35:00 +00:00
-- * Popups/Modals
2021-04-18 13:10:20 +03:00
, withPopup
, withPopupOpen
2021-01-24 17:35:00 +00:00
, beginPopup
2021-04-18 13:10:20 +03:00
, withPopupModal
, withPopupModalOpen
2021-01-24 17:35:00 +00:00
, beginPopupModal
2021-04-18 13:10:20 +03:00
2021-04-05 20:16:09 +03:00
, Raw . endPopup
2021-04-18 13:10:20 +03:00
2021-01-24 17:35:00 +00:00
, openPopup
2021-04-05 20:16:09 +03:00
, Raw . closeCurrentPopup
2021-01-24 17:35:00 +00:00
2021-01-24 17:39:35 +00:00
-- * Item/Widgets Utilities
2021-04-05 20:16:09 +03:00
, Raw . isItemHovered
2021-01-24 17:39:35 +00:00
2021-01-24 15:54:39 +00:00
-- * Types
2021-02-05 21:57:17 +01:00
, module DearImGui.Enums
, module DearImGui.Structs
2021-01-24 15:27:03 +00:00
)
where
2021-01-24 19:25:40 +01:00
-- base
2021-03-12 14:03:54 +03:00
import Control.Monad
( when )
2021-01-24 15:56:14 +00:00
import Data.Bool
2021-01-24 15:27:03 +00:00
import Foreign
2021-01-24 15:56:14 +00:00
import Foreign.C
2021-01-24 19:25:40 +01:00
2021-01-24 20:46:01 +00:00
-- dear-imgui
2021-02-05 21:57:17 +01:00
import DearImGui.Enums
import DearImGui.Structs
2021-01-24 20:46:01 +00:00
2021-01-28 23:38:59 +00:00
-- managed
import qualified Control.Monad.Managed as Managed
2021-01-24 19:25:40 +01:00
-- StateVar
import Data.StateVar
( HasGetter ( get ) , HasSetter , ( $=! ) )
-- transformers
import Control.Monad.IO.Class
( MonadIO , liftIO )
2021-04-18 13:10:20 +03:00
-- unliftio
import UnliftIO ( MonadUnliftIO )
import UnliftIO.Exception ( bracket , bracket_ )
2021-04-05 20:16:09 +03:00
import qualified DearImGui.Raw as Raw
2021-01-24 15:27:03 +00:00
-- | Get the compiled version string e.g. "1.80 WIP" (essentially the value for
-- @IMGUI_VERSION@ from the compiled version of @imgui.cpp@).
2021-01-24 16:34:36 +00:00
getVersion :: MonadIO m => m String
getVersion = liftIO do
2021-04-05 20:16:09 +03:00
peekCString =<< Raw . getVersion
2021-01-24 15:27:03 +00:00
-- | Push window to the stack and start appending to it.
--
-- Returns 'False' to indicate the window is collapsed or fully clipped, so you
-- may early out and omit submitting anything to the window. Always call a
-- matching 'end' for each 'begin' call, regardless of its return value!
--
-- Wraps @ImGui::Begin()@.
2021-01-24 16:34:36 +00:00
begin :: MonadIO m => String -> m Bool
begin name = liftIO do
2021-04-05 20:16:09 +03:00
withCString name Raw . begin
2021-01-24 17:00:25 +00:00
2021-04-18 13:10:20 +03:00
-- | 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 )
2021-01-24 17:00:25 +00:00
2021-01-28 22:38:25 +00:00
-- | Wraps @ImGui::BeginChild()@.
beginChild :: MonadIO m => String -> m Bool
beginChild name = liftIO do
2021-04-05 20:16:09 +03:00
withCString name Raw . beginChild
2021-01-24 16:58:52 +00:00
2021-04-18 13:10:20 +03:00
-- | 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 )
2021-01-24 16:58:52 +00:00
2021-01-24 15:27:03 +00:00
-- | Formatted text.
--
-- Wraps @ImGui::Text()@.
2021-01-24 16:34:36 +00:00
text :: MonadIO m => String -> m ()
text t = liftIO do
2021-04-05 20:16:09 +03:00
withCString t Raw . text
2021-01-24 15:27:03 +00:00
-- | A button. Returns 'True' when clicked.
--
-- Wraps @ImGui::Button()@.
2021-01-24 16:34:36 +00:00
button :: MonadIO m => String -> m Bool
button label = liftIO do
2021-04-05 20:16:09 +03:00
withCString label Raw . button
2021-01-24 15:27:03 +00:00
-- | Button with @FramePadding=(0,0)@ to easily embed within text.
--
-- Wraps @ImGui::SmallButton()@.
2021-01-24 16:34:36 +00:00
smallButton :: MonadIO m => String -> m Bool
smallButton label = liftIO do
2021-04-05 20:16:09 +03:00
withCString label Raw . smallButton
2021-01-24 15:54:39 +00:00
-- | Square button with an arrow shape.
--
-- Wraps @ImGui::ArrowButton()@.
2021-01-24 16:34:36 +00:00
arrowButton :: MonadIO m => String -> ImGuiDir -> m Bool
2021-02-06 11:17:37 +01:00
arrowButton strId dir = liftIO do
2021-01-24 16:34:36 +00:00
withCString strId \ strIdPtr ->
2021-04-05 20:16:09 +03:00
Raw . arrowButton strIdPtr dir
2021-01-24 15:54:39 +00:00
2021-01-24 15:56:14 +00:00
-- | Wraps @ImGui::Checkbox()@.
2021-01-24 16:34:36 +00:00
checkbox :: ( HasSetter ref Bool , HasGetter ref Bool , MonadIO m ) => String -> ref -> m Bool
checkbox label ref = liftIO do
2021-01-24 15:56:14 +00:00
currentValue <- get ref
2021-04-05 20:16:09 +03:00
with ( bool 0 1 currentValue ) \ boolPtr -> do
2021-01-24 15:56:14 +00:00
changed <- withCString label \ labelPtr ->
2021-04-05 20:16:09 +03:00
Raw . checkbox labelPtr boolPtr
2021-01-24 15:56:14 +00:00
2021-03-12 14:03:54 +03:00
when changed do
newValue <- peek boolPtr
ref $=! ( newValue == 1 )
2021-01-24 15:56:14 +00:00
return changed
2021-01-24 16:34:36 +00:00
progressBar :: MonadIO m => Float -> Maybe String -> m ()
progressBar progress overlay = liftIO do
withCStringOrNull overlay \ overlayPtr ->
2021-04-05 20:16:09 +03:00
Raw . progressBar ( CFloat progress ) overlayPtr
2021-01-24 15:56:23 +00:00
2021-01-24 16:14:51 +00:00
-- | Begin creating a combo box with a given label and preview value.
--
-- 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'.
--
2021-04-18 13:10:20 +03:00
-- Only call 'endCombo' if 'beginCombo' returns 'True'!
--
2021-01-24 16:14:51 +00:00
-- Wraps @ImGui::BeginCombo()@.
2021-01-24 16:34:36 +00:00
beginCombo :: MonadIO m => String -> String -> m Bool
beginCombo label previewValue = liftIO $
2021-01-24 16:14:51 +00:00
withCString label \ labelPtr ->
withCString previewValue \ previewValuePtr ->
2021-04-05 20:16:09 +03:00
Raw . beginCombo labelPtr previewValuePtr
2021-01-24 16:14:51 +00:00
2021-04-18 13:10:20 +03:00
-- | 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 )
2021-01-24 16:14:51 +00:00
2021-02-06 11:17:37 +01:00
-- | Wraps @ImGui::Combo()@.
2021-02-05 23:20:32 +02:00
combo :: ( MonadIO m , HasGetter ref Int , HasSetter ref Int ) => String -> ref -> [ String ] -> m Bool
combo label selectedIndex items = liftIO $ Managed . with m return
where
m = do
i <- get selectedIndex
cStrings <- traverse ( \ str -> Managed . managed ( withCString str ) ) items
labelPtr <- Managed . managed $ withCString label
iPtr <- Managed . managed $ with ( fromIntegral i )
liftIO $ withArrayLen cStrings \ len itemsPtr -> do
2021-04-05 20:16:09 +03:00
changed <- Raw . combo labelPtr iPtr itemsPtr ( fromIntegral len )
when changed do
i' <- peek iPtr
selectedIndex $=! fromIntegral i'
return changed
2021-02-05 23:20:32 +02:00
2021-01-28 23:10:58 +00:00
-- | Wraps @ImGui::DragFloat()@
dragFloat :: ( MonadIO m , HasSetter ref Float , HasGetter ref Float ) => String -> ref -> Float -> Float -> Float -> m Bool
dragFloat desc ref speed minValue maxValue = liftIO do
currentValue <- get ref
with ( realToFrac currentValue ) \ floatPtr -> do
changed <- withCString desc \ descPtr ->
2021-04-05 20:16:09 +03:00
Raw . dragFloat descPtr floatPtr ( CFloat speed ) ( CFloat minValue ) ( CFloat maxValue )
2021-01-28 23:10:58 +00:00
2021-03-12 14:03:54 +03:00
when changed do
newValue <- peek floatPtr
ref $=! realToFrac newValue
2021-01-28 23:10:58 +00:00
return changed
-- | Wraps @ImGui::DragFloat2()@
dragFloat2 :: ( MonadIO m , HasSetter ref ( Float , Float ) , HasGetter ref ( Float , Float ) ) => String -> ref -> Float -> Float -> Float -> m Bool
dragFloat2 desc ref speed minValue maxValue = liftIO do
( x , y ) <- get ref
withArray [ realToFrac x , realToFrac y ] \ floatPtr -> do
changed <- withCString desc \ descPtr ->
2021-04-05 20:16:09 +03:00
Raw . dragFloat2 descPtr floatPtr ( CFloat speed ) ( CFloat minValue ) ( CFloat maxValue )
2021-01-28 23:10:58 +00:00
2021-03-12 14:03:54 +03:00
when changed do
[ x' , y' ] <- peekArray 2 floatPtr
ref $=! ( realToFrac x' , realToFrac y' )
2021-01-28 23:10:58 +00:00
return changed
-- | Wraps @ImGui::DragFloat3()@
dragFloat3 :: ( MonadIO m , HasSetter ref ( Float , Float , Float ) , HasGetter ref ( Float , Float , Float ) ) => String -> ref -> Float -> Float -> Float -> m Bool
dragFloat3 desc ref speed minValue maxValue = liftIO do
( x , y , z ) <- get ref
withArray [ realToFrac x , realToFrac y , realToFrac z ] \ floatPtr -> do
changed <- withCString desc \ descPtr ->
2021-04-05 20:16:09 +03:00
Raw . dragFloat3 descPtr floatPtr ( CFloat speed ) ( CFloat minValue ) ( CFloat maxValue )
2021-01-28 23:10:58 +00:00
2021-03-12 14:03:54 +03:00
when changed do
[ x' , y' , z' ] <- peekArray 3 floatPtr
ref $=! ( realToFrac x' , realToFrac y' , realToFrac z' )
2021-01-28 23:10:58 +00:00
return changed
-- | Wraps @ImGui::DragFloat4()@
dragFloat4 :: ( MonadIO m , HasSetter ref ( Float , Float , Float , Float ) , HasGetter ref ( Float , Float , Float , Float ) ) => String -> ref -> Float -> Float -> Float -> m Bool
dragFloat4 desc ref speed minValue maxValue = liftIO do
( x , y , z , u ) <- get ref
withArray [ realToFrac x , realToFrac y , realToFrac z , realToFrac u ] \ floatPtr -> do
changed <- withCString desc \ descPtr ->
2021-04-05 20:16:09 +03:00
Raw . dragFloat4 descPtr floatPtr ( CFloat speed ) ( CFloat minValue ) ( CFloat maxValue )
2021-01-28 23:10:58 +00:00
2021-03-12 14:03:54 +03:00
when changed do
[ x' , y' , z' , u' ] <- peekArray 4 floatPtr
ref $=! ( realToFrac x' , realToFrac y' , realToFrac z' , realToFrac u' )
2021-01-28 23:10:58 +00:00
return changed
2021-01-25 19:04:43 +00:00
-- | Wraps @ImGui::SliderFloat()@
sliderFloat :: ( MonadIO m , HasSetter ref Float , HasGetter ref Float ) => String -> ref -> Float -> Float -> m Bool
sliderFloat desc ref minValue maxValue = liftIO do
currentValue <- get ref
with ( realToFrac currentValue ) \ floatPtr -> do
changed <- withCString desc \ descPtr ->
2021-04-05 20:16:09 +03:00
Raw . sliderFloat descPtr floatPtr ( CFloat minValue ) ( CFloat maxValue )
2021-01-25 19:04:43 +00:00
2021-03-12 14:03:54 +03:00
when changed do
newValue <- peek floatPtr
ref $=! realToFrac newValue
2021-01-25 19:04:43 +00:00
return changed
2021-01-25 09:11:46 +00:00
2021-01-28 23:02:04 +00:00
-- | Wraps @ImGui::SliderFloat2()@
sliderFloat2 :: ( MonadIO m , HasSetter ref ( Float , Float ) , HasGetter ref ( Float , Float ) ) => String -> ref -> Float -> Float -> m Bool
sliderFloat2 desc ref minValue maxValue = liftIO do
( x , y ) <- get ref
withArray [ realToFrac x , realToFrac y ] \ floatPtr -> do
changed <- withCString desc \ descPtr ->
2021-04-05 20:16:09 +03:00
Raw . sliderFloat descPtr floatPtr ( CFloat minValue ) ( CFloat maxValue )
2021-01-28 23:02:04 +00:00
2021-03-12 14:03:54 +03:00
when changed do
[ x' , y' ] <- peekArray 2 floatPtr
ref $=! ( realToFrac x' , realToFrac y' )
2021-01-28 23:02:04 +00:00
return changed
-- | Wraps @ImGui::SliderFloat3()@
sliderFloat3 :: ( MonadIO m , HasSetter ref ( Float , Float , Float ) , HasGetter ref ( Float , Float , Float ) ) => String -> ref -> Float -> Float -> m Bool
sliderFloat3 desc ref minValue maxValue = liftIO do
( x , y , z ) <- get ref
withArray [ realToFrac x , realToFrac y , realToFrac z ] \ floatPtr -> do
changed <- withCString desc \ descPtr ->
2021-04-05 20:16:09 +03:00
Raw . sliderFloat descPtr floatPtr ( CFloat minValue ) ( CFloat maxValue )
2021-01-28 23:02:04 +00:00
2021-03-12 14:03:54 +03:00
when changed do
[ x' , y' , z' ] <- peekArray 3 floatPtr
ref $=! ( realToFrac x' , realToFrac y' , realToFrac z' )
2021-01-28 23:02:04 +00:00
return changed
-- | Wraps @ImGui::SliderFloat4()@
sliderFloat4 :: ( MonadIO m , HasSetter ref ( Float , Float , Float , Float ) , HasGetter ref ( Float , Float , Float , Float ) ) => String -> ref -> Float -> Float -> m Bool
sliderFloat4 desc ref minValue maxValue = liftIO do
( x , y , z , u ) <- get ref
withArray [ realToFrac x , realToFrac y , realToFrac z , realToFrac u ] \ floatPtr -> do
changed <- withCString desc \ descPtr ->
2021-04-05 20:16:09 +03:00
Raw . sliderFloat descPtr floatPtr ( CFloat minValue ) ( CFloat maxValue )
2021-01-28 23:02:04 +00:00
2021-03-12 14:03:54 +03:00
when changed do
[ x' , y' , z' , u' ] <- peekArray 4 floatPtr
ref $=! ( realToFrac x' , realToFrac y' , realToFrac z' , realToFrac u' )
2021-01-28 23:02:04 +00:00
return changed
2021-02-21 03:39:17 -08:00
-- | Wraps @ImGui::InputText()@.
2021-04-05 20:16:09 +03:00
inputText :: ( MonadIO m , HasSetter ref String , HasGetter ref String ) => String -> ref -> Int -> m Bool
2021-02-21 03:39:17 -08:00
inputText desc ref refSize = liftIO do
input <- get ref
withCString input \ refPtr -> do
withCString desc \ descPtr -> do
let refSize' :: CInt
refSize' = fromIntegral refSize
2021-04-05 20:16:09 +03:00
changed <- Raw . inputText descPtr refPtr refSize'
when changed do
peekCString refPtr >>= ( $=! ) ref
2021-02-21 03:39:17 -08:00
return changed
2021-01-28 23:02:04 +00:00
-- | Wraps @ImGui::ColorPicker3()@.
colorPicker3 :: ( MonadIO m , HasSetter ref ImVec3 , HasGetter ref ImVec3 ) => String -> ref -> m Bool
colorPicker3 desc ref = liftIO do
ImVec3 { x , y , z } <- get ref
withArray ( realToFrac <$> [ x , y , z ] ) \ refPtr -> do
changed <- withCString desc \ descPtr ->
2021-04-05 20:16:09 +03:00
Raw . colorPicker3 descPtr refPtr
2021-01-28 23:02:04 +00:00
2021-03-12 14:03:54 +03:00
when changed do
[ x' , y' , z' ] <- peekArray 3 refPtr
ref $=! ImVec3 ( realToFrac x' ) ( realToFrac y' ) ( realToFrac z' )
2021-01-28 23:02:04 +00:00
return changed
2021-01-24 20:46:01 +00:00
-- | Display a color square/button, hover for details, return true when pressed.
--
2021-01-25 09:11:56 +00:00
-- Wraps @ImGui::ColorButton()@.
2021-01-24 20:46:01 +00:00
colorButton :: ( MonadIO m , HasSetter ref ImVec4 , HasGetter ref ImVec4 ) => String -> ref -> m Bool
colorButton desc ref = liftIO do
currentValue <- get ref
with currentValue \ refPtr -> do
changed <- withCString desc \ descPtr ->
2021-04-05 20:16:09 +03:00
Raw . colorButton descPtr refPtr
2021-01-24 20:46:01 +00:00
2021-03-12 14:03:54 +03:00
when changed do
newValue <- peek refPtr
ref $=! newValue
2021-01-24 20:46:01 +00:00
return changed
2021-04-05 20:16:09 +03:00
2021-01-28 23:28:45 +00:00
-- | Wraps @ImGui::TreeNode()@.
treeNode :: MonadIO m => String -> m Bool
treeNode label = liftIO do
2021-04-05 20:16:09 +03:00
withCString label Raw . treeNode
2021-01-28 23:28:45 +00:00
-- | Wraps @ImGui::TreePush()@.
treePush :: MonadIO m => String -> m ()
treePush label = liftIO do
2021-04-05 20:16:09 +03:00
withCString label Raw . treePush
2021-01-28 23:28:45 +00:00
2021-01-24 20:46:01 +00:00
2021-01-24 16:14:51 +00:00
-- | Wraps @ImGui::Selectable()@.
2021-01-24 16:34:36 +00:00
selectable :: MonadIO m => String -> m Bool
selectable label = liftIO do
2021-04-05 20:16:09 +03:00
withCString label Raw . selectable
2021-01-24 16:14:51 +00:00
2021-01-28 23:38:59 +00:00
listBox :: ( MonadIO m , HasGetter ref Int , HasSetter ref Int ) => String -> ref -> [ String ] -> m Bool
listBox label selectedIndex items = liftIO $ Managed . with m return
where
m = do
i <- get selectedIndex
cStrings <- traverse ( \ str -> Managed . managed ( withCString str ) ) items
labelPtr <- Managed . managed $ withCString label
iPtr <- Managed . managed $ with ( fromIntegral i )
liftIO $ withArrayLen cStrings \ len itemsPtr -> do
2021-04-05 20:16:09 +03:00
changed <- Raw . listBox labelPtr iPtr itemsPtr ( fromIntegral len )
when changed do
i' <- peek iPtr
selectedIndex $=! fromIntegral i'
return changed
2021-01-28 23:38:59 +00:00
2021-01-24 20:23:58 +00:00
-- | Wraps @ImGui::PlotHistogram()@.
plotHistogram :: MonadIO m => String -> [ CFloat ] -> m ()
plotHistogram label values = liftIO $
withArrayLen values \ len valuesPtr ->
2021-04-05 20:16:09 +03:00
withCString label \ labelPtr ->
Raw . plotHistogram labelPtr valuesPtr ( fromIntegral len )
2021-01-24 16:49:28 +00:00
2021-04-18 13:10:20 +03:00
-- | 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 )
2021-01-24 16:49:28 +00:00
-- | Create a sub-menu entry.
--
-- Wraps @ImGui::BeginMenu()@.
beginMenu :: MonadIO m => String -> m Bool
beginMenu label = liftIO do
2021-04-05 20:16:09 +03:00
withCString label Raw . beginMenu
2021-01-24 16:49:28 +00:00
2021-04-18 13:10:20 +03:00
-- | 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 )
2021-01-24 16:49:28 +00:00
2021-02-06 11:17:37 +01:00
-- | Return true when activated. Shortcuts are displayed for convenience but not
2021-01-24 16:49:28 +00:00
-- processed by ImGui at the moment
--
-- Wraps @ImGui::MenuItem()@
menuItem :: MonadIO m => String -> m Bool
menuItem label = liftIO do
2021-04-05 20:16:09 +03:00
withCString label Raw . menuItem
2021-01-24 16:49:28 +00:00
2021-02-06 14:26:28 +01:00
-- | 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 ->
2021-04-05 20:16:09 +03:00
Raw . beginTabBar ptr flags
2021-02-06 14:26:28 +01:00
2021-04-18 13:10:20 +03:00
-- | 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 )
2021-02-06 14:26:28 +01:00
-- | Create a new tab. Returns @True@ if the tab is selected.
--
-- Wraps @ImGui::BeginTabItem@.
2021-04-18 13:10:20 +03:00
beginTabItem :: ( MonadIO m , HasGetter ref Bool , HasSetter ref Bool ) => String -> ref -> ImGuiTabBarFlags -> m Bool
2021-02-06 14:26:28 +01:00
beginTabItem tabName ref flags = liftIO do
currentValue <- get ref
2021-04-05 20:16:09 +03:00
with ( bool 0 1 currentValue ) \ refPtr -> do
open <- withCString tabName \ ptrName ->
Raw . beginTabItem ptrName refPtr flags
2021-02-06 14:26:28 +01:00
newValue <- ( 0 /= ) <$> peek refPtr
2021-04-05 20:16:09 +03:00
when ( newValue /= currentValue ) do
ref $=! newValue
2021-02-06 14:26:28 +01:00
pure open
2021-04-18 13:10:20 +03:00
-- | 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 )
2021-02-06 14:26:28 +01:00
-- | 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
2021-04-05 20:16:09 +03:00
withCString tabName \ namePtr ->
Raw . tabItemButton namePtr flags
2021-02-06 14:26:28 +01:00
-- | 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
2021-04-05 20:16:09 +03:00
withCString tabName Raw . setTabItemClosed
2021-01-24 17:39:44 +00:00
2021-04-18 13:10:20 +03:00
-- | 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
2021-01-24 17:39:44 +00:00
2021-01-24 17:35:00 +00:00
-- | Returns 'True' if the popup is open, and you can start outputting to it.
--
-- Wraps @ImGui::BeginPopup()@
beginPopup :: MonadIO m => String -> m Bool
beginPopup popupId = liftIO do
2021-04-05 20:16:09 +03:00
withCString popupId Raw . beginPopup
2021-01-24 17:35:00 +00:00
2021-04-18 13:10:20 +03:00
-- | 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 )
2021-01-24 17:35:00 +00:00
-- | Returns 'True' if the modal is open, and you can start outputting to it.
--
-- Wraps @ImGui::BeginPopupModal()@
beginPopupModal :: MonadIO m => String -> m Bool
beginPopupModal popupId = liftIO do
2021-04-05 20:16:09 +03:00
withCString popupId Raw . beginPopupModal
2021-01-24 17:35:00 +00:00
2021-04-18 13:10:20 +03:00
-- | 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 )
2021-01-24 17:35:00 +00:00
-- | Call to mark popup as open (don't call every frame!).
--
-- Wraps @ImGui::OpenPopup()@
openPopup :: MonadIO m => String -> m ()
openPopup popupId = liftIO do
2021-04-05 20:16:09 +03:00
withCString popupId Raw . openPopup
2021-01-24 17:39:35 +00:00
2021-01-24 16:03:18 +00:00
withCStringOrNull :: Maybe String -> ( Ptr CChar -> IO a ) -> IO a
withCStringOrNull Nothing k = k nullPtr
withCStringOrNull ( Just s ) k = withCString s k
2021-02-05 23:46:48 +00:00
-- | Set next window position. Call before `begin` Use pivot=(0.5,0.5) to center on given point, etc.
--
-- Wraps @ImGui::SetNextWindowPos()@
setNextWindowPos :: ( MonadIO m , HasGetter ref ImVec2 ) => ref -> ImGuiCond -> Maybe ref -> m ()
2021-02-06 11:17:37 +01:00
setNextWindowPos posRef cond pivotMaybe = liftIO do
2021-02-05 23:46:48 +00:00
pos <- get posRef
with pos $ \ posPtr ->
case pivotMaybe of
Just pivotRef -> do
pivot <- get pivotRef
with pivot $ \ pivotPtr ->
2021-04-05 20:16:09 +03:00
Raw . setNextWindowPos posPtr cond pivotPtr
2021-02-05 23:46:48 +00:00
Nothing ->
2021-04-05 20:16:09 +03:00
Raw . setNextWindowPos posPtr cond nullPtr
2021-02-05 23:46:48 +00:00
2021-04-05 20:16:09 +03:00
-- | Set next window size. Call before `begin`
2021-02-05 23:46:48 +00:00
--
-- Wraps @ImGui::SetNextWindowSize()@
setNextWindowSize :: ( MonadIO m , HasGetter ref ImVec2 ) => ref -> ImGuiCond -> m ()
2021-02-06 11:17:37 +01:00
setNextWindowSize sizeRef cond = liftIO do
2021-02-05 23:46:48 +00:00
size' <- get sizeRef
2021-04-05 20:16:09 +03:00
with size' \ sizePtr ->
Raw . setNextWindowSize sizePtr cond
2021-02-05 23:46:48 +00:00
-- | Set next window content size (~ scrollable client area, which enforce the range of scrollbars). Not including window decorations (title bar, menu bar, etc.) nor WindowPadding. call before `begin`
--
-- Wraps @ImGui::SetNextWindowContentSize()@
setNextWindowContentSize :: ( MonadIO m , HasGetter ref ImVec2 ) => ref -> m ()
setNextWindowContentSize sizeRef = liftIO do
size' <- get sizeRef
2021-04-05 20:16:09 +03:00
with size' Raw . setNextWindowContentSize
2021-02-05 23:46:48 +00:00
-- | Set next window size limits. use -1,-1 on either X/Y axis to preserve the current size. Sizes will be rounded down.
--
-- Wraps @ImGui::SetNextWindowContentSize()@
setNextWindowSizeConstraints :: ( MonadIO m , HasGetter ref ImVec2 ) => ref -> ref -> m ()
setNextWindowSizeConstraints sizeMinRef sizeMaxRef = liftIO do
sizeMin <- get sizeMinRef
sizeMax <- get sizeMaxRef
2021-04-05 20:16:09 +03:00
with sizeMin \ sizeMinPtr ->
with sizeMax \ sizeMaxPtr ->
Raw . setNextWindowSizeConstraints sizeMinPtr sizeMaxPtr
2021-02-05 23:46:48 +00:00
-- | Set next window collapsed state. call before `begin`
--
-- Wraps @ImGui::SetNextWindowCollapsed()@
setNextWindowCollapsed :: ( MonadIO m ) => Bool -> ImGuiCond -> m ()
2021-02-06 11:17:37 +01:00
setNextWindowCollapsed b cond = liftIO do
2021-04-05 20:16:09 +03:00
Raw . setNextWindowCollapsed ( bool 0 1 b ) cond
2021-02-05 23:46:48 +00:00
-- | Set next window background color alpha. helper to easily override the Alpha component of `ImGuiCol_WindowBg`, `ChildBg`, `PopupBg`. you may also use `ImGuiWindowFlags_NoBackground`.
--
-- Wraps @ImGui::SetNextWindowBgAlpha()@
setNextWindowBgAlpha :: ( MonadIO m ) => Float -> m ()
2021-04-05 20:16:09 +03:00
setNextWindowBgAlpha alpha = liftIO do
Raw . setNextWindowBgAlpha ( CFloat alpha )
2021-02-05 23:46:48 +00:00
-- | Add a dummy item of given size. unlike `invisibleButton`, `dummy` won't take the mouse click or be navigable into.
--
-- Wraps @ImGui::Dummy()@
dummy :: ( MonadIO m , HasGetter ref ImVec2 ) => ref -> m ()
2021-04-05 20:16:09 +03:00
dummy sizeRef = liftIO do
2021-02-05 23:46:48 +00:00
size' <- get sizeRef
2021-04-05 20:16:09 +03:00
with size' Raw . dummy
2021-02-05 23:46:48 +00:00
-- | Move content position toward the right, by indent_w, or style.IndentSpacing if indent_w <= 0
--
-- Wraps @ImGui::Indent()@
indent :: ( MonadIO m ) => Float -> m ()
indent indent_w = liftIO do
2021-04-05 20:16:09 +03:00
Raw . indent ( CFloat indent_w )
2021-02-05 23:46:48 +00:00
-- | Move content position back to the left, by indent_w, or style.IndentSpacing if indent_w <= 0
--
-- Wraps @ImGui::Unindent()@
unindent :: ( MonadIO m ) => Float -> m ()
unindent f = liftIO do
2021-04-05 20:16:09 +03:00
Raw . unindent ( CFloat f )
2021-02-05 23:46:48 +00:00
2021-02-21 03:39:17 -08:00
-- | Affect large frame+labels widgets only.
--
-- Wraps @ImGui::SetNextItemWidth()@
setNextItemWidth :: ( MonadIO m ) => Float -> m ()
setNextItemWidth itemWidth = liftIO do
2021-04-05 20:16:09 +03:00
Raw . setNextItemWidth ( CFloat itemWidth )
2021-02-21 03:39:17 -08:00
-- Wraps @ImGui::PushItemWidth()@
pushItemWidth :: ( MonadIO m ) => Float -> m ()
pushItemWidth itemWidth = liftIO do
2021-04-05 20:16:09 +03:00
Raw . pushItemWidth ( CFloat itemWidth )
2021-02-05 23:46:48 +00:00
2021-04-18 13:10:20 +03:00
-- | Lock horizontal starting position
--
-- Wraps @ImGui::BeginGroup()@ and @ImGui::EndGroup()@
withGroup :: MonadUnliftIO m => m a -> m a
withGroup = bracket_ Raw . beginGroup Raw . endGroup
2021-02-05 23:46:48 +00:00
-- | Set cursor position in window-local coordinates
2021-04-05 20:16:09 +03:00
--
2021-02-05 23:46:48 +00:00
-- Wraps @ImGui::SetCursorPos()@
setCursorPos :: ( MonadIO m , HasGetter ref ImVec2 ) => ref -> m ()
2021-04-05 20:16:09 +03:00
setCursorPos posRef = liftIO do
2021-02-05 23:46:48 +00:00
pos <- get posRef
2021-04-05 20:16:09 +03:00
with pos Raw . setCursorPos
2021-02-05 23:46:48 +00:00
-- | Modify a style color by pushing to the shared stack. always use this if you modify the style after `newFrame`
2021-04-05 20:16:09 +03:00
--
2021-02-05 23:46:48 +00:00
-- Wraps @ImGui::PushStyleColor()@
pushStyleColor :: ( MonadIO m , HasGetter ref ImVec4 ) => ImGuiCol -> ref -> m ()
2021-04-05 20:16:09 +03:00
pushStyleColor col colorRef = liftIO do
2021-02-05 23:46:48 +00:00
color <- get colorRef
2021-04-05 20:16:09 +03:00
with color \ colorPtr ->
Raw . pushStyleColor col colorPtr
2021-02-05 23:46:48 +00:00
-- | Modify a style variable by pushing to the shared stack. always use this if you modify the style after `newFrame`
2021-04-05 20:16:09 +03:00
--
2021-02-05 23:46:48 +00:00
-- Wraps @ImGui::PushStyleVar()@
pushStyleVar :: ( MonadIO m , HasGetter ref ImVec2 ) => ImGuiStyleVar -> ref -> m ()
2021-04-05 20:16:09 +03:00
pushStyleVar style valRef = liftIO do
2021-02-05 23:46:48 +00:00
val <- get valRef
2021-04-05 20:16:09 +03:00
with val \ valPtr ->
Raw . pushStyleVar style valPtr
2021-02-05 23:46:48 +00:00
-- | Remove style variable modifications from the shared stack
2021-04-05 20:16:09 +03:00
--
2021-02-05 23:46:48 +00:00
-- Wraps @ImGui::PopStyleVar()@
2021-04-05 20:16:09 +03:00
popStyleVar :: ( MonadIO m ) => Int -> m ()
2021-02-06 11:17:37 +01:00
popStyleVar n = liftIO do
2021-04-05 20:16:09 +03:00
Raw . popStyleVar ( fromIntegral n )