mirror of
https://github.com/Drezil/dear-imgui.hs.git
synced 2025-03-14 19:12:44 +00:00
Raw.image and sdl2/gl example "image" Wrappers should be backend-specific due to different handling of `userTextureIDPtr`.
1667 lines
50 KiB
Haskell
1667 lines
50 KiB
Haskell
{-# LANGUAGE BlockArguments #-}
|
|
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE PatternSynonyms #-}
|
|
{-# LANGUAGE QuasiQuotes #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
{-|
|
|
Module: DearImGui
|
|
|
|
Main ImGui module, exporting the functions to create a GUI.
|
|
-}
|
|
|
|
module DearImGui
|
|
( -- * Context Creation and Access
|
|
Raw.Context(..)
|
|
, Raw.createContext
|
|
, Raw.destroyContext
|
|
, Raw.getCurrentContext
|
|
, Raw.setCurrentContext
|
|
|
|
-- * Main
|
|
, Raw.newFrame
|
|
, Raw.endFrame
|
|
, Raw.render
|
|
, Raw.DrawData(..)
|
|
, Raw.getDrawData
|
|
, Raw.checkVersion
|
|
|
|
-- * Demo, Debug, Information
|
|
, Raw.showDemoWindow
|
|
, Raw.showMetricsWindow
|
|
, Raw.showAboutWindow
|
|
, Raw.showUserGuide
|
|
, getVersion
|
|
|
|
-- * Styles
|
|
, Raw.styleColorsDark
|
|
, Raw.styleColorsLight
|
|
, Raw.styleColorsClassic
|
|
|
|
-- * Windows
|
|
, withWindow
|
|
, withWindowOpen
|
|
, withFullscreen
|
|
, fullscreenFlags
|
|
|
|
, begin
|
|
, Raw.end
|
|
|
|
-- ** Utilities
|
|
|
|
, Raw.getWindowPos
|
|
, Raw.getWindowSize
|
|
, Raw.getWindowWidth
|
|
, Raw.getWindowHeight
|
|
|
|
-- ** Manipulation
|
|
, setNextWindowPos
|
|
, setNextWindowSize
|
|
, Raw.setNextWindowFullscreen
|
|
, setNextWindowContentSize
|
|
, setNextWindowSizeConstraints
|
|
, setNextWindowCollapsed
|
|
, setNextWindowBgAlpha
|
|
|
|
-- ** Child Windows
|
|
, withChild
|
|
, withChildOpen
|
|
, withChildContext
|
|
, beginChild
|
|
, Raw.endChild
|
|
|
|
-- * Parameter stacks
|
|
, withStyleColor
|
|
, pushStyleColor
|
|
, Raw.popStyleColor
|
|
|
|
, withStyleVar
|
|
, pushStyleVar
|
|
, popStyleVar
|
|
|
|
-- * Cursor/Layout
|
|
, Raw.separator
|
|
, Raw.sameLine
|
|
, Raw.newLine
|
|
, Raw.spacing
|
|
, dummy
|
|
|
|
, withIndent
|
|
, indent
|
|
, unindent
|
|
|
|
, setNextItemWidth
|
|
, withItemWidth
|
|
, pushItemWidth
|
|
, Raw.popItemWidth
|
|
|
|
, withGroup
|
|
, Raw.beginGroup
|
|
, Raw.endGroup
|
|
|
|
, setCursorPos
|
|
, Raw.alignTextToFramePadding
|
|
|
|
-- * ID stack
|
|
, withID
|
|
, ToID(..)
|
|
|
|
-- * Widgets
|
|
-- ** Text
|
|
, text
|
|
, textColored
|
|
, textDisabled
|
|
, textWrapped
|
|
, labelText
|
|
, bulletText
|
|
|
|
-- ** Main
|
|
, button
|
|
, smallButton
|
|
, invisibleButton
|
|
, arrowButton
|
|
, Raw.image
|
|
, checkbox
|
|
, progressBar
|
|
, Raw.bullet
|
|
|
|
-- ** Combo Box
|
|
, withCombo
|
|
, withComboOpen
|
|
, beginCombo
|
|
, Raw.endCombo
|
|
, combo
|
|
|
|
-- ** Drag Sliders
|
|
, dragFloat
|
|
, dragFloat2
|
|
, dragFloat3
|
|
, dragFloat4
|
|
, dragFloatRange2
|
|
, dragInt
|
|
, dragInt2
|
|
, dragInt3
|
|
, dragInt4
|
|
, dragIntRange2
|
|
, dragScalar
|
|
, dragScalarN
|
|
|
|
-- ** Slider
|
|
, sliderFloat
|
|
, sliderFloat2
|
|
, sliderFloat3
|
|
, sliderFloat4
|
|
, sliderAngle
|
|
, sliderInt
|
|
, sliderInt2
|
|
, sliderInt3
|
|
, sliderInt4
|
|
, sliderScalar
|
|
, sliderScalarN
|
|
, vSliderFloat
|
|
, vSliderInt
|
|
, vSliderScalar
|
|
|
|
-- ** Text Input
|
|
, inputText
|
|
, inputTextMultiline
|
|
, inputTextWithHint
|
|
|
|
-- * Color Editor/Picker
|
|
, colorPicker3
|
|
, colorButton
|
|
|
|
-- * Trees
|
|
, treeNode
|
|
, treePush
|
|
, Raw.treePop
|
|
|
|
-- ** Selectables
|
|
, selectable
|
|
|
|
-- ** List Boxes
|
|
, listBox
|
|
|
|
-- * Data Plotting
|
|
, plotHistogram
|
|
|
|
-- ** Menus
|
|
, withMenuBar
|
|
, withMenuBarOpen
|
|
, Raw.beginMenuBar
|
|
, Raw.endMenuBar
|
|
|
|
, withMainMenuBar
|
|
, withMainMenuBarOpen
|
|
, Raw.beginMainMenuBar
|
|
, Raw.endMainMenuBar
|
|
|
|
, withMenu
|
|
, withMenuOpen
|
|
, beginMenu
|
|
, Raw.endMenu
|
|
|
|
, menuItem
|
|
|
|
-- ** Tabs, tab bar
|
|
, withTabBar
|
|
, withTabBarOpen
|
|
, beginTabBar
|
|
, Raw.endTabBar
|
|
|
|
, withTabItem
|
|
, withTabItemOpen
|
|
, beginTabItem
|
|
, Raw.endTabItem
|
|
, tabItemButton
|
|
, setTabItemClosed
|
|
|
|
-- * Tooltips
|
|
, withTooltip
|
|
, Raw.beginTooltip
|
|
, Raw.endTooltip
|
|
|
|
-- * Popups/Modals
|
|
, withPopup
|
|
, withPopupOpen
|
|
, beginPopup
|
|
|
|
, withPopupModal
|
|
, withPopupModalOpen
|
|
, beginPopupModal
|
|
|
|
, Raw.endPopup
|
|
|
|
, openPopup
|
|
, Raw.closeCurrentPopup
|
|
|
|
-- * Item/Widgets Utilities
|
|
, Raw.isItemHovered
|
|
, Raw.wantCaptureMouse
|
|
, Raw.wantCaptureKeyboard
|
|
|
|
-- * Types
|
|
, module DearImGui.Enums
|
|
, module DearImGui.Structs
|
|
)
|
|
where
|
|
|
|
-- base
|
|
import Control.Monad
|
|
( when )
|
|
import Data.Bool
|
|
import Data.Foldable
|
|
( foldl' )
|
|
import Foreign
|
|
import Foreign.C
|
|
import qualified GHC.Foreign as Foreign
|
|
import System.IO
|
|
( utf8 )
|
|
|
|
-- dear-imgui
|
|
import DearImGui.Enums
|
|
import DearImGui.Structs
|
|
|
|
-- managed
|
|
import qualified Control.Monad.Managed as Managed
|
|
|
|
-- StateVar
|
|
import Data.StateVar
|
|
( HasGetter(get), HasSetter, ($=!) )
|
|
|
|
-- transformers
|
|
import Control.Monad.IO.Class
|
|
( MonadIO, liftIO )
|
|
|
|
-- unliftio
|
|
import UnliftIO (MonadUnliftIO)
|
|
import UnliftIO.Exception (bracket, bracket_)
|
|
|
|
import qualified DearImGui.Raw as Raw
|
|
|
|
|
|
-- | Get the compiled version string e.g. "1.80 WIP" (essentially the value for
|
|
-- @IMGUI_VERSION@ from the compiled version of @imgui.cpp@).
|
|
getVersion :: MonadIO m => m String
|
|
getVersion = liftIO do
|
|
peekCString =<< Raw.getVersion
|
|
|
|
|
|
-- | 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()@ with default options.
|
|
begin :: MonadIO m => String -> m Bool
|
|
begin name = liftIO do
|
|
withCString name \namePtr ->
|
|
Raw.begin namePtr Nothing Nothing
|
|
|
|
-- | 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)
|
|
|
|
-- | Append items to a fullscreen window.
|
|
--
|
|
-- The action runs inside a window that is set to behave as a backdrop.
|
|
-- It has no typical window decorations, ignores events and does not jump to front.
|
|
--
|
|
-- You may append multiple times to it during the same frame
|
|
-- by calling 'withFullscreen' in multiple places.
|
|
withFullscreen :: MonadUnliftIO m => m () -> m ()
|
|
withFullscreen action = bracket open close (`when` action)
|
|
where
|
|
open = liftIO do
|
|
Raw.setNextWindowFullscreen
|
|
withCString "FullScreen" \namePtr ->
|
|
Raw.begin namePtr (Just nullPtr) (Just fullscreenFlags)
|
|
|
|
close = liftIO . const Raw.end
|
|
|
|
fullscreenFlags :: ImGuiWindowFlags
|
|
fullscreenFlags = foldl' (.|.) zeroBits
|
|
[ ImGuiWindowFlags_NoBackground
|
|
, ImGuiWindowFlags_NoBringToFrontOnFocus
|
|
, ImGuiWindowFlags_NoDecoration
|
|
, ImGuiWindowFlags_NoFocusOnAppearing
|
|
, ImGuiWindowFlags_NoMove
|
|
, ImGuiWindowFlags_NoResize
|
|
, ImGuiWindowFlags_NoSavedSettings
|
|
, ImGuiWindowFlags_NoScrollbar
|
|
, ImGuiWindowFlags_NoScrollWithMouse
|
|
, ImGuiWindowFlags_NoTitleBar
|
|
]
|
|
|
|
|
|
-- | Begin a self-contained independent scrolling/clipping regions within a host window.
|
|
--
|
|
-- Child windows can embed their own child.
|
|
--
|
|
-- For each independent axis of @size@:
|
|
-- * ==0.0f: use remaining host window size
|
|
-- * >0.0f: fixed size
|
|
-- * <0.0f: use remaining window size minus abs(size)
|
|
--
|
|
-- Each axis can use a different mode, e.g. @ImVec2 0 400@.
|
|
--
|
|
-- @BeginChild()@ 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 `endChild` for each `beginChild` call, regardless of its return value.
|
|
--
|
|
-- Wraps @ImGui::BeginChild()@.
|
|
beginChild :: MonadIO m => String -> ImVec2 -> Bool -> ImGuiWindowFlags -> m Bool
|
|
beginChild name size border flags = liftIO do
|
|
withCString name \namePtr ->
|
|
with size \sizePtr ->
|
|
Raw.beginChild namePtr sizePtr (bool 0 1 border) flags
|
|
|
|
-- | Action wrapper for child windows.
|
|
--
|
|
-- Action will get 'False' if the child region is collapsed or fully clipped.
|
|
withChild :: MonadUnliftIO m => String -> ImVec2 -> Bool -> ImGuiWindowFlags -> (Bool -> m a) -> m a
|
|
withChild name size border flags = bracket (beginChild name size border flags) (const Raw.endChild)
|
|
|
|
-- | Action-skipping wrapper for child windows.
|
|
--
|
|
-- Action will be skipped if the child region is collapsed or fully clipped.
|
|
withChildOpen :: MonadUnliftIO m => String -> ImVec2 -> Bool -> ImGuiWindowFlags -> m () -> m ()
|
|
withChildOpen name size border flags action =
|
|
withChild name size border flags (`when` action)
|
|
|
|
-- | Action wrapper to run in a context of another child window addressed by its name.
|
|
--
|
|
-- Action will get 'False' if the child region is collapsed or fully clipped.
|
|
withChildContext :: MonadUnliftIO m => String -> (Bool -> m a) -> m a
|
|
withChildContext name action =
|
|
bracket
|
|
(liftIO $ withCString name Raw.beginChildContext)
|
|
(const Raw.endChild)
|
|
action
|
|
|
|
|
|
-- | Plain text.
|
|
text :: MonadIO m => String -> m ()
|
|
text t = liftIO do
|
|
withCString t \textPtr ->
|
|
Raw.textUnformatted textPtr Nothing
|
|
|
|
-- | Colored text.
|
|
textColored :: (HasGetter ref ImVec4, MonadIO m) => ref -> String -> m ()
|
|
textColored ref t = liftIO do
|
|
currentValue <- get ref
|
|
with currentValue \refPtr ->
|
|
withCString t $ Raw.textColored refPtr
|
|
|
|
-- | Plain text in a "disabled" color according to current style.
|
|
textDisabled :: MonadIO m => String -> m ()
|
|
textDisabled t = liftIO do
|
|
withCString t Raw.textDisabled
|
|
|
|
-- | Plain text with a word-wrap capability.
|
|
--
|
|
-- Note that this won't work on an auto-resizing window if there's no other widgets to extend the window width,
|
|
-- you may need to set a size using 'setNextWindowSize'.
|
|
textWrapped :: MonadIO m => String -> m ()
|
|
textWrapped t = liftIO do
|
|
withCString t Raw.textWrapped
|
|
|
|
-- | Label+text combo aligned to other label+value widgets.
|
|
labelText :: MonadIO m => String -> String -> m ()
|
|
labelText label t = liftIO do
|
|
withCString label \labelPtr ->
|
|
withCString t \textPtr ->
|
|
Raw.labelText labelPtr textPtr
|
|
|
|
-- | Text with a little bullet aligned to the typical tree node.
|
|
bulletText :: MonadIO m => String -> m ()
|
|
bulletText t = liftIO do
|
|
withCString t Raw.bulletText
|
|
|
|
-- | A button. Returns 'True' when clicked.
|
|
--
|
|
-- Wraps @ImGui::Button()@.
|
|
button :: MonadIO m => String -> m Bool
|
|
button label = liftIO do
|
|
withCString label Raw.button
|
|
|
|
|
|
-- | Button with @FramePadding=(0,0)@ to easily embed within text.
|
|
--
|
|
-- Wraps @ImGui::SmallButton()@.
|
|
smallButton :: MonadIO m => String -> m Bool
|
|
smallButton label = liftIO do
|
|
withCString label Raw.smallButton
|
|
|
|
|
|
-- | Flexible button behavior without the visuals.
|
|
--
|
|
-- Frequently useful to build custom behaviors using the public api
|
|
-- (along with IsItemActive, IsItemHovered, etc).
|
|
--
|
|
-- Wraps @ImGui::InvisibleButton()@.
|
|
invisibleButton :: MonadIO m => String -> ImVec2 -> ImGuiButtonFlags -> m Bool
|
|
invisibleButton label size flags = liftIO do
|
|
withCString label \labelPtr ->
|
|
with size \sizePtr ->
|
|
Raw.invisibleButton labelPtr sizePtr flags
|
|
|
|
|
|
-- | Square button with an arrow shape.
|
|
--
|
|
-- Wraps @ImGui::ArrowButton()@.
|
|
arrowButton :: MonadIO m => String -> ImGuiDir -> m Bool
|
|
arrowButton strId dir = liftIO do
|
|
withCString strId \strIdPtr ->
|
|
Raw.arrowButton strIdPtr dir
|
|
|
|
|
|
-- | Wraps @ImGui::Checkbox()@.
|
|
checkbox :: (HasSetter ref Bool, HasGetter ref Bool, MonadIO m) => String -> ref -> m Bool
|
|
checkbox label ref = liftIO do
|
|
currentValue <- get ref
|
|
with (bool 0 1 currentValue) \boolPtr -> do
|
|
changed <- withCString label \labelPtr ->
|
|
Raw.checkbox labelPtr boolPtr
|
|
|
|
when changed do
|
|
newValue <- peek boolPtr
|
|
ref $=! (newValue == 1)
|
|
|
|
return changed
|
|
|
|
|
|
progressBar :: MonadIO m => Float -> Maybe String -> m ()
|
|
progressBar progress overlay = liftIO do
|
|
withCStringOrNull overlay \overlayPtr ->
|
|
Raw.progressBar (CFloat progress) overlayPtr
|
|
|
|
|
|
-- | 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'.
|
|
--
|
|
-- Only call 'endCombo' if 'beginCombo' returns 'True'!
|
|
--
|
|
-- Wraps @ImGui::BeginCombo()@.
|
|
beginCombo :: MonadIO m => String -> String -> m Bool
|
|
beginCombo label previewValue = liftIO $
|
|
withCString label \labelPtr ->
|
|
withCString previewValue \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()@.
|
|
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
|
|
changed <- Raw.combo labelPtr iPtr itemsPtr (fromIntegral len)
|
|
|
|
when changed do
|
|
i' <- peek iPtr
|
|
selectedIndex $=! fromIntegral i'
|
|
|
|
return changed
|
|
|
|
|
|
-- | 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 ->
|
|
Raw.dragFloat descPtr floatPtr (CFloat speed) (CFloat minValue) (CFloat maxValue)
|
|
|
|
when changed do
|
|
newValue <- peek floatPtr
|
|
ref $=! realToFrac newValue
|
|
|
|
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 ->
|
|
Raw.dragFloat2 descPtr floatPtr (CFloat speed) (CFloat minValue) (CFloat maxValue)
|
|
|
|
when changed do
|
|
[x', y'] <- peekArray 2 floatPtr
|
|
ref $=! (realToFrac x', realToFrac y')
|
|
|
|
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 ->
|
|
Raw.dragFloat3 descPtr floatPtr (CFloat speed) (CFloat minValue) (CFloat maxValue)
|
|
|
|
when changed do
|
|
[x', y', z'] <- peekArray 3 floatPtr
|
|
ref $=! (realToFrac x', realToFrac y', realToFrac z')
|
|
|
|
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 ->
|
|
Raw.dragFloat4 descPtr floatPtr (CFloat speed) (CFloat minValue) (CFloat maxValue)
|
|
|
|
when changed do
|
|
[x', y', z', u'] <- peekArray 4 floatPtr
|
|
ref $=! (realToFrac x', realToFrac y', realToFrac z', realToFrac u')
|
|
|
|
return changed
|
|
|
|
dragFloatRange2 :: (MonadIO m, HasSetter ref Float, HasGetter ref Float) => String -> ref -> ref -> Float -> Float -> Float -> String -> String -> m Bool
|
|
dragFloatRange2 desc refMin refMax speed minValue maxValue minFmt maxFmt = liftIO do
|
|
curMin <- get refMin
|
|
curMax <- get refMax
|
|
with (CFloat curMin) \minPtr ->
|
|
with (CFloat curMax) \maxPtr -> do
|
|
changed <-
|
|
withCString desc \descPtr ->
|
|
withCString minFmt \minFmtPtr ->
|
|
withCString maxFmt \maxFmtPtr ->
|
|
Raw.dragFloatRange2
|
|
descPtr
|
|
minPtr maxPtr
|
|
(CFloat speed) (CFloat minValue) (CFloat maxValue)
|
|
minFmtPtr maxFmtPtr
|
|
ImGuiSliderFlags_AlwaysClamp
|
|
|
|
when changed do
|
|
CFloat nextMin <- peek minPtr
|
|
CFloat nextMax <- peek maxPtr
|
|
refMin $=! nextMin
|
|
refMax $=! nextMax
|
|
|
|
return changed
|
|
|
|
-- | Wraps @ImGui::DragFloat()@
|
|
dragInt :: (MonadIO m, HasSetter ref Int, HasGetter ref Int) => String -> ref -> Float -> Int -> Int -> m Bool
|
|
dragInt label ref speed minValue maxValue = liftIO do
|
|
currentValue <- get ref
|
|
with (fromIntegral currentValue) \vPtr -> do
|
|
changed <-
|
|
withCString label \labelPtr ->
|
|
withCString "%d" \formatPtr ->
|
|
Raw.dragInt
|
|
labelPtr
|
|
vPtr
|
|
(CFloat speed)
|
|
(fromIntegral minValue)
|
|
(fromIntegral maxValue)
|
|
formatPtr
|
|
ImGuiSliderFlags_AlwaysClamp
|
|
|
|
when changed do
|
|
newValue <- peek vPtr
|
|
ref $=! fromIntegral newValue
|
|
|
|
return changed
|
|
|
|
-- | Wraps @ImGui::DragInt2()@
|
|
dragInt2 :: (MonadIO m, HasSetter ref (Int, Int), HasGetter ref (Int, Int)) => String -> ref -> Float -> Int -> Int -> m Bool
|
|
dragInt2 label ref speed minValue maxValue = liftIO do
|
|
(x, y) <- get ref
|
|
withArray [ fromIntegral x, fromIntegral y ] \vPtr -> do
|
|
changed <-
|
|
withCString label \labelPtr ->
|
|
withCString "%d" \formatPtr ->
|
|
Raw.dragInt2
|
|
labelPtr
|
|
vPtr
|
|
(CFloat speed)
|
|
(fromIntegral minValue)
|
|
(fromIntegral maxValue)
|
|
formatPtr
|
|
ImGuiSliderFlags_AlwaysClamp
|
|
|
|
when changed do
|
|
[x', y'] <- peekArray 2 vPtr
|
|
ref $=! (fromIntegral x', fromIntegral y')
|
|
|
|
return changed
|
|
|
|
-- | Wraps @ImGui::DragInt3()@
|
|
dragInt3 :: (MonadIO m, HasSetter ref (Int, Int, Int), HasGetter ref (Int, Int, Int)) => String -> ref -> Float -> Int -> Int -> m Bool
|
|
dragInt3 label ref speed minValue maxValue = liftIO do
|
|
(x, y, z) <- get ref
|
|
withArray [ fromIntegral x, fromIntegral y, fromIntegral z ] \vPtr -> do
|
|
changed <-
|
|
withCString label \labelPtr ->
|
|
withCString "%d" \formatPtr ->
|
|
Raw.dragInt3
|
|
labelPtr
|
|
vPtr
|
|
(CFloat speed)
|
|
(fromIntegral minValue)
|
|
(fromIntegral maxValue)
|
|
formatPtr
|
|
ImGuiSliderFlags_AlwaysClamp
|
|
|
|
when changed do
|
|
[x', y', z'] <- peekArray 3 vPtr
|
|
ref $=! (fromIntegral x', fromIntegral y', fromIntegral z')
|
|
|
|
return changed
|
|
|
|
-- | Wraps @ImGui::DragInt4()@
|
|
dragInt4 :: (MonadIO m, HasSetter ref (Int, Int, Int, Int), HasGetter ref (Int, Int, Int, Int)) => String -> ref -> Float -> Int -> Int -> m Bool
|
|
dragInt4 label ref speed minValue maxValue = liftIO do
|
|
(x, y, z, w) <- get ref
|
|
withArray [ fromIntegral x, fromIntegral y, fromIntegral z, fromIntegral w ] \vPtr -> do
|
|
changed <-
|
|
withCString label \labelPtr ->
|
|
withCString "%d" \formatPtr ->
|
|
Raw.dragInt4
|
|
labelPtr
|
|
vPtr
|
|
(CFloat speed)
|
|
(fromIntegral minValue)
|
|
(fromIntegral maxValue)
|
|
formatPtr
|
|
ImGuiSliderFlags_AlwaysClamp
|
|
|
|
when changed do
|
|
[x', y', z', w'] <- peekArray 3 vPtr
|
|
ref $=! (fromIntegral x', fromIntegral y', fromIntegral z', fromIntegral w')
|
|
|
|
return changed
|
|
|
|
dragIntRange2 :: (MonadIO m, HasSetter ref Int, HasGetter ref Int) => String -> ref -> ref -> Float -> Int -> Int -> String -> String -> m Bool
|
|
dragIntRange2 desc refMin refMax speed minValue maxValue minFmt maxFmt = liftIO do
|
|
curMin <- get refMin
|
|
curMax <- get refMax
|
|
with (fromIntegral curMin) \minPtr ->
|
|
with (fromIntegral curMax) \maxPtr -> do
|
|
changed <-
|
|
withCString desc \descPtr ->
|
|
withCString minFmt \minFmtPtr ->
|
|
withCString maxFmt \maxFmtPtr ->
|
|
Raw.dragIntRange2
|
|
descPtr
|
|
minPtr
|
|
maxPtr
|
|
(CFloat speed)
|
|
(fromIntegral minValue)
|
|
(fromIntegral maxValue)
|
|
minFmtPtr maxFmtPtr
|
|
ImGuiSliderFlags_AlwaysClamp
|
|
|
|
when changed do
|
|
nextMin <- peek minPtr
|
|
nextMax <- peek maxPtr
|
|
refMin $=! fromIntegral nextMin
|
|
refMax $=! fromIntegral nextMax
|
|
|
|
return changed
|
|
|
|
dragScalar
|
|
:: (HasSetter ref a, HasGetter ref a, Storable a, MonadIO m)
|
|
=> String -> ImGuiDataType -> ref -> Float -> ref -> ref -> String -> ImGuiSliderFlags -> m Bool
|
|
dragScalar label dataType ref vSpeed refMin refMax format flags = liftIO do
|
|
currentValue <- get ref
|
|
minValue <- get refMin
|
|
maxValue <- get refMax
|
|
|
|
with currentValue \dataPtr ->
|
|
with minValue \minPtr ->
|
|
with maxValue \maxPtr -> do
|
|
changed <-
|
|
withCString label \labelPtr ->
|
|
withCString format \formatPtr ->
|
|
Raw.dragScalar
|
|
labelPtr
|
|
dataType
|
|
dataPtr
|
|
(CFloat vSpeed)
|
|
minPtr
|
|
maxPtr
|
|
formatPtr
|
|
flags
|
|
|
|
when changed do
|
|
newValue <- peek dataPtr
|
|
ref $=! newValue
|
|
|
|
return changed
|
|
|
|
dragScalarN
|
|
:: (HasSetter valueRef [a], HasGetter valueRef [a], HasGetter rangeRef a, Storable a, MonadIO m)
|
|
=> String -> ImGuiDataType -> valueRef -> Float -> rangeRef -> rangeRef -> String -> ImGuiSliderFlags -> m Bool
|
|
dragScalarN label dataType ref vSpeed refMin refMax format flags = liftIO do
|
|
currentValues <- get ref
|
|
minValue <- get refMin
|
|
maxValue <- get refMax
|
|
|
|
withArrayLen currentValues \components dataPtr ->
|
|
with minValue \minPtr ->
|
|
with maxValue \maxPtr -> do
|
|
changed <-
|
|
withCString label \labelPtr ->
|
|
withCString format \formatPtr ->
|
|
Raw.dragScalarN
|
|
labelPtr
|
|
dataType
|
|
dataPtr
|
|
(fromIntegral components)
|
|
(CFloat vSpeed)
|
|
minPtr
|
|
maxPtr
|
|
formatPtr
|
|
flags
|
|
|
|
when changed do
|
|
newValue <- peekArray components dataPtr
|
|
ref $=! newValue
|
|
|
|
return changed
|
|
|
|
sliderScalar
|
|
:: (HasSetter ref a, HasGetter ref a, Storable a, MonadIO m)
|
|
=> String -> ImGuiDataType -> ref -> ref -> ref -> String -> ImGuiSliderFlags -> m Bool
|
|
sliderScalar label dataType ref refMin refMax format flags = liftIO do
|
|
currentValue <- get ref
|
|
minValue <- get refMin
|
|
maxValue <- get refMax
|
|
|
|
with currentValue \dataPtr ->
|
|
with minValue \minPtr ->
|
|
with maxValue \maxPtr -> do
|
|
changed <-
|
|
withCString label \labelPtr ->
|
|
withCString format \formatPtr ->
|
|
Raw.sliderScalar
|
|
labelPtr
|
|
dataType
|
|
dataPtr
|
|
minPtr
|
|
maxPtr
|
|
formatPtr
|
|
flags
|
|
|
|
when changed do
|
|
newValue <- peek dataPtr
|
|
ref $=! newValue
|
|
|
|
return changed
|
|
|
|
sliderScalarN
|
|
:: (HasSetter valueRef [a], HasGetter valueRef [a], HasGetter rangeRef a, Storable a, MonadIO m)
|
|
=> String -> ImGuiDataType -> valueRef -> rangeRef -> rangeRef -> String -> ImGuiSliderFlags -> m Bool
|
|
sliderScalarN label dataType ref refMin refMax format flags = liftIO do
|
|
currentValues <- get ref
|
|
minValue <- get refMin
|
|
maxValue <- get refMax
|
|
|
|
withArrayLen currentValues \components dataPtr ->
|
|
with minValue \minPtr ->
|
|
with maxValue \maxPtr -> do
|
|
changed <-
|
|
withCString label \labelPtr ->
|
|
withCString format \formatPtr ->
|
|
Raw.sliderScalarN
|
|
labelPtr
|
|
dataType
|
|
dataPtr
|
|
(fromIntegral components)
|
|
minPtr
|
|
maxPtr
|
|
formatPtr
|
|
flags
|
|
|
|
when changed do
|
|
newValue <- peekArray components dataPtr
|
|
ref $=! newValue
|
|
|
|
return changed
|
|
|
|
-- | 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 ->
|
|
Raw.sliderFloat descPtr floatPtr (CFloat minValue) (CFloat maxValue)
|
|
|
|
when changed do
|
|
newValue <- peek floatPtr
|
|
ref $=! realToFrac newValue
|
|
|
|
return changed
|
|
|
|
-- | 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 ->
|
|
Raw.sliderFloat descPtr floatPtr (CFloat minValue) (CFloat maxValue)
|
|
|
|
when changed do
|
|
[x', y'] <- peekArray 2 floatPtr
|
|
ref $=! (realToFrac x', realToFrac y')
|
|
|
|
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 ->
|
|
Raw.sliderFloat descPtr floatPtr (CFloat minValue) (CFloat maxValue)
|
|
|
|
when changed do
|
|
[x', y', z'] <- peekArray 3 floatPtr
|
|
ref $=! (realToFrac x', realToFrac y', realToFrac z')
|
|
|
|
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 ->
|
|
Raw.sliderFloat descPtr floatPtr (CFloat minValue) (CFloat maxValue)
|
|
|
|
when changed do
|
|
[x', y', z', u'] <- peekArray 4 floatPtr
|
|
ref $=! (realToFrac x', realToFrac y', realToFrac z', realToFrac u')
|
|
|
|
return changed
|
|
|
|
-- | Slider widget to select an angle in radians, while displaying degrees.
|
|
sliderAngle :: (MonadIO m, HasSetter ref Float, HasGetter ref Float) => String -> ref -> Float -> Float -> m Bool
|
|
sliderAngle desc refRads minDegs maxDegs = liftIO do
|
|
currentRads <- get refRads
|
|
with (CFloat currentRads) \currentRadsPtr -> do
|
|
changed <-
|
|
withCString desc \descPtr ->
|
|
withCString "%.0f deg" \formatPtr ->
|
|
Raw.sliderAngle descPtr currentRadsPtr (CFloat minDegs) (CFloat maxDegs) formatPtr ImGuiSliderFlags_AlwaysClamp
|
|
|
|
when changed do
|
|
CFloat newRads <- peek currentRadsPtr
|
|
refRads $=! newRads
|
|
|
|
return changed
|
|
|
|
-- | Wraps @ImGui::SliderInt()@
|
|
sliderInt
|
|
:: (MonadIO m, HasSetter ref Int, HasGetter ref Int)
|
|
=> String -> ref -> Int -> Int -> m Bool
|
|
sliderInt label ref minValue maxValue = liftIO do
|
|
currentValue <- get ref
|
|
with (fromIntegral currentValue) \vPtr -> do
|
|
changed <-
|
|
withCString label \labelPtr ->
|
|
withCString "%d" \formatPtr ->
|
|
Raw.sliderInt
|
|
labelPtr
|
|
vPtr
|
|
(fromIntegral minValue)
|
|
(fromIntegral maxValue)
|
|
formatPtr
|
|
ImGuiSliderFlags_AlwaysClamp
|
|
|
|
when changed do
|
|
newValue <- peek vPtr
|
|
ref $=! fromIntegral newValue
|
|
|
|
return changed
|
|
|
|
-- | Wraps @ImGui::SliderInt2()@
|
|
sliderInt2
|
|
:: (MonadIO m, HasSetter ref (Int, Int), HasGetter ref (Int, Int))
|
|
=> String -> ref -> Int -> Int -> m Bool
|
|
sliderInt2 label ref minValue maxValue = liftIO do
|
|
(x, y) <- get ref
|
|
withArray [ fromIntegral x, fromIntegral y ] \vPtr -> do
|
|
changed <-
|
|
withCString label \labelPtr ->
|
|
withCString "%d" \formatPtr ->
|
|
Raw.sliderInt2
|
|
labelPtr
|
|
vPtr
|
|
(fromIntegral minValue)
|
|
(fromIntegral maxValue)
|
|
formatPtr
|
|
ImGuiSliderFlags_AlwaysClamp
|
|
|
|
when changed do
|
|
[x', y'] <- peekArray 2 vPtr
|
|
ref $=! (fromIntegral x', fromIntegral y')
|
|
|
|
return changed
|
|
|
|
-- | Wraps @ImGui::SliderInt3()@
|
|
sliderInt3
|
|
:: (MonadIO m, HasSetter ref (Int, Int, Int), HasGetter ref (Int, Int, Int))
|
|
=> String -> ref -> Int -> Int -> m Bool
|
|
sliderInt3 label ref minValue maxValue = liftIO do
|
|
(x, y, z) <- get ref
|
|
withArray [ fromIntegral x, fromIntegral y, fromIntegral z ] \vPtr -> do
|
|
changed <-
|
|
withCString label \labelPtr ->
|
|
withCString "%d" \formatPtr ->
|
|
Raw.sliderInt3
|
|
labelPtr
|
|
vPtr
|
|
(fromIntegral minValue)
|
|
(fromIntegral maxValue)
|
|
formatPtr
|
|
ImGuiSliderFlags_AlwaysClamp
|
|
|
|
when changed do
|
|
[x', y', z'] <- peekArray 3 vPtr
|
|
ref $=! (fromIntegral x', fromIntegral y', fromIntegral z')
|
|
|
|
return changed
|
|
|
|
-- | Wraps @ImGui::SliderInt4()@
|
|
sliderInt4
|
|
:: (MonadIO m, HasSetter ref (Int, Int, Int, Int), HasGetter ref (Int, Int, Int, Int))
|
|
=> String -> ref -> Int -> Int -> m Bool
|
|
sliderInt4 label ref minValue maxValue = liftIO do
|
|
(x, y, z, w) <- get ref
|
|
withArray [ fromIntegral x, fromIntegral y, fromIntegral z, fromIntegral w] \vPtr -> do
|
|
changed <-
|
|
withCString label \labelPtr ->
|
|
withCString "%d" \formatPtr ->
|
|
Raw.sliderInt4
|
|
labelPtr
|
|
vPtr
|
|
(fromIntegral minValue)
|
|
(fromIntegral maxValue)
|
|
formatPtr
|
|
ImGuiSliderFlags_AlwaysClamp
|
|
|
|
when changed do
|
|
[x', y', z', w'] <- peekArray 4 vPtr
|
|
ref $=! (fromIntegral x', fromIntegral y', fromIntegral z', fromIntegral w')
|
|
|
|
return changed
|
|
|
|
vSliderFloat
|
|
:: (HasSetter ref Float, HasGetter ref Float, MonadIO m)
|
|
=> String -> ImVec2 -> ref -> Float -> Float -> m Bool
|
|
vSliderFloat label size ref minValue maxValue = liftIO do
|
|
currentValue <- get ref
|
|
|
|
with size \sizePtr ->
|
|
with (CFloat currentValue) \dataPtr -> do
|
|
changed <-
|
|
withCString label \labelPtr ->
|
|
withCString "%.3f" \formatPtr ->
|
|
Raw.vSliderFloat
|
|
labelPtr
|
|
sizePtr
|
|
dataPtr
|
|
(CFloat minValue)
|
|
(CFloat maxValue)
|
|
formatPtr
|
|
ImGuiSliderFlags_AlwaysClamp
|
|
|
|
when changed do
|
|
CFloat newValue <- peek dataPtr
|
|
ref $=! newValue
|
|
|
|
return changed
|
|
|
|
vSliderInt
|
|
:: (HasSetter ref Int, HasGetter ref Int, MonadIO m)
|
|
=> String -> ImVec2 -> ref -> Int -> Int -> m Bool
|
|
vSliderInt label size ref minValue maxValue = liftIO do
|
|
currentValue <- get ref
|
|
|
|
with size \sizePtr ->
|
|
with (fromIntegral currentValue) \dataPtr -> do
|
|
changed <-
|
|
withCString label \labelPtr ->
|
|
withCString "%d" \formatPtr ->
|
|
Raw.vSliderInt
|
|
labelPtr
|
|
sizePtr
|
|
dataPtr
|
|
(fromIntegral minValue)
|
|
(fromIntegral maxValue)
|
|
formatPtr
|
|
ImGuiSliderFlags_AlwaysClamp
|
|
|
|
when changed do
|
|
newValue <- peek dataPtr
|
|
ref $=! fromIntegral newValue
|
|
|
|
return changed
|
|
|
|
vSliderScalar
|
|
:: (HasSetter ref a, HasGetter ref a, Storable a, MonadIO m)
|
|
=> String -> ImVec2 -> ImGuiDataType -> ref -> ref -> ref -> String -> ImGuiSliderFlags -> m Bool
|
|
vSliderScalar label size dataType ref refMin refMax format flags = liftIO do
|
|
currentValue <- get ref
|
|
minValue <- get refMin
|
|
maxValue <- get refMax
|
|
|
|
with size \sizePtr ->
|
|
with currentValue \dataPtr ->
|
|
with minValue \minPtr ->
|
|
with maxValue \maxPtr -> do
|
|
changed <-
|
|
withCString label \labelPtr ->
|
|
withCString format \formatPtr ->
|
|
Raw.vSliderScalar
|
|
labelPtr
|
|
sizePtr
|
|
dataType
|
|
dataPtr
|
|
minPtr
|
|
maxPtr
|
|
formatPtr
|
|
flags
|
|
|
|
when changed do
|
|
newValue <- peek dataPtr
|
|
ref $=! newValue
|
|
|
|
return changed
|
|
|
|
|
|
-- | Wraps @ImGui::InputText()@.
|
|
inputText :: (MonadIO m, HasSetter ref String, HasGetter ref String) => String -> ref -> Int -> m Bool
|
|
inputText label ref bufSize =
|
|
withInputString ref bufSize \bufPtrLen ->
|
|
Foreign.withCString utf8 label \labelPtr ->
|
|
Raw.inputText
|
|
labelPtr
|
|
bufPtrLen
|
|
ImGuiInputTextFlags_None
|
|
|
|
|
|
-- | Wraps @ImGui::InputTextMultiline()@.
|
|
inputTextMultiline :: (MonadIO m, HasSetter ref String, HasGetter ref String) => String -> ref -> Int -> ImVec2 -> m Bool
|
|
inputTextMultiline label ref bufSize size =
|
|
withInputString ref bufSize \bufPtrLen ->
|
|
Foreign.withCString utf8 label \labelPtr ->
|
|
with size \sizePtr ->
|
|
Raw.inputTextMultiline
|
|
labelPtr
|
|
bufPtrLen
|
|
sizePtr
|
|
ImGuiInputTextFlags_None
|
|
|
|
|
|
-- | Wraps @ImGui::InputTextWithHint()@.
|
|
inputTextWithHint :: (MonadIO m, HasSetter ref String, HasGetter ref String) => String -> String -> ref -> Int -> m Bool
|
|
inputTextWithHint label hint ref bufSize =
|
|
withInputString ref bufSize \bufPtrLen ->
|
|
Foreign.withCString utf8 label \labelPtr ->
|
|
Foreign.withCString utf8 hint \hintPtr ->
|
|
Raw.inputTextWithHint
|
|
labelPtr
|
|
hintPtr
|
|
bufPtrLen
|
|
ImGuiInputTextFlags_None
|
|
|
|
|
|
-- | Internal helper to prepare appropriately sized and encoded input buffer.
|
|
withInputString
|
|
:: (MonadIO m, HasSetter ref String, HasGetter ref String)
|
|
=> ref
|
|
-> Int
|
|
-> (CStringLen -> IO Bool)
|
|
-> m Bool
|
|
withInputString ref bufSize action = liftIO do
|
|
input <- get ref
|
|
Foreign.withCStringLen utf8 input \(refPtr, refSize) ->
|
|
-- XXX: Allocate and zero buffer to receive imgui updates.
|
|
bracket (mkBuf refSize) free \bufPtr -> do
|
|
-- XXX: Copy the original input.
|
|
copyBytes bufPtr refPtr refSize
|
|
|
|
changed <- action (bufPtr, bufSize)
|
|
|
|
when changed do
|
|
-- XXX: Assuming Imgui wouldn't write over the bump stop so peekCString would finish.
|
|
newValue <- Foreign.peekCString utf8 bufPtr
|
|
ref $=! newValue
|
|
|
|
return changed
|
|
where
|
|
mkBuf refSize =
|
|
callocBytes $
|
|
max refSize bufSize +
|
|
5 -- XXX: max size of UTF8 code point + NUL terminator
|
|
|
|
|
|
-- | 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 ->
|
|
Raw.colorPicker3 descPtr refPtr
|
|
|
|
when changed do
|
|
[x', y', z'] <- peekArray 3 refPtr
|
|
ref $=! ImVec3 (realToFrac x') (realToFrac y') (realToFrac z')
|
|
|
|
return changed
|
|
|
|
|
|
-- | Display a color square/button, hover for details, return true when pressed.
|
|
--
|
|
-- Wraps @ImGui::ColorButton()@.
|
|
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 ->
|
|
Raw.colorButton descPtr refPtr
|
|
|
|
when changed do
|
|
newValue <- peek refPtr
|
|
ref $=! newValue
|
|
|
|
return changed
|
|
|
|
|
|
-- | Wraps @ImGui::TreeNode()@.
|
|
treeNode :: MonadIO m => String -> m Bool
|
|
treeNode label = liftIO do
|
|
withCString label Raw.treeNode
|
|
|
|
|
|
-- | Wraps @ImGui::TreePush()@.
|
|
treePush :: MonadIO m => String -> m ()
|
|
treePush label = liftIO do
|
|
withCString label Raw.treePush
|
|
|
|
|
|
-- | Wraps @ImGui::Selectable()@.
|
|
selectable :: MonadIO m => String -> m Bool
|
|
selectable label = liftIO do
|
|
withCString label Raw.selectable
|
|
|
|
|
|
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
|
|
changed <- Raw.listBox labelPtr iPtr itemsPtr (fromIntegral len)
|
|
|
|
when changed do
|
|
i' <- peek iPtr
|
|
selectedIndex $=! fromIntegral i'
|
|
|
|
return changed
|
|
|
|
|
|
-- | Wraps @ImGui::PlotHistogram()@.
|
|
plotHistogram :: MonadIO m => String -> [CFloat] -> m ()
|
|
plotHistogram label values = liftIO $
|
|
withArrayLen values \len valuesPtr ->
|
|
withCString label \labelPtr ->
|
|
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.
|
|
--
|
|
-- Wraps @ImGui::BeginMenu()@.
|
|
beginMenu :: MonadIO m => String -> m Bool
|
|
beginMenu label = liftIO do
|
|
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
|
|
-- processed by ImGui at the moment
|
|
--
|
|
-- Wraps @ImGui::MenuItem()@
|
|
menuItem :: MonadIO m => String -> m Bool
|
|
menuItem label = liftIO do
|
|
withCString label Raw.menuItem
|
|
|
|
|
|
-- | 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 ->
|
|
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.
|
|
--
|
|
-- 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) \refPtr -> do
|
|
open <- withCString tabName \ptrName ->
|
|
Raw.beginTabItem ptrName refPtr flags
|
|
|
|
newValue <- (0 /=) <$> peek refPtr
|
|
when (newValue /= currentValue) do
|
|
ref $=! newValue
|
|
|
|
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.
|
|
--
|
|
-- Wraps @ImGui.TabItemButton@.
|
|
tabItemButton :: MonadIO m => String -> ImGuiTabItemFlags -> m Bool
|
|
tabItemButton tabName flags = liftIO do
|
|
withCString tabName \namePtr ->
|
|
Raw.tabItemButton namePtr 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 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.
|
|
--
|
|
-- Wraps @ImGui::BeginPopup()@
|
|
beginPopup :: MonadIO m => String -> m Bool
|
|
beginPopup popupId = liftIO do
|
|
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.
|
|
--
|
|
-- Wraps @ImGui::BeginPopupModal()@
|
|
beginPopupModal :: MonadIO m => String -> m Bool
|
|
beginPopupModal popupId = liftIO do
|
|
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!).
|
|
--
|
|
-- Wraps @ImGui::OpenPopup()@
|
|
openPopup :: MonadIO m => String -> m ()
|
|
openPopup popupId = liftIO do
|
|
withCString popupId Raw.openPopup
|
|
|
|
|
|
withCStringOrNull :: Maybe String -> (Ptr CChar -> IO a) -> IO a
|
|
withCStringOrNull Nothing k = k nullPtr
|
|
withCStringOrNull (Just s) k = withCString s k
|
|
|
|
|
|
-- | 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 ()
|
|
setNextWindowPos posRef cond pivotMaybe = liftIO do
|
|
pos <- get posRef
|
|
with pos $ \posPtr ->
|
|
case pivotMaybe of
|
|
Just pivotRef -> do
|
|
pivot <- get pivotRef
|
|
with pivot $ \pivotPtr ->
|
|
Raw.setNextWindowPos posPtr cond (Just pivotPtr)
|
|
Nothing ->
|
|
Raw.setNextWindowPos posPtr cond Nothing
|
|
|
|
-- | Set next window size. Call before `begin`
|
|
--
|
|
-- Wraps @ImGui::SetNextWindowSize()@
|
|
setNextWindowSize :: (MonadIO m, HasGetter ref ImVec2) => ref -> ImGuiCond -> m ()
|
|
setNextWindowSize sizeRef cond = liftIO do
|
|
size' <- get sizeRef
|
|
with size' \sizePtr ->
|
|
Raw.setNextWindowSize sizePtr cond
|
|
|
|
-- | 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
|
|
with size' Raw.setNextWindowContentSize
|
|
|
|
|
|
-- | 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
|
|
with sizeMin \sizeMinPtr ->
|
|
with sizeMax \sizeMaxPtr ->
|
|
Raw.setNextWindowSizeConstraints sizeMinPtr sizeMaxPtr
|
|
|
|
|
|
-- | Set next window collapsed state. call before `begin`
|
|
--
|
|
-- Wraps @ImGui::SetNextWindowCollapsed()@
|
|
setNextWindowCollapsed :: (MonadIO m) => Bool -> ImGuiCond -> m ()
|
|
setNextWindowCollapsed b cond = liftIO do
|
|
Raw.setNextWindowCollapsed (bool 0 1 b) cond
|
|
|
|
|
|
-- | 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 ()
|
|
setNextWindowBgAlpha alpha = liftIO do
|
|
Raw.setNextWindowBgAlpha (CFloat alpha)
|
|
|
|
|
|
-- | 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 ()
|
|
dummy sizeRef = liftIO do
|
|
size' <- get sizeRef
|
|
with size' Raw.dummy
|
|
|
|
withIndent :: MonadUnliftIO m => Float -> m a -> m a
|
|
withIndent width =
|
|
bracket_ (indent width) (unindent width)
|
|
|
|
-- | 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
|
|
Raw.indent (CFloat indent_w)
|
|
|
|
|
|
-- | 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
|
|
Raw.unindent (CFloat f)
|
|
|
|
|
|
-- | Affect large frame+labels widgets only.
|
|
--
|
|
-- Wraps @ImGui::SetNextItemWidth()@
|
|
setNextItemWidth :: (MonadIO m) => Float -> m ()
|
|
setNextItemWidth itemWidth = liftIO do
|
|
Raw.setNextItemWidth (CFloat itemWidth)
|
|
|
|
|
|
withItemWidth :: MonadUnliftIO m => Float -> m a -> m a
|
|
withItemWidth width =
|
|
bracket_ (pushItemWidth width) Raw.popItemWidth
|
|
|
|
-- Wraps @ImGui::PushItemWidth()@
|
|
pushItemWidth :: (MonadIO m) => Float -> m ()
|
|
pushItemWidth itemWidth = liftIO do
|
|
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
|
|
--
|
|
-- Wraps @ImGui::SetCursorPos()@
|
|
setCursorPos :: (MonadIO m, HasGetter ref ImVec2) => ref -> m ()
|
|
setCursorPos posRef = liftIO do
|
|
pos <- get posRef
|
|
with pos Raw.setCursorPos
|
|
|
|
-- | Add an element to a ID stack
|
|
--
|
|
-- Read the FAQ (http://dearimgui.org/faq) for more details
|
|
-- about how ID are handled in dear imgui.
|
|
--
|
|
-- Those questions are answered and impacted by understanding of the ID stack system:
|
|
-- * "Q: Why is my widget not reacting when I click on it?"
|
|
-- * "Q: How can I have widgets with an empty label?"
|
|
-- * "Q: How can I have multiple widgets with the same label?"
|
|
--
|
|
-- Wraps @ImGui::PushId@ and @ImGui::PopId@
|
|
withID :: (MonadUnliftIO m, ToID id) => id -> m a -> m a
|
|
withID i = bracket_ (liftIO $ pushID i) Raw.popID
|
|
|
|
-- | A supplementary class to match overloaded functions in C++ the library.
|
|
class ToID a where
|
|
pushID :: MonadIO m => a -> m ()
|
|
|
|
instance ToID CInt where
|
|
pushID = Raw.pushIDInt
|
|
|
|
instance ToID Int where
|
|
pushID = Raw.pushIDInt . fromIntegral
|
|
|
|
instance ToID Integer where
|
|
pushID = Raw.pushIDInt . fromInteger
|
|
|
|
instance {-# OVERLAPPABLE #-} ToID (Ptr a) where
|
|
pushID = Raw.pushIDPtr
|
|
|
|
instance {-# OVERLAPPING #-} ToID (Ptr CChar) where
|
|
pushID = Raw.pushIDStr
|
|
|
|
instance ToID (Ptr CChar, Int) where
|
|
pushID = Raw.pushIDStrLen
|
|
|
|
instance ToID String where
|
|
pushID s = liftIO $ withCStringLen s pushID
|
|
|
|
withStyleColor :: (MonadUnliftIO m, HasGetter ref ImVec4) => ImGuiCol -> ref -> m a -> m a
|
|
withStyleColor color ref =
|
|
bracket_ (pushStyleColor color ref) (Raw.popStyleColor 1)
|
|
|
|
-- | Modify a style color by pushing to the shared stack.
|
|
--
|
|
-- Always use this if you modify the style after `newFrame`.
|
|
--
|
|
-- Wraps @ImGui::PushStyleColor()@
|
|
pushStyleColor :: (MonadIO m, HasGetter ref ImVec4) => ImGuiCol -> ref -> m ()
|
|
pushStyleColor col colorRef = liftIO do
|
|
color <- get colorRef
|
|
with color \colorPtr ->
|
|
Raw.pushStyleColor col colorPtr
|
|
|
|
withStyleVar :: (MonadUnliftIO m, HasGetter ref ImVec2) => ImGuiStyleVar -> ref -> m a -> m a
|
|
withStyleVar style ref =
|
|
bracket_ (pushStyleVar style ref) (Raw.popStyleVar 1)
|
|
|
|
-- | Modify a style variable by pushing to the shared stack.
|
|
--
|
|
-- Always use this if you modify the style after `newFrame`.
|
|
--
|
|
-- Wraps @ImGui::PushStyleVar()@
|
|
pushStyleVar :: (MonadIO m, HasGetter ref ImVec2) => ImGuiStyleVar -> ref -> m ()
|
|
pushStyleVar style valRef = liftIO do
|
|
val <- get valRef
|
|
with val \valPtr ->
|
|
Raw.pushStyleVar style valPtr
|
|
|
|
-- | Remove style variable modifications from the shared stack
|
|
--
|
|
-- Wraps @ImGui::PopStyleVar()@
|
|
popStyleVar :: (MonadIO m) => Int -> m ()
|
|
popStyleVar n = liftIO do
|
|
Raw.popStyleVar (fromIntegral n)
|