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-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, exporting the functions to create a GUI.
|
|
|
|
-}
|
|
|
|
|
2021-01-24 15:27:03 +00:00
|
|
|
module DearImGui
|
|
|
|
( -- * Context Creation and Access
|
|
|
|
Context(..)
|
|
|
|
, createContext
|
|
|
|
, destroyContext
|
|
|
|
|
|
|
|
-- * Main
|
|
|
|
, newFrame
|
|
|
|
, endFrame
|
|
|
|
, render
|
|
|
|
, DrawData(..)
|
|
|
|
, getDrawData
|
|
|
|
, checkVersion
|
|
|
|
|
|
|
|
-- * Demo, Debug, Information
|
|
|
|
, showDemoWindow
|
|
|
|
, showMetricsWindow
|
|
|
|
, showAboutWindow
|
|
|
|
, showUserGuide
|
|
|
|
, getVersion
|
|
|
|
|
|
|
|
-- * Styles
|
|
|
|
, styleColorsDark
|
|
|
|
, styleColorsLight
|
|
|
|
, styleColorsClassic
|
|
|
|
|
|
|
|
-- * Windows
|
|
|
|
, begin
|
|
|
|
, end
|
|
|
|
|
2021-01-28 22:38:25 +00:00
|
|
|
-- * Child Windows
|
|
|
|
, beginChild
|
|
|
|
, endChild
|
|
|
|
|
2021-01-24 16:58:52 +00:00
|
|
|
-- * Cursor/Layout
|
2021-01-24 17:00:25 +00:00
|
|
|
, separator
|
2021-01-24 16:58:52 +00:00
|
|
|
, sameLine
|
|
|
|
|
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-01-24 15:56:23 +00:00
|
|
|
, bullet
|
2021-01-24 15:54:39 +00:00
|
|
|
|
2021-01-24 16:14:51 +00:00
|
|
|
-- ** Combo Box
|
|
|
|
, beginCombo
|
|
|
|
, endCombo
|
|
|
|
|
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-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-24 16:14:51 +00:00
|
|
|
-- ** Selectables
|
|
|
|
, selectable
|
|
|
|
|
2021-01-24 20:23:58 +00:00
|
|
|
-- * Data Plotting
|
|
|
|
, plotHistogram
|
|
|
|
|
2021-01-24 16:49:28 +00:00
|
|
|
-- ** Menus
|
|
|
|
, beginMenuBar
|
|
|
|
, endMenuBar
|
|
|
|
, beginMainMenuBar
|
|
|
|
, endMainMenuBar
|
|
|
|
, beginMenu
|
|
|
|
, endMenu
|
|
|
|
, menuItem
|
|
|
|
|
2021-01-24 17:39:44 +00:00
|
|
|
-- * Tooltips
|
|
|
|
, beginTooltip
|
|
|
|
, endTooltip
|
|
|
|
|
2021-01-24 17:35:00 +00:00
|
|
|
-- * Popups/Modals
|
|
|
|
, beginPopup
|
|
|
|
, beginPopupModal
|
|
|
|
, endPopup
|
|
|
|
, openPopup
|
|
|
|
, closeCurrentPopup
|
|
|
|
|
2021-01-24 17:39:35 +00:00
|
|
|
-- * Item/Widgets Utilities
|
|
|
|
, isItemHovered
|
|
|
|
|
2021-01-24 15:54:39 +00:00
|
|
|
-- * Types
|
|
|
|
, ImGuiDir
|
|
|
|
, pattern ImGuiDirLeft
|
|
|
|
, pattern ImGuiDirRight
|
|
|
|
, pattern ImGuiDirUp
|
|
|
|
, pattern ImGuiDirDown
|
2021-01-25 09:11:46 +00:00
|
|
|
, ImVec3(..)
|
2021-01-24 20:46:01 +00:00
|
|
|
, ImVec4(..)
|
2021-01-24 15:27:03 +00:00
|
|
|
)
|
|
|
|
where
|
|
|
|
|
2021-01-24 19:25:40 +01:00
|
|
|
-- base
|
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
|
|
|
|
import DearImGui.Context
|
|
|
|
|
2021-01-24 19:25:40 +01:00
|
|
|
-- inline-c
|
2021-01-24 15:27:03 +00:00
|
|
|
import qualified Language.C.Inline as C
|
2021-01-24 19:25:40 +01:00
|
|
|
|
|
|
|
-- inline-c-cpp
|
2021-01-24 15:27:03 +00:00
|
|
|
import qualified Language.C.Inline.Cpp as Cpp
|
2021-01-24 19:25:40 +01:00
|
|
|
|
|
|
|
-- StateVar
|
|
|
|
import Data.StateVar
|
|
|
|
( HasGetter(get), HasSetter, ($=!) )
|
|
|
|
|
|
|
|
-- transformers
|
|
|
|
import Control.Monad.IO.Class
|
|
|
|
( MonadIO, liftIO )
|
|
|
|
|
2021-01-24 15:27:03 +00:00
|
|
|
|
2021-01-24 20:46:01 +00:00
|
|
|
C.context (Cpp.cppCtx <> C.bsCtx <> imguiContext)
|
2021-01-24 15:27:03 +00:00
|
|
|
C.include "imgui.h"
|
|
|
|
Cpp.using "namespace ImGui"
|
|
|
|
|
|
|
|
|
|
|
|
-- | Wraps @ImGuiContext*@.
|
|
|
|
newtype Context = Context (Ptr ())
|
|
|
|
|
|
|
|
|
|
|
|
-- | Wraps @ImGui::CreateContext()@.
|
2021-01-24 16:34:36 +00:00
|
|
|
createContext :: MonadIO m => m Context
|
|
|
|
createContext = liftIO do
|
2021-01-24 15:27:03 +00:00
|
|
|
Context <$> [C.exp| void* { CreateContext() } |]
|
|
|
|
|
|
|
|
|
|
|
|
-- | Wraps @ImGui::DestroyContext()@.
|
2021-01-24 16:34:36 +00:00
|
|
|
destroyContext :: MonadIO m => Context -> m ()
|
|
|
|
destroyContext (Context contextPtr) = liftIO do
|
2021-01-24 15:27:03 +00:00
|
|
|
[C.exp| void { DestroyContext((ImGuiContext*)$(void* contextPtr)); } |]
|
|
|
|
|
|
|
|
|
|
|
|
-- | Start a new Dear ImGui frame, you can submit any command from this point
|
|
|
|
-- until 'render'/'endFrame'.
|
|
|
|
--
|
|
|
|
-- Wraps @ImGui::NewFrame()@.
|
2021-01-24 16:34:36 +00:00
|
|
|
newFrame :: MonadIO m => m ()
|
|
|
|
newFrame = liftIO do
|
|
|
|
[C.exp| void { ImGui::NewFrame(); } |]
|
2021-01-24 15:27:03 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- | Ends the Dear ImGui frame. automatically called by 'render'. If you don't
|
|
|
|
-- need to render data (skipping rendering) you may call 'endFrame' without
|
|
|
|
-- 'render'... but you'll have wasted CPU already! If you don't need to render,
|
|
|
|
-- better to not create any windows and not call 'newFrame' at all!
|
2021-01-24 16:34:36 +00:00
|
|
|
endFrame :: MonadIO m => m ()
|
|
|
|
endFrame = liftIO do
|
|
|
|
[C.exp| void { ImGui::EndFrame(); } |]
|
2021-01-24 15:27:03 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- | Ends the Dear ImGui frame, finalize the draw data. You can then get call
|
|
|
|
-- 'getDrawData'.
|
2021-01-24 16:34:36 +00:00
|
|
|
render :: MonadIO m => m ()
|
|
|
|
render = liftIO do
|
|
|
|
[C.exp| void { ImGui::Render(); } |]
|
2021-01-24 15:27:03 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- | Wraps @ImDrawData*@.
|
|
|
|
newtype DrawData = DrawData (Ptr ())
|
|
|
|
|
|
|
|
|
|
|
|
-- | Valid after 'render' and until the next call to 'newFrame'. This is what
|
|
|
|
-- you have to render.
|
2021-01-24 16:34:36 +00:00
|
|
|
getDrawData :: MonadIO m => m DrawData
|
|
|
|
getDrawData = liftIO do
|
|
|
|
DrawData <$> [C.exp| void* { ImGui::GetDrawData() } |]
|
2021-01-24 15:27:03 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- | Wraps @IMGUI_CHECKVERSION()@
|
2021-01-24 16:34:36 +00:00
|
|
|
checkVersion :: MonadIO m => m ()
|
|
|
|
checkVersion = liftIO do
|
2021-01-24 15:27:03 +00:00
|
|
|
[C.exp| void { IMGUI_CHECKVERSION(); } |]
|
|
|
|
|
|
|
|
|
|
|
|
-- | Create demo window. Demonstrate most ImGui features. Call this to learn
|
|
|
|
-- about the library! Try to make it always available in your application!
|
2021-01-24 16:34:36 +00:00
|
|
|
showDemoWindow :: MonadIO m => m ()
|
|
|
|
showDemoWindow = liftIO do
|
|
|
|
[C.exp| void { ImGui::ShowDemoWindow(); } |]
|
2021-01-24 15:27:03 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- | Create Metrics/Debugger window. Display Dear ImGui internals: windows, draw
|
|
|
|
-- commands, various internal state, etc.
|
2021-01-24 16:34:36 +00:00
|
|
|
showMetricsWindow :: MonadIO m => m ()
|
|
|
|
showMetricsWindow = liftIO do
|
|
|
|
[C.exp| void { ImGui::ShowMetricsWindow(); } |]
|
2021-01-24 15:27:03 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- | Create About window. display Dear ImGui version, credits and build/system
|
|
|
|
-- information.
|
2021-01-24 16:34:36 +00:00
|
|
|
showAboutWindow :: MonadIO m => m ()
|
|
|
|
showAboutWindow = liftIO do
|
|
|
|
[C.exp| void { ShowAboutWindow(); } |]
|
2021-01-24 15:27:03 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- | Add basic help/info block (not a window): how to manipulate ImGui as a
|
|
|
|
-- end-user (mouse/keyboard controls).
|
2021-01-24 16:34:36 +00:00
|
|
|
showUserGuide :: MonadIO m => m ()
|
|
|
|
showUserGuide = liftIO do
|
|
|
|
[C.exp| void { ShowUserGuide() } |]
|
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
|
|
|
|
peekCString =<< [C.exp| const char* { GetVersion() } |]
|
2021-01-24 15:27:03 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- | New, recommended style (default).
|
|
|
|
--
|
|
|
|
-- Wraps @ImGui::StyleColorsDark()@.
|
2021-01-24 16:34:36 +00:00
|
|
|
styleColorsDark :: MonadIO m => m ()
|
|
|
|
styleColorsDark = liftIO do
|
|
|
|
[C.exp| void { StyleColorsDark(); } |]
|
2021-01-24 15:27:03 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- | Best used with borders and a custom, thicker font.
|
|
|
|
--
|
|
|
|
-- Wraps @ImGui::StyleColorsLight()@.
|
2021-01-24 16:34:36 +00:00
|
|
|
styleColorsLight :: MonadIO m => m ()
|
|
|
|
styleColorsLight = liftIO do
|
|
|
|
[C.exp| void { StyleColorsLight(); } |]
|
2021-01-24 15:27:03 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- | Classic ImGui style.
|
|
|
|
--
|
|
|
|
-- Wraps @ImGui::StyleColorsClasic()@.
|
2021-01-24 16:34:36 +00:00
|
|
|
styleColorsClassic :: MonadIO m => m ()
|
|
|
|
styleColorsClassic = liftIO do
|
|
|
|
[C.exp| void { StyleColorsClassic(); } |]
|
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
|
|
|
|
withCString name \namePtr ->
|
2021-01-26 12:35:09 +01:00
|
|
|
(0 /=) <$> [C.exp| bool { ImGui::Begin($(char* namePtr)) } |]
|
2021-01-24 15:27:03 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- | Pop window from the stack.
|
|
|
|
--
|
|
|
|
-- Wraps @ImGui::End()@.
|
2021-01-24 16:34:36 +00:00
|
|
|
end :: MonadIO m => m ()
|
|
|
|
end = liftIO do
|
|
|
|
[C.exp| void { ImGui::End(); } |]
|
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
|
|
|
|
withCString name \namePtr ->
|
|
|
|
(0 /=) <$> [C.exp| bool { ImGui::BeginChild($(char* namePtr)) } |]
|
|
|
|
|
|
|
|
|
|
|
|
-- | Wraps @ImGui::EndChild()@.
|
|
|
|
endChild :: MonadIO m => m ()
|
|
|
|
endChild = liftIO do
|
|
|
|
[C.exp| void { ImGui::EndChild(); } |]
|
|
|
|
|
|
|
|
|
2021-01-24 17:00:25 +00:00
|
|
|
-- | Separator, generally horizontal. inside a menu bar or in horizontal layout
|
|
|
|
-- mode, this becomes a vertical separator.
|
|
|
|
--
|
|
|
|
-- Wraps @ImGui::Separator()@
|
|
|
|
separator :: MonadIO m => m ()
|
|
|
|
separator = liftIO do
|
|
|
|
[C.exp| void { Separator(); } |]
|
2021-01-24 15:27:03 +00:00
|
|
|
|
|
|
|
|
2021-01-24 16:58:52 +00:00
|
|
|
-- | Call between widgets or groups to layout them horizontally.
|
|
|
|
--
|
|
|
|
-- Wraps @ImGui::SameLine@.
|
|
|
|
sameLine :: MonadIO m => m ()
|
|
|
|
sameLine = liftIO do
|
|
|
|
[C.exp| void { SameLine(); } |]
|
|
|
|
|
|
|
|
|
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
|
|
|
|
withCString t \textPtr ->
|
2021-01-25 12:07:00 +00:00
|
|
|
[C.exp| void { Text("%s", $(char* textPtr)) } |]
|
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
|
|
|
|
withCString label \labelPtr ->
|
2021-01-26 12:35:09 +01:00
|
|
|
(0 /=) <$> [C.exp| bool { Button($(char* labelPtr)) } |]
|
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
|
|
|
|
withCString label \labelPtr ->
|
2021-01-26 12:35:09 +01:00
|
|
|
(0 /=) <$> [C.exp| bool { SmallButton($(char* labelPtr)) } |]
|
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
|
|
|
|
arrowButton strId (ImGuiDir dir) = liftIO do
|
|
|
|
withCString strId \strIdPtr ->
|
2021-01-26 12:35:09 +01:00
|
|
|
(0 /=) <$> [C.exp| bool { ArrowButton($(char* strIdPtr), $(int 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
|
|
|
|
with (bool 0 1 currentValue :: CBool) \boolPtr -> do
|
|
|
|
changed <- withCString label \labelPtr ->
|
2021-01-26 12:35:09 +01:00
|
|
|
(0 /=) <$> [C.exp| bool { Checkbox($(char* labelPtr), $(bool* boolPtr)) } |]
|
2021-01-24 15:56:14 +00:00
|
|
|
|
|
|
|
newValue <- peek boolPtr
|
|
|
|
ref $=! (newValue == 1)
|
|
|
|
|
|
|
|
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 ->
|
|
|
|
[C.exp| void { ProgressBar($(float c'progress), ImVec2(-FLT_MIN, 0), $(char* overlayPtr)) } |]
|
2021-01-24 16:03:18 +00:00
|
|
|
where
|
|
|
|
c'progress :: CFloat
|
|
|
|
c'progress = realToFrac progress
|
|
|
|
|
|
|
|
|
2021-01-24 15:56:23 +00:00
|
|
|
-- | Draw a small circle + keep the cursor on the same line. Advance cursor x
|
|
|
|
-- position by 'getTreeNodeToLabelSpacing', same distance that 'treeNode' uses.
|
2021-01-24 16:34:36 +00:00
|
|
|
bullet :: MonadIO m => m ()
|
|
|
|
bullet = liftIO do
|
|
|
|
[C.exp| void { Bullet() } |]
|
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'.
|
|
|
|
--
|
|
|
|
-- 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-01-26 12:35:09 +01:00
|
|
|
(0 /=) <$> [C.exp| bool { BeginCombo($(char* labelPtr), $(char* previewValuePtr)) } |]
|
2021-01-24 16:14:51 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- | Only call 'endCombo' if 'beginCombon' returns 'True'!
|
|
|
|
--
|
|
|
|
-- Wraps @ImGui::EndCombo()@.
|
2021-01-24 16:34:36 +00:00
|
|
|
endCombo :: MonadIO m => m ()
|
|
|
|
endCombo = liftIO do
|
|
|
|
[C.exp| void { EndCombo() } |]
|
2021-01-24 16:14:51 +00: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 ->
|
|
|
|
(0 /=) <$> [C.exp| bool { DragFloat( $(char* descPtr), $(float *floatPtr), $(float speed'), $(float min'), $(float max')) } |]
|
|
|
|
|
|
|
|
newValue <- peek floatPtr
|
|
|
|
ref $=! realToFrac newValue
|
|
|
|
|
|
|
|
return changed
|
|
|
|
where
|
|
|
|
min', max', speed' :: CFloat
|
|
|
|
min' = realToFrac minValue
|
|
|
|
max' = realToFrac maxValue
|
|
|
|
speed' = realToFrac speed
|
|
|
|
|
|
|
|
|
|
|
|
-- | 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 ->
|
|
|
|
(0 /=) <$> [C.exp| bool { DragFloat2( $(char* descPtr), $(float *floatPtr), $(float speed'), $(float min'), $(float max')) } |]
|
|
|
|
|
|
|
|
[x', y'] <- peekArray 2 floatPtr
|
|
|
|
ref $=! (realToFrac x', realToFrac y')
|
|
|
|
|
|
|
|
return changed
|
|
|
|
where
|
|
|
|
min', max', speed' :: CFloat
|
|
|
|
min' = realToFrac minValue
|
|
|
|
max' = realToFrac maxValue
|
|
|
|
speed' = realToFrac speed
|
|
|
|
|
|
|
|
|
|
|
|
-- | 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 ->
|
|
|
|
(0 /=) <$> [C.exp| bool { DragFloat3( $(char* descPtr), $(float *floatPtr), $(float speed'), $(float min'), $(float max')) } |]
|
|
|
|
|
|
|
|
[x', y', z'] <- peekArray 3 floatPtr
|
|
|
|
ref $=! (realToFrac x', realToFrac y', realToFrac z')
|
|
|
|
|
|
|
|
return changed
|
|
|
|
where
|
|
|
|
min', max', speed' :: CFloat
|
|
|
|
min' = realToFrac minValue
|
|
|
|
max' = realToFrac maxValue
|
|
|
|
speed' = realToFrac speed
|
|
|
|
|
|
|
|
|
|
|
|
-- | 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 ->
|
|
|
|
(0 /=) <$> [C.exp| bool { DragFloat4( $(char* descPtr), $(float *floatPtr), $(float speed'), $(float min'), $(float max')) } |]
|
|
|
|
|
|
|
|
[x', y', z', u'] <- peekArray 4 floatPtr
|
|
|
|
ref $=! (realToFrac x', realToFrac y', realToFrac z', realToFrac u')
|
|
|
|
|
|
|
|
return changed
|
|
|
|
where
|
|
|
|
min', max', speed' :: CFloat
|
|
|
|
min' = realToFrac minValue
|
|
|
|
max' = realToFrac maxValue
|
|
|
|
speed' = realToFrac speed
|
|
|
|
|
|
|
|
|
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-01-26 12:35:09 +01:00
|
|
|
(0 /=) <$> [C.exp| bool { SliderFloat( $(char* descPtr), $(float *floatPtr), $(float min'), $(float max')) } |]
|
2021-01-25 19:04:43 +00:00
|
|
|
|
|
|
|
newValue <- peek floatPtr
|
|
|
|
ref $=! realToFrac newValue
|
|
|
|
|
|
|
|
return changed
|
|
|
|
where
|
|
|
|
min', max' :: CFloat
|
|
|
|
min' = realToFrac minValue
|
|
|
|
max' = realToFrac maxValue
|
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 ->
|
|
|
|
(0 /=) <$> [C.exp| bool { SliderFloat2( $(char* descPtr), $(float *floatPtr), $(float min'), $(float max')) } |]
|
|
|
|
|
|
|
|
[x', y'] <- peekArray 2 floatPtr
|
|
|
|
ref $=! (realToFrac x', realToFrac y')
|
|
|
|
|
|
|
|
return changed
|
|
|
|
where
|
|
|
|
min', max' :: CFloat
|
|
|
|
min' = realToFrac minValue
|
|
|
|
max' = realToFrac maxValue
|
|
|
|
|
|
|
|
|
|
|
|
-- | 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 ->
|
|
|
|
(0 /=) <$> [C.exp| bool { SliderFloat3( $(char* descPtr), $(float *floatPtr), $(float min'), $(float max')) } |]
|
|
|
|
|
|
|
|
[x', y', z'] <- peekArray 3 floatPtr
|
|
|
|
ref $=! (realToFrac x', realToFrac y', realToFrac z')
|
|
|
|
|
|
|
|
return changed
|
|
|
|
where
|
|
|
|
min', max' :: CFloat
|
|
|
|
min' = realToFrac minValue
|
|
|
|
max' = realToFrac maxValue
|
|
|
|
|
|
|
|
|
|
|
|
-- | 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 ->
|
|
|
|
(0 /=) <$> [C.exp| bool { SliderFloat4( $(char* descPtr), $(float *floatPtr), $(float min'), $(float max')) } |]
|
|
|
|
|
|
|
|
[x', y', z', u'] <- peekArray 4 floatPtr
|
|
|
|
ref $=! (realToFrac x', realToFrac y', realToFrac z', realToFrac u')
|
|
|
|
|
|
|
|
return changed
|
|
|
|
where
|
|
|
|
min', max' :: CFloat
|
|
|
|
min' = realToFrac minValue
|
|
|
|
max' = realToFrac maxValue
|
|
|
|
|
|
|
|
|
|
|
|
-- | 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 ->
|
|
|
|
(0 /= ) <$> [C.exp| bool { ColorPicker3( $(char* descPtr), $(float *refPtr) ) } |]
|
|
|
|
|
|
|
|
[x', y', z'] <- peekArray 3 refPtr
|
|
|
|
ref $=! ImVec3 (realToFrac x') (realToFrac y') (realToFrac z')
|
|
|
|
|
|
|
|
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-01-26 12:35:09 +01:00
|
|
|
(0 /=) <$> [C.exp| bool { ColorButton( $(char* descPtr), *$(ImVec4 *refPtr) ) } |]
|
2021-01-24 20:46:01 +00:00
|
|
|
|
|
|
|
newValue <- peek refPtr
|
|
|
|
ref $=! newValue
|
|
|
|
|
|
|
|
return changed
|
|
|
|
|
|
|
|
|
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
|
|
|
|
withCString label \labelPtr ->
|
2021-01-26 12:35:09 +01:00
|
|
|
(0 /=) <$> [C.exp| bool { Selectable($(char* labelPtr)) } |]
|
2021-01-24 16:14:51 +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 ->
|
|
|
|
withCString label \labelPtr -> do
|
|
|
|
let c'len = fromIntegral len
|
|
|
|
[C.exp| void { PlotHistogram($(char* labelPtr), $(float* valuesPtr), $(int c'len)) } |]
|
|
|
|
|
|
|
|
|
2021-01-24 16:49:28 +00:00
|
|
|
-- | Append to menu-bar of current window (requires 'ImGuiWindowFlagsMenuBar'
|
|
|
|
-- flag set on parent window).
|
|
|
|
--
|
|
|
|
-- Wraps @ImGui::BeginMenuBar()@.
|
|
|
|
beginMenuBar :: MonadIO m => m Bool
|
|
|
|
beginMenuBar = liftIO do
|
2021-01-26 12:35:09 +01:00
|
|
|
(0 /=) <$> [C.exp| bool { BeginMenuBar() } |]
|
2021-01-24 16:49:28 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- | Only call 'endMenuBar' if 'beginMenuBar' returns true!
|
|
|
|
--
|
|
|
|
-- Wraps @ImGui::EndMenuBar()@.
|
|
|
|
endMenuBar :: MonadIO m => m ()
|
|
|
|
endMenuBar = liftIO do
|
|
|
|
[C.exp| void { EndMenuBar(); } |]
|
|
|
|
|
|
|
|
|
|
|
|
-- | Create and append to a full screen menu-bar.
|
|
|
|
--
|
|
|
|
-- Wraps @ImGui::BeginMainMenuBar()@.
|
|
|
|
beginMainMenuBar :: MonadIO m => m Bool
|
|
|
|
beginMainMenuBar = liftIO do
|
2021-01-26 12:35:09 +01:00
|
|
|
(0 /=) <$> [C.exp| bool { BeginMainMenuBar() } |]
|
2021-01-24 16:49:28 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- | Only call 'endMainMenuBar' if 'beginMainMenuBar' returns true!
|
|
|
|
--
|
|
|
|
-- Wraps @ImGui::EndMainMenuBar()@.
|
|
|
|
endMainMenuBar :: MonadIO m => m ()
|
|
|
|
endMainMenuBar = liftIO do
|
|
|
|
[C.exp| void { EndMainMenuBar(); } |]
|
|
|
|
|
|
|
|
|
|
|
|
-- | Create a sub-menu entry.
|
|
|
|
--
|
|
|
|
-- Wraps @ImGui::BeginMenu()@.
|
|
|
|
beginMenu :: MonadIO m => String -> m Bool
|
|
|
|
beginMenu label = liftIO do
|
|
|
|
withCString label \labelPtr ->
|
2021-01-26 12:35:09 +01:00
|
|
|
(0 /=) <$> [C.exp| bool { BeginMenu($(char* labelPtr)) } |]
|
2021-01-24 16:49:28 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- | Only call 'endMenu' if 'beginMenu' returns true!
|
|
|
|
--
|
|
|
|
-- Wraps @ImGui::EndMenu()@.
|
|
|
|
endMenu :: MonadIO m => m ()
|
|
|
|
endMenu = liftIO do
|
|
|
|
[C.exp| void { EndMenu(); } |]
|
|
|
|
|
|
|
|
|
|
|
|
-- 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 \labelPtr ->
|
2021-01-26 12:35:09 +01:00
|
|
|
(0 /=) <$> [C.exp| bool { MenuItem($(char* labelPtr)) } |]
|
2021-01-24 16:49:28 +00:00
|
|
|
|
|
|
|
|
2021-01-24 17:39:44 +00:00
|
|
|
-- | Begin/append a tooltip window to create full-featured tooltip (with any
|
|
|
|
-- kind of items).
|
|
|
|
--
|
|
|
|
-- Wraps @ImGui::BeginTooltip()@
|
|
|
|
beginTooltip :: MonadIO m => m ()
|
|
|
|
beginTooltip = liftIO do
|
|
|
|
[C.exp| void { BeginTooltip() } |]
|
|
|
|
|
|
|
|
|
|
|
|
-- | Wraps @ImGui::EndTooltip()@
|
|
|
|
endTooltip :: MonadIO m => m ()
|
|
|
|
endTooltip = liftIO do
|
|
|
|
[C.exp| void { EndTooltip() } |]
|
|
|
|
|
|
|
|
|
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
|
|
|
|
withCString popupId \popupIdPtr ->
|
2021-01-26 12:35:09 +01:00
|
|
|
(0 /=) <$> [C.exp| bool { BeginPopup($(char* popupIdPtr)) } |]
|
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
|
|
|
|
withCString popupId \popupIdPtr ->
|
2021-01-26 12:35:09 +01:00
|
|
|
(0 /=) <$> [C.exp| bool { BeginPopupModal($(char* popupIdPtr)) } |]
|
2021-01-24 17:35:00 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- | Only call 'endPopup' if 'beginPopup' or 'beginPopupModal' returns 'True'!
|
|
|
|
--
|
|
|
|
-- Wraps @ImGui::BeginPopupModal()@
|
|
|
|
endPopup :: MonadIO m => m ()
|
|
|
|
endPopup = liftIO do
|
|
|
|
[C.exp| void { EndPopup() } |]
|
|
|
|
|
|
|
|
|
|
|
|
-- | 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 \popupIdPtr ->
|
|
|
|
[C.exp| void { OpenPopup($(char* popupIdPtr)) } |]
|
|
|
|
|
|
|
|
|
|
|
|
-- | Manually close the popup we have begin-ed into.
|
|
|
|
--
|
|
|
|
-- Wraps @ImGui::ClosePopup()@
|
|
|
|
closeCurrentPopup :: MonadIO m => m ()
|
|
|
|
closeCurrentPopup = liftIO do
|
|
|
|
[C.exp| void { CloseCurrentPopup() } |]
|
|
|
|
|
|
|
|
|
2021-01-24 17:39:35 +00:00
|
|
|
-- | Is the last item hovered? (and usable, aka not blocked by a popup, etc.).
|
|
|
|
--
|
|
|
|
-- Wraps @ImGui::IsItemHovered()@
|
|
|
|
isItemHovered :: MonadIO m => m Bool
|
|
|
|
isItemHovered = liftIO do
|
2021-01-26 12:35:09 +01:00
|
|
|
(0 /=) <$> [C.exp| bool { IsItemHovered() } |]
|
2021-01-24 17:39:35 +00:00
|
|
|
|
|
|
|
|
2021-01-24 15:54:39 +00:00
|
|
|
-- | A cardinal direction.
|
|
|
|
newtype ImGuiDir = ImGuiDir CInt
|
|
|
|
|
|
|
|
|
|
|
|
pattern ImGuiDirLeft, ImGuiDirRight, ImGuiDirUp, ImGuiDirDown :: ImGuiDir
|
|
|
|
pattern ImGuiDirLeft = ImGuiDir 0
|
|
|
|
pattern ImGuiDirRight = ImGuiDir 1
|
|
|
|
pattern ImGuiDirUp = ImGuiDir 2
|
|
|
|
pattern ImGuiDirDown = ImGuiDir 3
|
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
|