{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# 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

    -- * 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
  , setNextWindowPos
  , setNextWindowSize
  , Raw.setNextWindowFullscreen
  , setNextWindowContentSize
  , setNextWindowSizeConstraints
  , setNextWindowCollapsed
  , setNextWindowBgAlpha

    -- * Child Windows
  , withChild
  , withChildOpen
  , beginChild
  , Raw.endChild

    -- * Parameter stacks
  , pushStyleColor
  , Raw.popStyleColor
  , pushStyleVar
  , popStyleVar

    -- * Cursor/Layout
  , Raw.separator
  , Raw.sameLine
  , Raw.newLine
  , Raw.spacing
  , dummy
  , indent
  , unindent
  , setNextItemWidth
  , pushItemWidth
  , Raw.popItemWidth

  , withGroup
  , Raw.beginGroup
  , Raw.endGroup

  , setCursorPos
  , Raw.alignTextToFramePadding

    -- * Widgets
    -- ** Text
  , text
  , textColored
  , textDisabled
  , textWrapped
  , labelText
  , bulletText

    -- ** Main
  , button
  , smallButton
  , arrowButton
  , 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

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

-- 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 :: m String
getVersion = IO String -> m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  CString -> IO String
peekCString (CString -> IO String) -> IO CString -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO CString
forall (m :: * -> *). MonadIO m => m CString
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 :: String -> m Bool
begin String
name = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
name \CString
namePtr ->
    CString -> Ptr CBool -> ImGuiWindowFlags -> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString -> Ptr CBool -> ImGuiWindowFlags -> m Bool
Raw.begin CString
namePtr Ptr CBool
forall a. Ptr a
nullPtr (CInt -> ImGuiWindowFlags
ImGuiWindowFlags CInt
0)

-- | 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 :: String -> (Bool -> m a) -> m a
withWindow String
name = m Bool -> (Bool -> m ()) -> (Bool -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (String -> m Bool
forall (m :: * -> *). MonadIO m => String -> m Bool
begin String
name) (m () -> Bool -> m ()
forall a b. a -> b -> a
const m ()
forall (m :: * -> *). MonadIO m => m ()
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 :: String -> m () -> m ()
withWindowOpen String
name m ()
action =
  String -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (Bool -> m a) -> m a
withWindow String
name (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` m ()
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 :: m () -> m ()
withFullscreen m ()
action = m Bool -> (Bool -> m ()) -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket m Bool
open Bool -> m ()
forall b. b -> m ()
close (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` m ()
action)
  where
    open :: m Bool
open = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
      IO ()
forall (m :: * -> *). MonadIO m => m ()
Raw.setNextWindowFullscreen
      String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
"FullScreen" \CString
namePtr ->
        CString -> Ptr CBool -> ImGuiWindowFlags -> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString -> Ptr CBool -> ImGuiWindowFlags -> m Bool
Raw.begin CString
namePtr Ptr CBool
forall a. Ptr a
nullPtr ImGuiWindowFlags
fullscreenFlags

    close :: b -> m ()
close = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (b -> IO ()) -> b -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> b -> IO ()
forall a b. a -> b -> a
const IO ()
forall (m :: * -> *). MonadIO m => m ()
Raw.end

fullscreenFlags :: ImGuiWindowFlags
fullscreenFlags :: ImGuiWindowFlags
fullscreenFlags = (ImGuiWindowFlags -> ImGuiWindowFlags -> ImGuiWindowFlags)
-> ImGuiWindowFlags -> [ImGuiWindowFlags] -> ImGuiWindowFlags
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ImGuiWindowFlags -> ImGuiWindowFlags -> ImGuiWindowFlags
forall a. Bits a => a -> a -> a
(.|.) ImGuiWindowFlags
forall a. Bits a => a
zeroBits
  [ ImGuiWindowFlags
ImGuiWindowFlags_NoBackground
  , ImGuiWindowFlags
ImGuiWindowFlags_NoBringToFrontOnFocus
  , ImGuiWindowFlags
ImGuiWindowFlags_NoDecoration
  , ImGuiWindowFlags
ImGuiWindowFlags_NoFocusOnAppearing
  , ImGuiWindowFlags
ImGuiWindowFlags_NoMove
  , ImGuiWindowFlags
ImGuiWindowFlags_NoResize
  , ImGuiWindowFlags
ImGuiWindowFlags_NoSavedSettings
  , ImGuiWindowFlags
ImGuiWindowFlags_NoScrollbar
  , ImGuiWindowFlags
ImGuiWindowFlags_NoScrollWithMouse
  , ImGuiWindowFlags
ImGuiWindowFlags_NoTitleBar
  ]

-- | Wraps @ImGui::BeginChild()@.
beginChild :: MonadIO m => String -> m Bool
beginChild :: String -> m Bool
beginChild String
name = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
name CString -> IO Bool
forall (m :: * -> *). MonadIO m => CString -> m Bool
Raw.beginChild

-- | Child windows used for self-contained independent scrolling/clipping regions
-- within a host window. Child windows can embed their own child.
--
-- Action will get 'False' if the child region is collapsed or fully clipped.
withChild :: MonadUnliftIO m => String -> (Bool -> m a) -> m a
withChild :: String -> (Bool -> m a) -> m a
withChild String
name = m Bool -> (Bool -> m ()) -> (Bool -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (String -> m Bool
forall (m :: * -> *). MonadIO m => String -> m Bool
beginChild String
name) (m () -> Bool -> m ()
forall a b. a -> b -> a
const m ()
forall (m :: * -> *). MonadIO m => m ()
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 :: String -> m () -> m ()
withChildOpen String
name m ()
action =
  String -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (Bool -> m a) -> m a
withChild String
name (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` m ()
action)

-- | Plain text.
text :: MonadIO m => String -> m ()
text :: String -> m ()
text String
t = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
t \CString
textPtr ->
    CString -> CString -> IO ()
forall (m :: * -> *). MonadIO m => CString -> CString -> m ()
Raw.textUnformatted CString
textPtr CString
forall a. Ptr a
nullPtr

-- | Colored text.
textColored :: (HasGetter ref ImVec4, MonadIO m) => ref -> String -> m ()
textColored :: ref -> String -> m ()
textColored ref
ref String
t = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  ImVec4
currentValue <- ref -> IO ImVec4
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref
  ImVec4 -> (Ptr ImVec4 -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with ImVec4
currentValue \Ptr ImVec4
refPtr ->
    String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
t ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ImVec4 -> CString -> IO ()
forall (m :: * -> *). MonadIO m => Ptr ImVec4 -> CString -> m ()
Raw.textColored Ptr ImVec4
refPtr

-- | Plain text in a "disabled" color according to current style.
textDisabled :: MonadIO m => String -> m ()
textDisabled :: String -> m ()
textDisabled String
t = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
t CString -> IO ()
forall (m :: * -> *). MonadIO m => CString -> m ()
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 :: String -> m ()
textWrapped String
t = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
t CString -> IO ()
forall (m :: * -> *). MonadIO m => CString -> m ()
Raw.textWrapped

-- | Label+text combo aligned to other label+value widgets.
labelText :: MonadIO m => String -> String -> m ()
labelText :: String -> String -> m ()
labelText String
label String
t = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
label \CString
labelPtr ->
    String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
t \CString
textPtr ->
      CString -> CString -> IO ()
forall (m :: * -> *). MonadIO m => CString -> CString -> m ()
Raw.labelText CString
labelPtr CString
textPtr

-- | Text with a little bullet aligned to the typical tree node.
bulletText :: MonadIO m => String -> m ()
bulletText :: String -> m ()
bulletText String
t = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
t CString -> IO ()
forall (m :: * -> *). MonadIO m => CString -> m ()
Raw.bulletText

-- | A button. Returns 'True' when clicked.
--
-- Wraps @ImGui::Button()@.
button :: MonadIO m => String -> m Bool
button :: String -> m Bool
button String
label = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
label CString -> IO Bool
forall (m :: * -> *). MonadIO m => CString -> m Bool
Raw.button


-- | Button with @FramePadding=(0,0)@ to easily embed within text.
--
-- Wraps @ImGui::SmallButton()@.
smallButton :: MonadIO m => String -> m Bool
smallButton :: String -> m Bool
smallButton String
label = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
label CString -> IO Bool
forall (m :: * -> *). MonadIO m => CString -> m Bool
Raw.smallButton


-- | Square button with an arrow shape.
--
-- Wraps @ImGui::ArrowButton()@.
arrowButton :: MonadIO m => String -> ImGuiDir -> m Bool
arrowButton :: String -> ImGuiDir -> m Bool
arrowButton String
strId ImGuiDir
dir = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
strId \CString
strIdPtr ->
    CString -> ImGuiDir -> IO Bool
forall (m :: * -> *). MonadIO m => CString -> ImGuiDir -> m Bool
Raw.arrowButton CString
strIdPtr ImGuiDir
dir


-- | Wraps @ImGui::Checkbox()@.
checkbox :: (HasSetter ref Bool, HasGetter ref Bool, MonadIO m) => String -> ref -> m Bool
checkbox :: String -> ref -> m Bool
checkbox String
label ref
ref = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  Bool
currentValue <- ref -> IO Bool
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref
  CBool -> (Ptr CBool -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (CBool -> CBool -> Bool -> CBool
forall a. a -> a -> Bool -> a
bool CBool
0 CBool
1 Bool
currentValue) \Ptr CBool
boolPtr -> do
    Bool
changed <- String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
label \CString
labelPtr ->
      CString -> Ptr CBool -> IO Bool
forall (m :: * -> *). MonadIO m => CString -> Ptr CBool -> m Bool
Raw.checkbox CString
labelPtr Ptr CBool
boolPtr

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
      CBool
newValue <- Ptr CBool -> IO CBool
forall a. Storable a => Ptr a -> IO a
peek Ptr CBool
boolPtr
      ref
ref ref -> Bool -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! (CBool
newValue CBool -> CBool -> Bool
forall a. Eq a => a -> a -> Bool
== CBool
1)

    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
changed


progressBar :: MonadIO m => Float -> Maybe String -> m ()
progressBar :: Float -> Maybe String -> m ()
progressBar Float
progress Maybe String
overlay = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  Maybe String -> (CString -> IO ()) -> IO ()
forall a. Maybe String -> (CString -> IO a) -> IO a
withCStringOrNull Maybe String
overlay \CString
overlayPtr ->
    CFloat -> CString -> IO ()
forall (m :: * -> *). MonadIO m => CFloat -> CString -> m ()
Raw.progressBar (Float -> CFloat
CFloat Float
progress) CString
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 :: String -> String -> m Bool
beginCombo String
label String
previewValue = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$
  String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
label        \CString
labelPtr ->
  String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
previewValue \CString
previewValuePtr ->
  CString -> CString -> IO Bool
forall (m :: * -> *). MonadIO m => CString -> CString -> m Bool
Raw.beginCombo CString
labelPtr CString
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 :: String -> String -> (Bool -> m a) -> m a
withCombo String
label String
previewValue =
  m Bool -> (Bool -> m ()) -> (Bool -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (String -> String -> m Bool
forall (m :: * -> *). MonadIO m => String -> String -> m Bool
beginCombo String
label String
previewValue) (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` m ()
forall (m :: * -> *). MonadIO m => m ()
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 :: String -> String -> m () -> m ()
withComboOpen String
label String
previewValue m ()
action =
  String -> String -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> String -> (Bool -> m a) -> m a
withCombo String
label String
previewValue (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` m ()
action)

-- | Wraps @ImGui::Combo()@.
combo :: (MonadIO m, HasGetter ref Int, HasSetter ref Int) => String -> ref -> [String] -> m Bool
combo :: String -> ref -> [String] -> m Bool
combo String
label ref
selectedIndex [String]
items = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Managed Bool -> (Bool -> IO Bool) -> IO Bool
forall a r. Managed a -> (a -> IO r) -> IO r
Managed.with Managed Bool
m Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return
  where
    m :: Managed Bool
m = do
      Int
i <- ref -> Managed Int
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
selectedIndex

      [CString]
cStrings <- (String -> Managed CString) -> [String] -> Managed [CString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\String
str -> (forall r. (CString -> IO r) -> IO r) -> Managed CString
forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
Managed.managed (String -> (CString -> IO r) -> IO r
forall a. String -> (CString -> IO a) -> IO a
withCString String
str)) [String]
items
      CString
labelPtr <- (forall r. (CString -> IO r) -> IO r) -> Managed CString
forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
Managed.managed ((forall r. (CString -> IO r) -> IO r) -> Managed CString)
-> (forall r. (CString -> IO r) -> IO r) -> Managed CString
forall a b. (a -> b) -> a -> b
$ String -> (CString -> IO r) -> IO r
forall a. String -> (CString -> IO a) -> IO a
withCString String
label
      Ptr CInt
iPtr     <- (forall r. (Ptr CInt -> IO r) -> IO r) -> Managed (Ptr CInt)
forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
Managed.managed ((forall r. (Ptr CInt -> IO r) -> IO r) -> Managed (Ptr CInt))
-> (forall r. (Ptr CInt -> IO r) -> IO r) -> Managed (Ptr CInt)
forall a b. (a -> b) -> a -> b
$ CInt -> (Ptr CInt -> IO r) -> IO r
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)

      IO Bool -> Managed Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Managed Bool) -> IO Bool -> Managed Bool
forall a b. (a -> b) -> a -> b
$ [CString] -> (Int -> Ptr CString -> IO Bool) -> IO Bool
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [CString]
cStrings \Int
len Ptr CString
itemsPtr -> do
        Bool
changed <- CString -> Ptr CInt -> Ptr CString -> CInt -> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString -> Ptr CInt -> Ptr CString -> CInt -> m Bool
Raw.combo CString
labelPtr Ptr CInt
iPtr Ptr CString
itemsPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
          CInt
i' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
iPtr
          ref
selectedIndex ref -> Int -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
i'

        Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
changed


-- | Wraps @ImGui::DragFloat()@
dragFloat :: (MonadIO m, HasSetter ref Float, HasGetter ref Float) => String -> ref -> Float -> Float -> Float -> m Bool
dragFloat :: String -> ref -> Float -> Float -> Float -> m Bool
dragFloat String
desc ref
ref Float
speed Float
minValue Float
maxValue = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  Float
currentValue <- ref -> IO Float
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref
  CFloat -> (Ptr CFloat -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
currentValue) \Ptr CFloat
floatPtr -> do
    Bool
changed <- String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
desc \CString
descPtr ->
      CString -> Ptr CFloat -> CFloat -> CFloat -> CFloat -> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString -> Ptr CFloat -> CFloat -> CFloat -> CFloat -> m Bool
Raw.dragFloat CString
descPtr Ptr CFloat
floatPtr (Float -> CFloat
CFloat Float
speed) (Float -> CFloat
CFloat Float
minValue) (Float -> CFloat
CFloat Float
maxValue)

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
      CFloat
newValue <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
floatPtr
      ref
ref ref -> Float -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
newValue

    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
changed


-- | Wraps @ImGui::DragFloat2()@
dragFloat2 :: (MonadIO m, HasSetter ref (Float, Float), HasGetter ref (Float, Float)) => String -> ref -> Float -> Float -> Float -> m Bool
dragFloat2 :: String -> ref -> Float -> Float -> Float -> m Bool
dragFloat2 String
desc ref
ref Float
speed Float
minValue Float
maxValue = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  (Float
x, Float
y) <- ref -> IO (Float, Float)
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref
  [CFloat] -> (Ptr CFloat -> IO Bool) -> IO Bool
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [ Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x, Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y ] \Ptr CFloat
floatPtr -> do
    Bool
changed <- String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
desc \CString
descPtr ->
      CString -> Ptr CFloat -> CFloat -> CFloat -> CFloat -> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString -> Ptr CFloat -> CFloat -> CFloat -> CFloat -> m Bool
Raw.dragFloat2 CString
descPtr Ptr CFloat
floatPtr (Float -> CFloat
CFloat Float
speed) (Float -> CFloat
CFloat Float
minValue) (Float -> CFloat
CFloat Float
maxValue)

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
      [CFloat
x', CFloat
y'] <- Int -> Ptr CFloat -> IO [CFloat]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
2 Ptr CFloat
floatPtr
      ref
ref ref -> (Float, Float) -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! (CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
x', CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
y')

    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
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 :: String -> ref -> Float -> Float -> Float -> m Bool
dragFloat3 String
desc ref
ref Float
speed Float
minValue Float
maxValue = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  (Float
x, Float
y, Float
z) <- ref -> IO (Float, Float, Float)
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref
  [CFloat] -> (Ptr CFloat -> IO Bool) -> IO Bool
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [ Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x, Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y, Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
z ] \Ptr CFloat
floatPtr -> do
    Bool
changed <- String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
desc \CString
descPtr ->
      CString -> Ptr CFloat -> CFloat -> CFloat -> CFloat -> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString -> Ptr CFloat -> CFloat -> CFloat -> CFloat -> m Bool
Raw.dragFloat3 CString
descPtr Ptr CFloat
floatPtr (Float -> CFloat
CFloat Float
speed) (Float -> CFloat
CFloat Float
minValue) (Float -> CFloat
CFloat Float
maxValue)

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
      [CFloat
x', CFloat
y', CFloat
z'] <- Int -> Ptr CFloat -> IO [CFloat]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
3 Ptr CFloat
floatPtr
      ref
ref ref -> (Float, Float, Float) -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! (CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
x', CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
y', CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
z')

    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
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 :: String -> ref -> Float -> Float -> Float -> m Bool
dragFloat4 String
desc ref
ref Float
speed Float
minValue Float
maxValue = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  (Float
x, Float
y, Float
z, Float
u) <- ref -> IO (Float, Float, Float, Float)
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref
  [CFloat] -> (Ptr CFloat -> IO Bool) -> IO Bool
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [ Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x, Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y, Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
z, Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
u ] \Ptr CFloat
floatPtr -> do
    Bool
changed <- String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
desc \CString
descPtr ->
      CString -> Ptr CFloat -> CFloat -> CFloat -> CFloat -> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString -> Ptr CFloat -> CFloat -> CFloat -> CFloat -> m Bool
Raw.dragFloat4 CString
descPtr Ptr CFloat
floatPtr (Float -> CFloat
CFloat Float
speed) (Float -> CFloat
CFloat Float
minValue) (Float -> CFloat
CFloat Float
maxValue)

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
      [CFloat
x', CFloat
y', CFloat
z', CFloat
u'] <- Int -> Ptr CFloat -> IO [CFloat]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
4 Ptr CFloat
floatPtr
      ref
ref ref -> (Float, Float, Float, Float) -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! (CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
x', CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
y', CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
z', CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
u')

    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
changed

dragFloatRange2 :: (MonadIO m, HasSetter ref Float, HasGetter ref Float) => String -> ref -> ref -> Float -> Float -> Float -> String -> String -> m Bool
dragFloatRange2 :: String
-> ref
-> ref
-> Float
-> Float
-> Float
-> String
-> String
-> m Bool
dragFloatRange2 String
desc ref
refMin ref
refMax Float
speed Float
minValue Float
maxValue String
minFmt String
maxFmt = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  Float
curMin <- ref -> IO Float
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
refMin
  Float
curMax <- ref -> IO Float
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
refMax
  CFloat -> (Ptr CFloat -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Float -> CFloat
CFloat Float
curMin) \Ptr CFloat
minPtr ->
    CFloat -> (Ptr CFloat -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Float -> CFloat
CFloat Float
curMax) \Ptr CFloat
maxPtr -> do
      Bool
changed <-
        String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
desc \CString
descPtr ->
          String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
minFmt \CString
minFmtPtr ->
            String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
maxFmt \CString
maxFmtPtr ->
              CString
-> Ptr CFloat
-> Ptr CFloat
-> CFloat
-> CFloat
-> CFloat
-> CString
-> CString
-> ImGuiSliderFlags
-> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString
-> Ptr CFloat
-> Ptr CFloat
-> CFloat
-> CFloat
-> CFloat
-> CString
-> CString
-> ImGuiSliderFlags
-> m Bool
Raw.dragFloatRange2
                CString
descPtr
                Ptr CFloat
minPtr Ptr CFloat
maxPtr
                (Float -> CFloat
CFloat Float
speed) (Float -> CFloat
CFloat Float
minValue) (Float -> CFloat
CFloat Float
maxValue)
                CString
minFmtPtr CString
maxFmtPtr
                ImGuiSliderFlags
ImGuiSliderFlags_AlwaysClamp

      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
        CFloat Float
nextMin <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
minPtr
        CFloat Float
nextMax <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
maxPtr
        ref
refMin ref -> Float -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! Float
nextMin
        ref
refMax ref -> Float -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! Float
nextMax

      Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
changed

-- | Wraps @ImGui::DragFloat()@
dragInt :: (MonadIO m, HasSetter ref Int, HasGetter ref Int) => String -> ref -> Float -> Int -> Int -> m Bool
dragInt :: String -> ref -> Float -> Int -> Int -> m Bool
dragInt String
label ref
ref Float
speed Int
minValue Int
maxValue = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  Int
currentValue <- ref -> IO Int
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref
  CInt -> (Ptr CInt -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
currentValue) \Ptr CInt
vPtr -> do
    Bool
changed <-
      String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
label \CString
labelPtr ->
        String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
"%d" \CString
formatPtr ->
          CString
-> Ptr CInt
-> CFloat
-> CInt
-> CInt
-> CString
-> ImGuiSliderFlags
-> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString
-> Ptr CInt
-> CFloat
-> CInt
-> CInt
-> CString
-> ImGuiSliderFlags
-> m Bool
Raw.dragInt
            CString
labelPtr
            Ptr CInt
vPtr
            (Float -> CFloat
CFloat Float
speed)
            (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
minValue)
            (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxValue)
            CString
formatPtr
            ImGuiSliderFlags
ImGuiSliderFlags_AlwaysClamp

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
      CInt
newValue <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
vPtr
      ref
ref ref -> Int -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
newValue

    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
changed

-- | Wraps @ImGui::DragInt2()@
dragInt2 :: (MonadIO m, HasSetter ref (Int, Int), HasGetter ref (Int, Int)) => String -> ref -> Float -> Int -> Int -> m Bool
dragInt2 :: String -> ref -> Float -> Int -> Int -> m Bool
dragInt2 String
label ref
ref Float
speed Int
minValue Int
maxValue = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  (Int
x, Int
y) <- ref -> IO (Int, Int)
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref
  [CInt] -> (Ptr CInt -> IO Bool) -> IO Bool
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [ Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x, Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y ] \Ptr CInt
vPtr -> do
    Bool
changed <-
      String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
label \CString
labelPtr ->
        String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
"%d" \CString
formatPtr ->
          CString
-> Ptr CInt
-> CFloat
-> CInt
-> CInt
-> CString
-> ImGuiSliderFlags
-> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString
-> Ptr CInt
-> CFloat
-> CInt
-> CInt
-> CString
-> ImGuiSliderFlags
-> m Bool
Raw.dragInt2
            CString
labelPtr
            Ptr CInt
vPtr
            (Float -> CFloat
CFloat Float
speed)
            (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
minValue)
            (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxValue)
            CString
formatPtr
            ImGuiSliderFlags
ImGuiSliderFlags_AlwaysClamp

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
      [CInt
x', CInt
y'] <- Int -> Ptr CInt -> IO [CInt]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
2 Ptr CInt
vPtr
      ref
ref ref -> (Int, Int) -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
x', CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
y')

    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
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 :: String -> ref -> Float -> Int -> Int -> m Bool
dragInt3 String
label ref
ref Float
speed Int
minValue Int
maxValue = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  (Int
x, Int
y, Int
z) <- ref -> IO (Int, Int, Int)
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref
  [CInt] -> (Ptr CInt -> IO Bool) -> IO Bool
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [ Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x, Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y, Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
z ] \Ptr CInt
vPtr -> do
    Bool
changed <-
      String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
label \CString
labelPtr ->
        String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
"%d" \CString
formatPtr ->
          CString
-> Ptr CInt
-> CFloat
-> CInt
-> CInt
-> CString
-> ImGuiSliderFlags
-> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString
-> Ptr CInt
-> CFloat
-> CInt
-> CInt
-> CString
-> ImGuiSliderFlags
-> m Bool
Raw.dragInt3
            CString
labelPtr
            Ptr CInt
vPtr
            (Float -> CFloat
CFloat Float
speed)
            (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
minValue)
            (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxValue)
            CString
formatPtr
            ImGuiSliderFlags
ImGuiSliderFlags_AlwaysClamp

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
      [CInt
x', CInt
y', CInt
z'] <- Int -> Ptr CInt -> IO [CInt]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
3 Ptr CInt
vPtr
      ref
ref ref -> (Int, Int, Int) -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
x', CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
y', CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
z')

    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
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 :: String -> ref -> Float -> Int -> Int -> m Bool
dragInt4 String
label ref
ref Float
speed Int
minValue Int
maxValue = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  (Int
x, Int
y, Int
z, Int
w) <- ref -> IO (Int, Int, Int, Int)
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref
  [CInt] -> (Ptr CInt -> IO Bool) -> IO Bool
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [ Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x, Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y, Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
z, Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w ] \Ptr CInt
vPtr -> do
    Bool
changed <-
      String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
label \CString
labelPtr ->
        String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
"%d" \CString
formatPtr ->
          CString
-> Ptr CInt
-> CFloat
-> CInt
-> CInt
-> CString
-> ImGuiSliderFlags
-> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString
-> Ptr CInt
-> CFloat
-> CInt
-> CInt
-> CString
-> ImGuiSliderFlags
-> m Bool
Raw.dragInt4
            CString
labelPtr
            Ptr CInt
vPtr
            (Float -> CFloat
CFloat Float
speed)
            (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
minValue)
            (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxValue)
            CString
formatPtr
            ImGuiSliderFlags
ImGuiSliderFlags_AlwaysClamp

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
      [CInt
x', CInt
y', CInt
z', CInt
w'] <- Int -> Ptr CInt -> IO [CInt]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
3 Ptr CInt
vPtr
      ref
ref ref -> (Int, Int, Int, Int) -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
x', CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
y', CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
z', CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
w')

    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
changed

dragIntRange2 :: (MonadIO m, HasSetter ref Int, HasGetter ref Int) => String -> ref -> ref -> Float -> Int -> Int -> String -> String -> m Bool
dragIntRange2 :: String
-> ref -> ref -> Float -> Int -> Int -> String -> String -> m Bool
dragIntRange2 String
desc ref
refMin ref
refMax Float
speed Int
minValue Int
maxValue String
minFmt String
maxFmt = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  Int
curMin <- ref -> IO Int
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
refMin
  Int
curMax <- ref -> IO Int
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
refMax
  CInt -> (Ptr CInt -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
curMin) \Ptr CInt
minPtr ->
    CInt -> (Ptr CInt -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
curMax) \Ptr CInt
maxPtr -> do
      Bool
changed <-
        String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
desc \CString
descPtr ->
          String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
minFmt \CString
minFmtPtr ->
            String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
maxFmt \CString
maxFmtPtr ->
              CString
-> Ptr CInt
-> Ptr CInt
-> CFloat
-> CInt
-> CInt
-> CString
-> CString
-> ImGuiSliderFlags
-> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString
-> Ptr CInt
-> Ptr CInt
-> CFloat
-> CInt
-> CInt
-> CString
-> CString
-> ImGuiSliderFlags
-> m Bool
Raw.dragIntRange2
                CString
descPtr
                Ptr CInt
minPtr
                Ptr CInt
maxPtr
                (Float -> CFloat
CFloat Float
speed)
                (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
minValue)
                (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxValue)
                CString
minFmtPtr CString
maxFmtPtr
                ImGuiSliderFlags
ImGuiSliderFlags_AlwaysClamp

      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
        CInt
nextMin <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
minPtr
        CInt
nextMax <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
maxPtr
        ref
refMin ref -> Int -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
nextMin
        ref
refMax ref -> Int -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
nextMax

      Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
changed

dragScalar
  :: (HasSetter ref a, HasGetter ref a, Storable a, MonadIO m)
  => String -> ImGuiDataType -> ref -> Float -> ref -> ref -> String -> ImGuiSliderFlags -> m Bool
dragScalar :: String
-> ImGuiDataType
-> ref
-> Float
-> ref
-> ref
-> String
-> ImGuiSliderFlags
-> m Bool
dragScalar String
label ImGuiDataType
dataType ref
ref Float
vSpeed ref
refMin ref
refMax String
format ImGuiSliderFlags
flags = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  a
currentValue <- ref -> IO a
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref
  a
minValue <- ref -> IO a
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
refMin
  a
maxValue <- ref -> IO a
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
refMax

  a -> (Ptr a -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
currentValue \Ptr a
dataPtr ->
    a -> (Ptr a -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
minValue \Ptr a
minPtr ->
      a -> (Ptr a -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
maxValue \Ptr a
maxPtr -> do
        Bool
changed <-
          String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
label \CString
labelPtr ->
            String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
format \CString
formatPtr ->
              CString
-> ImGuiDataType
-> Ptr a
-> CFloat
-> Ptr a
-> Ptr a
-> CString
-> ImGuiSliderFlags
-> IO Bool
forall (m :: * -> *) a.
MonadIO m =>
CString
-> ImGuiDataType
-> Ptr a
-> CFloat
-> Ptr a
-> Ptr a
-> CString
-> ImGuiSliderFlags
-> m Bool
Raw.dragScalar
                CString
labelPtr
                ImGuiDataType
dataType
                Ptr a
dataPtr
                (Float -> CFloat
CFloat Float
vSpeed)
                Ptr a
minPtr
                Ptr a
maxPtr
                CString
formatPtr
                ImGuiSliderFlags
flags

        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
          a
newValue <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
dataPtr
          ref
ref ref -> a -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! a
newValue

        Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
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 :: String
-> ImGuiDataType
-> valueRef
-> Float
-> rangeRef
-> rangeRef
-> String
-> ImGuiSliderFlags
-> m Bool
dragScalarN String
label ImGuiDataType
dataType valueRef
ref Float
vSpeed rangeRef
refMin rangeRef
refMax String
format ImGuiSliderFlags
flags = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [a]
currentValues <- valueRef -> IO [a]
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get valueRef
ref
  a
minValue <- rangeRef -> IO a
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get rangeRef
refMin
  a
maxValue <- rangeRef -> IO a
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get rangeRef
refMax

  [a] -> (Int -> Ptr a -> IO Bool) -> IO Bool
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [a]
currentValues \Int
components Ptr a
dataPtr ->
    a -> (Ptr a -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
minValue \Ptr a
minPtr ->
      a -> (Ptr a -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
maxValue \Ptr a
maxPtr -> do
        Bool
changed <-
          String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
label \CString
labelPtr ->
            String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
format \CString
formatPtr ->
              CString
-> ImGuiDataType
-> Ptr a
-> CInt
-> CFloat
-> Ptr a
-> Ptr a
-> CString
-> ImGuiSliderFlags
-> IO Bool
forall (m :: * -> *) a.
MonadIO m =>
CString
-> ImGuiDataType
-> Ptr a
-> CInt
-> CFloat
-> Ptr a
-> Ptr a
-> CString
-> ImGuiSliderFlags
-> m Bool
Raw.dragScalarN
                CString
labelPtr
                ImGuiDataType
dataType
                Ptr a
dataPtr
                (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
components)
                (Float -> CFloat
CFloat Float
vSpeed)
                Ptr a
minPtr
                Ptr a
maxPtr
                CString
formatPtr
                ImGuiSliderFlags
flags

        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
          [a]
newValue <- Int -> Ptr a -> IO [a]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
components Ptr a
dataPtr
          valueRef
ref valueRef -> [a] -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! [a]
newValue

        Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
changed

sliderScalar
  :: (HasSetter ref a, HasGetter ref a, Storable a, MonadIO m)
  => String -> ImGuiDataType -> ref -> ref -> ref -> String -> ImGuiSliderFlags -> m Bool
sliderScalar :: String
-> ImGuiDataType
-> ref
-> ref
-> ref
-> String
-> ImGuiSliderFlags
-> m Bool
sliderScalar String
label ImGuiDataType
dataType ref
ref ref
refMin ref
refMax String
format ImGuiSliderFlags
flags = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  a
currentValue <- ref -> IO a
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref
  a
minValue <- ref -> IO a
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
refMin
  a
maxValue <- ref -> IO a
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
refMax

  a -> (Ptr a -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
currentValue \Ptr a
dataPtr ->
    a -> (Ptr a -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
minValue \Ptr a
minPtr ->
      a -> (Ptr a -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
maxValue \Ptr a
maxPtr -> do
        Bool
changed <-
          String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
label \CString
labelPtr ->
            String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
format \CString
formatPtr ->
              CString
-> ImGuiDataType
-> Ptr a
-> Ptr a
-> Ptr a
-> CString
-> ImGuiSliderFlags
-> IO Bool
forall (m :: * -> *) a.
MonadIO m =>
CString
-> ImGuiDataType
-> Ptr a
-> Ptr a
-> Ptr a
-> CString
-> ImGuiSliderFlags
-> m Bool
Raw.sliderScalar
                CString
labelPtr
                ImGuiDataType
dataType
                Ptr a
dataPtr
                Ptr a
minPtr
                Ptr a
maxPtr
                CString
formatPtr
                ImGuiSliderFlags
flags

        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
          a
newValue <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
dataPtr
          ref
ref ref -> a -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! a
newValue

        Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
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 :: String
-> ImGuiDataType
-> valueRef
-> rangeRef
-> rangeRef
-> String
-> ImGuiSliderFlags
-> m Bool
sliderScalarN String
label ImGuiDataType
dataType valueRef
ref rangeRef
refMin rangeRef
refMax String
format ImGuiSliderFlags
flags = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [a]
currentValues <- valueRef -> IO [a]
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get valueRef
ref
  a
minValue <- rangeRef -> IO a
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get rangeRef
refMin
  a
maxValue <- rangeRef -> IO a
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get rangeRef
refMax

  [a] -> (Int -> Ptr a -> IO Bool) -> IO Bool
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [a]
currentValues \Int
components Ptr a
dataPtr ->
    a -> (Ptr a -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
minValue \Ptr a
minPtr ->
      a -> (Ptr a -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
maxValue \Ptr a
maxPtr -> do
        Bool
changed <-
          String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
label \CString
labelPtr ->
            String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
format \CString
formatPtr ->
              CString
-> ImGuiDataType
-> Ptr a
-> CInt
-> Ptr a
-> Ptr a
-> CString
-> ImGuiSliderFlags
-> IO Bool
forall (m :: * -> *) a.
MonadIO m =>
CString
-> ImGuiDataType
-> Ptr a
-> CInt
-> Ptr a
-> Ptr a
-> CString
-> ImGuiSliderFlags
-> m Bool
Raw.sliderScalarN
                CString
labelPtr
                ImGuiDataType
dataType
                Ptr a
dataPtr
                (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
components)
                Ptr a
minPtr
                Ptr a
maxPtr
                CString
formatPtr
                ImGuiSliderFlags
flags

        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
          [a]
newValue <- Int -> Ptr a -> IO [a]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
components Ptr a
dataPtr
          valueRef
ref valueRef -> [a] -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! [a]
newValue

        Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
changed

-- | Wraps @ImGui::SliderFloat()@
sliderFloat :: (MonadIO m, HasSetter ref Float, HasGetter ref Float) => String -> ref -> Float -> Float -> m Bool
sliderFloat :: String -> ref -> Float -> Float -> m Bool
sliderFloat String
desc ref
ref Float
minValue Float
maxValue = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  Float
currentValue <- ref -> IO Float
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref
  CFloat -> (Ptr CFloat -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
currentValue) \Ptr CFloat
floatPtr -> do
    Bool
changed <- String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
desc \CString
descPtr ->
      CString -> Ptr CFloat -> CFloat -> CFloat -> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString -> Ptr CFloat -> CFloat -> CFloat -> m Bool
Raw.sliderFloat CString
descPtr Ptr CFloat
floatPtr (Float -> CFloat
CFloat Float
minValue) (Float -> CFloat
CFloat Float
maxValue)

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
      CFloat
newValue <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
floatPtr
      ref
ref ref -> Float -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
newValue

    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
changed

-- | Wraps @ImGui::SliderFloat2()@
sliderFloat2 :: (MonadIO m, HasSetter ref (Float, Float), HasGetter ref (Float, Float)) => String -> ref -> Float -> Float -> m Bool
sliderFloat2 :: String -> ref -> Float -> Float -> m Bool
sliderFloat2 String
desc ref
ref Float
minValue Float
maxValue = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  (Float
x, Float
y) <- ref -> IO (Float, Float)
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref
  [CFloat] -> (Ptr CFloat -> IO Bool) -> IO Bool
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [ Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x, Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y ] \Ptr CFloat
floatPtr -> do
    Bool
changed <- String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
desc \CString
descPtr ->
      CString -> Ptr CFloat -> CFloat -> CFloat -> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString -> Ptr CFloat -> CFloat -> CFloat -> m Bool
Raw.sliderFloat CString
descPtr Ptr CFloat
floatPtr (Float -> CFloat
CFloat Float
minValue) (Float -> CFloat
CFloat Float
maxValue)

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
      [CFloat
x', CFloat
y'] <- Int -> Ptr CFloat -> IO [CFloat]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
2 Ptr CFloat
floatPtr
      ref
ref ref -> (Float, Float) -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! (CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
x', CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
y')

    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
changed

-- | Wraps @ImGui::SliderFloat3()@
sliderFloat3 :: (MonadIO m, HasSetter ref (Float, Float, Float), HasGetter ref (Float, Float, Float)) => String -> ref -> Float -> Float -> m Bool
sliderFloat3 :: String -> ref -> Float -> Float -> m Bool
sliderFloat3 String
desc ref
ref Float
minValue Float
maxValue = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  (Float
x, Float
y, Float
z) <- ref -> IO (Float, Float, Float)
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref
  [CFloat] -> (Ptr CFloat -> IO Bool) -> IO Bool
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [ Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x, Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y, Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
z ] \Ptr CFloat
floatPtr -> do
    Bool
changed <- String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
desc \CString
descPtr ->
      CString -> Ptr CFloat -> CFloat -> CFloat -> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString -> Ptr CFloat -> CFloat -> CFloat -> m Bool
Raw.sliderFloat CString
descPtr Ptr CFloat
floatPtr (Float -> CFloat
CFloat Float
minValue) (Float -> CFloat
CFloat Float
maxValue)

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
      [CFloat
x', CFloat
y', CFloat
z'] <- Int -> Ptr CFloat -> IO [CFloat]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
3 Ptr CFloat
floatPtr
      ref
ref ref -> (Float, Float, Float) -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! (CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
x', CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
y', CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
z')

    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
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 :: String -> ref -> Float -> Float -> m Bool
sliderFloat4 String
desc ref
ref Float
minValue Float
maxValue = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  (Float
x, Float
y, Float
z, Float
u) <- ref -> IO (Float, Float, Float, Float)
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref
  [CFloat] -> (Ptr CFloat -> IO Bool) -> IO Bool
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [ Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x, Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
y, Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
z, Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
u ] \Ptr CFloat
floatPtr -> do
    Bool
changed <- String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
desc \CString
descPtr ->
      CString -> Ptr CFloat -> CFloat -> CFloat -> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString -> Ptr CFloat -> CFloat -> CFloat -> m Bool
Raw.sliderFloat CString
descPtr Ptr CFloat
floatPtr (Float -> CFloat
CFloat Float
minValue) (Float -> CFloat
CFloat Float
maxValue)

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
      [CFloat
x', CFloat
y', CFloat
z', CFloat
u'] <- Int -> Ptr CFloat -> IO [CFloat]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
4 Ptr CFloat
floatPtr
      ref
ref ref -> (Float, Float, Float, Float) -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! (CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
x', CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
y', CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
z', CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
u')

    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
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 :: String -> ref -> Float -> Float -> m Bool
sliderAngle String
desc ref
refRads Float
minDegs Float
maxDegs = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  Float
currentRads <- ref -> IO Float
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
refRads
  CFloat -> (Ptr CFloat -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Float -> CFloat
CFloat Float
currentRads) \Ptr CFloat
currentRadsPtr -> do
    Bool
changed <-
      String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
desc \CString
descPtr ->
        String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
"%.0f deg" \CString
formatPtr ->
          CString
-> Ptr CFloat
-> CFloat
-> CFloat
-> CString
-> ImGuiSliderFlags
-> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString
-> Ptr CFloat
-> CFloat
-> CFloat
-> CString
-> ImGuiSliderFlags
-> m Bool
Raw.sliderAngle CString
descPtr Ptr CFloat
currentRadsPtr (Float -> CFloat
CFloat Float
minDegs) (Float -> CFloat
CFloat Float
maxDegs) CString
formatPtr ImGuiSliderFlags
ImGuiSliderFlags_AlwaysClamp

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
      CFloat Float
newRads <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
currentRadsPtr
      ref
refRads ref -> Float -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! Float
newRads

    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
changed

-- | Wraps @ImGui::SliderInt()@
sliderInt
  :: (MonadIO m, HasSetter ref Int, HasGetter ref Int)
  => String -> ref -> Int -> Int -> m Bool
sliderInt :: String -> ref -> Int -> Int -> m Bool
sliderInt String
label ref
ref Int
minValue Int
maxValue = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  Int
currentValue <- ref -> IO Int
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref
  CInt -> (Ptr CInt -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
currentValue) \Ptr CInt
vPtr -> do
    Bool
changed <-
      String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
label \CString
labelPtr ->
        String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
"%d" \CString
formatPtr ->
          CString
-> Ptr CInt
-> CInt
-> CInt
-> CString
-> ImGuiSliderFlags
-> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString
-> Ptr CInt
-> CInt
-> CInt
-> CString
-> ImGuiSliderFlags
-> m Bool
Raw.sliderInt
            CString
labelPtr
            Ptr CInt
vPtr
            (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
minValue)
            (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxValue)
            CString
formatPtr
            ImGuiSliderFlags
ImGuiSliderFlags_AlwaysClamp

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
      CInt
newValue <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
vPtr
      ref
ref ref -> Int -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
newValue

    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
changed

-- | Wraps @ImGui::SliderInt2()@
sliderInt2
  :: (MonadIO m, HasSetter ref (Int, Int), HasGetter ref (Int, Int))
  => String -> ref -> Int -> Int -> m Bool
sliderInt2 :: String -> ref -> Int -> Int -> m Bool
sliderInt2 String
label ref
ref Int
minValue Int
maxValue = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  (Int
x, Int
y) <- ref -> IO (Int, Int)
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref
  [CInt] -> (Ptr CInt -> IO Bool) -> IO Bool
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [ Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x, Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y ] \Ptr CInt
vPtr -> do
    Bool
changed <-
      String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
label \CString
labelPtr ->
        String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
"%d" \CString
formatPtr ->
          CString
-> Ptr CInt
-> CInt
-> CInt
-> CString
-> ImGuiSliderFlags
-> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString
-> Ptr CInt
-> CInt
-> CInt
-> CString
-> ImGuiSliderFlags
-> m Bool
Raw.sliderInt2
            CString
labelPtr
            Ptr CInt
vPtr
            (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
minValue)
            (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxValue)
            CString
formatPtr
            ImGuiSliderFlags
ImGuiSliderFlags_AlwaysClamp

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
      [CInt
x', CInt
y'] <- Int -> Ptr CInt -> IO [CInt]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
2 Ptr CInt
vPtr
      ref
ref ref -> (Int, Int) -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
x', CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
y')

    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
changed

-- | Wraps @ImGui::SliderInt3()@
sliderInt3
  :: (MonadIO m, HasSetter ref (Int, Int, Int), HasGetter ref (Int, Int, Int))
  => String -> ref -> Int -> Int -> m Bool
sliderInt3 :: String -> ref -> Int -> Int -> m Bool
sliderInt3 String
label ref
ref Int
minValue Int
maxValue = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  (Int
x, Int
y, Int
z) <- ref -> IO (Int, Int, Int)
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref
  [CInt] -> (Ptr CInt -> IO Bool) -> IO Bool
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [ Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x, Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y, Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
z ] \Ptr CInt
vPtr -> do
    Bool
changed <-
      String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
label \CString
labelPtr ->
        String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
"%d" \CString
formatPtr ->
          CString
-> Ptr CInt
-> CInt
-> CInt
-> CString
-> ImGuiSliderFlags
-> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString
-> Ptr CInt
-> CInt
-> CInt
-> CString
-> ImGuiSliderFlags
-> m Bool
Raw.sliderInt3
            CString
labelPtr
            Ptr CInt
vPtr
            (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
minValue)
            (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxValue)
            CString
formatPtr
            ImGuiSliderFlags
ImGuiSliderFlags_AlwaysClamp

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
      [CInt
x', CInt
y', CInt
z'] <- Int -> Ptr CInt -> IO [CInt]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
3 Ptr CInt
vPtr
      ref
ref ref -> (Int, Int, Int) -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
x', CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
y', CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
z')

    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
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 :: String -> ref -> Int -> Int -> m Bool
sliderInt4 String
label ref
ref Int
minValue Int
maxValue = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  (Int
x, Int
y, Int
z, Int
w) <- ref -> IO (Int, Int, Int, Int)
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref
  [CInt] -> (Ptr CInt -> IO Bool) -> IO Bool
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [ Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x, Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y, Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
z, Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w] \Ptr CInt
vPtr -> do
    Bool
changed <-
      String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
label \CString
labelPtr ->
        String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
"%d" \CString
formatPtr ->
          CString
-> Ptr CInt
-> CInt
-> CInt
-> CString
-> ImGuiSliderFlags
-> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString
-> Ptr CInt
-> CInt
-> CInt
-> CString
-> ImGuiSliderFlags
-> m Bool
Raw.sliderInt4
            CString
labelPtr
            Ptr CInt
vPtr
            (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
minValue)
            (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxValue)
            CString
formatPtr
            ImGuiSliderFlags
ImGuiSliderFlags_AlwaysClamp

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
      [CInt
x', CInt
y', CInt
z', CInt
w'] <- Int -> Ptr CInt -> IO [CInt]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
4 Ptr CInt
vPtr
      ref
ref ref -> (Int, Int, Int, Int) -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
x', CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
y', CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
z', CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
w')

    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
changed

vSliderFloat
  :: (HasSetter ref Float, HasGetter ref Float, MonadIO m)
  => String -> ImVec2 -> ref -> Float -> Float -> m Bool
vSliderFloat :: String -> ImVec2 -> ref -> Float -> Float -> m Bool
vSliderFloat String
label ImVec2
size ref
ref Float
minValue Float
maxValue = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  Float
currentValue <- ref -> IO Float
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref

  ImVec2 -> (Ptr ImVec2 -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with ImVec2
size \Ptr ImVec2
sizePtr ->
    CFloat -> (Ptr CFloat -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Float -> CFloat
CFloat Float
currentValue) \Ptr CFloat
dataPtr -> do
      Bool
changed <-
        String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
label \CString
labelPtr ->
          String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
"%.3f" \CString
formatPtr ->
            CString
-> Ptr ImVec2
-> Ptr CFloat
-> CFloat
-> CFloat
-> CString
-> ImGuiSliderFlags
-> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString
-> Ptr ImVec2
-> Ptr CFloat
-> CFloat
-> CFloat
-> CString
-> ImGuiSliderFlags
-> m Bool
Raw.vSliderFloat
              CString
labelPtr
              Ptr ImVec2
sizePtr
              Ptr CFloat
dataPtr
              (Float -> CFloat
CFloat Float
minValue)
              (Float -> CFloat
CFloat Float
maxValue)
              CString
formatPtr
              ImGuiSliderFlags
ImGuiSliderFlags_AlwaysClamp

      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
        CFloat Float
newValue <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
dataPtr
        ref
ref ref -> Float -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! Float
newValue

      Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
changed

vSliderInt
  :: (HasSetter ref Int, HasGetter ref Int, MonadIO m)
  => String -> ImVec2 -> ref -> Int -> Int -> m Bool
vSliderInt :: String -> ImVec2 -> ref -> Int -> Int -> m Bool
vSliderInt String
label ImVec2
size ref
ref Int
minValue Int
maxValue = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  Int
currentValue <- ref -> IO Int
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref

  ImVec2 -> (Ptr ImVec2 -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with ImVec2
size \Ptr ImVec2
sizePtr ->
    CInt -> (Ptr CInt -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
currentValue) \Ptr CInt
dataPtr -> do
      Bool
changed <-
        String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
label \CString
labelPtr ->
          String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
"%d" \CString
formatPtr ->
            CString
-> Ptr ImVec2
-> Ptr CInt
-> CInt
-> CInt
-> CString
-> ImGuiSliderFlags
-> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString
-> Ptr ImVec2
-> Ptr CInt
-> CInt
-> CInt
-> CString
-> ImGuiSliderFlags
-> m Bool
Raw.vSliderInt
              CString
labelPtr
              Ptr ImVec2
sizePtr
              Ptr CInt
dataPtr
              (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
minValue)
              (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxValue)
              CString
formatPtr
              ImGuiSliderFlags
ImGuiSliderFlags_AlwaysClamp

      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
        CInt
newValue <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
dataPtr
        ref
ref ref -> Int -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
newValue

      Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
changed

vSliderScalar
  :: (HasSetter ref a, HasGetter ref a, Storable a, MonadIO m)
  => String -> ImVec2 -> ImGuiDataType -> ref -> ref -> ref -> String -> ImGuiSliderFlags -> m Bool
vSliderScalar :: String
-> ImVec2
-> ImGuiDataType
-> ref
-> ref
-> ref
-> String
-> ImGuiSliderFlags
-> m Bool
vSliderScalar String
label ImVec2
size ImGuiDataType
dataType ref
ref ref
refMin ref
refMax String
format ImGuiSliderFlags
flags = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  a
currentValue <- ref -> IO a
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref
  a
minValue <- ref -> IO a
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
refMin
  a
maxValue <- ref -> IO a
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
refMax

  ImVec2 -> (Ptr ImVec2 -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with ImVec2
size \Ptr ImVec2
sizePtr ->
    a -> (Ptr a -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
currentValue \Ptr a
dataPtr ->
      a -> (Ptr a -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
minValue \Ptr a
minPtr ->
        a -> (Ptr a -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
maxValue \Ptr a
maxPtr -> do
          Bool
changed <-
            String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
label \CString
labelPtr ->
              String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
format \CString
formatPtr ->
                CString
-> Ptr ImVec2
-> ImGuiDataType
-> Ptr a
-> Ptr a
-> Ptr a
-> CString
-> ImGuiSliderFlags
-> IO Bool
forall (m :: * -> *) a.
MonadIO m =>
CString
-> Ptr ImVec2
-> ImGuiDataType
-> Ptr a
-> Ptr a
-> Ptr a
-> CString
-> ImGuiSliderFlags
-> m Bool
Raw.vSliderScalar
                  CString
labelPtr
                  Ptr ImVec2
sizePtr
                  ImGuiDataType
dataType
                  Ptr a
dataPtr
                  Ptr a
minPtr
                  Ptr a
maxPtr
                  CString
formatPtr
                  ImGuiSliderFlags
flags

          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
            a
newValue <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
dataPtr
            ref
ref ref -> a -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! a
newValue

          Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
changed


-- | Wraps @ImGui::InputText()@.
inputText :: (MonadIO m, HasSetter ref String, HasGetter ref String) => String -> ref -> Int -> m Bool
inputText :: String -> ref -> Int -> m Bool
inputText String
desc ref
ref Int
refSize = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  String
input <- ref -> IO String
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref
  String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
input \ CString
refPtr -> do
    String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
desc \ CString
descPtr -> do
      let refSize' :: CInt
          refSize' :: CInt
refSize' = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
refSize
      Bool
changed <- CString -> CString -> CInt -> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString -> CString -> CInt -> m Bool
Raw.inputText CString
descPtr CString
refPtr CInt
refSize'

      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
        CString -> IO String
peekCString CString
refPtr IO String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ref -> String -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
($=!) ref
ref

      Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
changed


-- | Wraps @ImGui::ColorPicker3()@.
colorPicker3 :: (MonadIO m, HasSetter ref ImVec3, HasGetter ref ImVec3) => String -> ref -> m Bool
colorPicker3 :: String -> ref -> m Bool
colorPicker3 String
desc ref
ref = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  ImVec3{Float
$sel:x:ImVec3 :: ImVec3 -> Float
x :: Float
x, Float
$sel:y:ImVec3 :: ImVec3 -> Float
y :: Float
y, Float
$sel:z:ImVec3 :: ImVec3 -> Float
z :: Float
z} <- ref -> IO ImVec3
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref
  [CFloat] -> (Ptr CFloat -> IO Bool) -> IO Bool
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Float -> CFloat) -> [Float] -> [CFloat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Float
x, Float
y, Float
z]) \Ptr CFloat
refPtr -> do
    Bool
changed <- String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
desc \CString
descPtr ->
      CString -> Ptr CFloat -> IO Bool
forall (m :: * -> *). MonadIO m => CString -> Ptr CFloat -> m Bool
Raw.colorPicker3 CString
descPtr Ptr CFloat
refPtr

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
      [CFloat
x', CFloat
y', CFloat
z'] <- Int -> Ptr CFloat -> IO [CFloat]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
3 Ptr CFloat
refPtr
      ref
ref ref -> ImVec3 -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! Float -> Float -> Float -> ImVec3
ImVec3 (CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
x') (CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
y') (CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
z')

    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
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 :: String -> ref -> m Bool
colorButton String
desc ref
ref = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  ImVec4
currentValue <- ref -> IO ImVec4
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref
  ImVec4 -> (Ptr ImVec4 -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with ImVec4
currentValue \Ptr ImVec4
refPtr -> do
    Bool
changed <- String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
desc \CString
descPtr ->
      CString -> Ptr ImVec4 -> IO Bool
forall (m :: * -> *). MonadIO m => CString -> Ptr ImVec4 -> m Bool
Raw.colorButton CString
descPtr Ptr ImVec4
refPtr

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
      ImVec4
newValue <- Ptr ImVec4 -> IO ImVec4
forall a. Storable a => Ptr a -> IO a
peek Ptr ImVec4
refPtr
      ref
ref ref -> ImVec4 -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! ImVec4
newValue

    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
changed


-- | Wraps @ImGui::TreeNode()@.
treeNode :: MonadIO m => String -> m Bool
treeNode :: String -> m Bool
treeNode String
label = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
label CString -> IO Bool
forall (m :: * -> *). MonadIO m => CString -> m Bool
Raw.treeNode


-- | Wraps @ImGui::TreePush()@.
treePush :: MonadIO m => String -> m ()
treePush :: String -> m ()
treePush String
label = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
label CString -> IO ()
forall (m :: * -> *). MonadIO m => CString -> m ()
Raw.treePush


-- | Wraps @ImGui::Selectable()@.
selectable :: MonadIO m => String -> m Bool
selectable :: String -> m Bool
selectable String
label = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
label CString -> IO Bool
forall (m :: * -> *). MonadIO m => CString -> m Bool
Raw.selectable


listBox :: (MonadIO m, HasGetter ref Int, HasSetter ref Int) => String -> ref -> [String] -> m Bool
listBox :: String -> ref -> [String] -> m Bool
listBox String
label ref
selectedIndex [String]
items = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Managed Bool -> (Bool -> IO Bool) -> IO Bool
forall a r. Managed a -> (a -> IO r) -> IO r
Managed.with Managed Bool
m Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return
  where
    m :: Managed Bool
m = do
      Int
i <- ref -> Managed Int
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
selectedIndex

      [CString]
cStrings <- (String -> Managed CString) -> [String] -> Managed [CString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\String
str -> (forall r. (CString -> IO r) -> IO r) -> Managed CString
forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
Managed.managed (String -> (CString -> IO r) -> IO r
forall a. String -> (CString -> IO a) -> IO a
withCString String
str)) [String]
items
      CString
labelPtr <- (forall r. (CString -> IO r) -> IO r) -> Managed CString
forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
Managed.managed ((forall r. (CString -> IO r) -> IO r) -> Managed CString)
-> (forall r. (CString -> IO r) -> IO r) -> Managed CString
forall a b. (a -> b) -> a -> b
$ String -> (CString -> IO r) -> IO r
forall a. String -> (CString -> IO a) -> IO a
withCString String
label
      Ptr CInt
iPtr     <- (forall r. (Ptr CInt -> IO r) -> IO r) -> Managed (Ptr CInt)
forall (m :: * -> *) a.
MonadManaged m =>
(forall r. (a -> IO r) -> IO r) -> m a
Managed.managed ((forall r. (Ptr CInt -> IO r) -> IO r) -> Managed (Ptr CInt))
-> (forall r. (Ptr CInt -> IO r) -> IO r) -> Managed (Ptr CInt)
forall a b. (a -> b) -> a -> b
$ CInt -> (Ptr CInt -> IO r) -> IO r
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)

      IO Bool -> Managed Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Managed Bool) -> IO Bool -> Managed Bool
forall a b. (a -> b) -> a -> b
$ [CString] -> (Int -> Ptr CString -> IO Bool) -> IO Bool
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [CString]
cStrings \Int
len Ptr CString
itemsPtr -> do
        Bool
changed <- CString -> Ptr CInt -> Ptr CString -> CInt -> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString -> Ptr CInt -> Ptr CString -> CInt -> m Bool
Raw.listBox CString
labelPtr Ptr CInt
iPtr Ptr CString
itemsPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed do
          CInt
i' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
iPtr
          ref
selectedIndex ref -> Int -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
i'

        Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
changed


-- | Wraps @ImGui::PlotHistogram()@.
plotHistogram :: MonadIO m => String -> [CFloat] -> m ()
plotHistogram :: String -> [CFloat] -> m ()
plotHistogram String
label [CFloat]
values = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
  [CFloat] -> (Int -> Ptr CFloat -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [CFloat]
values \Int
len Ptr CFloat
valuesPtr ->
    String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
label \CString
labelPtr ->
      CString -> Ptr CFloat -> CInt -> IO ()
forall (m :: * -> *).
MonadIO m =>
CString -> Ptr CFloat -> CInt -> m ()
Raw.plotHistogram CString
labelPtr Ptr CFloat
valuesPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
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 :: (Bool -> m a) -> m a
withMainMenuBar = m Bool -> (Bool -> m ()) -> (Bool -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket m Bool
forall (m :: * -> *). MonadIO m => m Bool
Raw.beginMainMenuBar (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` m ()
forall (m :: * -> *). MonadIO m => m ()
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 :: m () -> m ()
withMainMenuBarOpen m ()
action =
  (Bool -> m ()) -> m ()
forall (m :: * -> *) a. MonadUnliftIO m => (Bool -> m a) -> m a
withMainMenuBar (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` m ()
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 :: (Bool -> m a) -> m a
withMenuBar = m Bool -> (Bool -> m ()) -> (Bool -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket m Bool
forall (m :: * -> *). MonadIO m => m Bool
Raw.beginMenuBar (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` m ()
forall (m :: * -> *). MonadIO m => m ()
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 :: m () -> m ()
withMenuBarOpen m ()
action =
  (Bool -> m ()) -> m ()
forall (m :: * -> *) a. MonadUnliftIO m => (Bool -> m a) -> m a
withMenuBar (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` m ()
action)

-- | Create a sub-menu entry.
--
-- Wraps @ImGui::BeginMenu()@.
beginMenu :: MonadIO m => String -> m Bool
beginMenu :: String -> m Bool
beginMenu String
label = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
label CString -> IO Bool
forall (m :: * -> *). MonadIO m => CString -> m Bool
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 :: String -> (Bool -> m a) -> m a
withMenu String
label = m Bool -> (Bool -> m ()) -> (Bool -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (String -> m Bool
forall (m :: * -> *). MonadIO m => String -> m Bool
beginMenu String
label) (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` m ()
forall (m :: * -> *). MonadIO m => m ()
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 :: String -> m () -> m ()
withMenuOpen String
label m ()
action =
  String -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (Bool -> m a) -> m a
withMenu String
label (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` m ()
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 :: String -> m Bool
menuItem String
label = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
label CString -> IO Bool
forall (m :: * -> *). MonadIO m => CString -> m Bool
Raw.menuItem


-- | Create a @TabBar@ and start appending to it.
--
-- Wraps @ImGui::BeginTabBar@.
beginTabBar :: MonadIO m => String -> ImGuiTabBarFlags -> m Bool
beginTabBar :: String -> ImGuiTabBarFlags -> m Bool
beginTabBar String
tabBarID ImGuiTabBarFlags
flags = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
tabBarID \CString
ptr ->
    CString -> ImGuiTabBarFlags -> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString -> ImGuiTabBarFlags -> m Bool
Raw.beginTabBar CString
ptr ImGuiTabBarFlags
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 :: String -> ImGuiTabBarFlags -> (Bool -> m a) -> m a
withTabBar String
tabBarID ImGuiTabBarFlags
flags =
  m Bool -> (Bool -> m ()) -> (Bool -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (String -> ImGuiTabBarFlags -> m Bool
forall (m :: * -> *).
MonadIO m =>
String -> ImGuiTabBarFlags -> m Bool
beginTabBar String
tabBarID ImGuiTabBarFlags
flags) (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` m ()
forall (m :: * -> *). MonadIO m => m ()
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 :: String -> ImGuiTabBarFlags -> m () -> m ()
withTabBarOpen String
tabBarID ImGuiTabBarFlags
flags m ()
action =
  String -> ImGuiTabBarFlags -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> ImGuiTabBarFlags -> (Bool -> m a) -> m a
withTabBar String
tabBarID ImGuiTabBarFlags
flags (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` m ()
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 :: String -> ref -> ImGuiTabBarFlags -> m Bool
beginTabItem String
tabName ref
ref ImGuiTabBarFlags
flags = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  Bool
currentValue <- ref -> IO Bool
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
ref
  CBool -> (Ptr CBool -> IO Bool) -> IO Bool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (CBool -> CBool -> Bool -> CBool
forall a. a -> a -> Bool -> a
bool CBool
0 CBool
1 Bool
currentValue) \Ptr CBool
refPtr -> do
    Bool
open <- String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
tabName \CString
ptrName ->
      CString -> Ptr CBool -> ImGuiTabBarFlags -> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString -> Ptr CBool -> ImGuiTabBarFlags -> m Bool
Raw.beginTabItem CString
ptrName Ptr CBool
refPtr ImGuiTabBarFlags
flags

    Bool
newValue <- (CBool
0 CBool -> CBool -> Bool
forall a. Eq a => a -> a -> Bool
/=) (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CBool -> IO CBool
forall a. Storable a => Ptr a -> IO a
peek Ptr CBool
refPtr
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
newValue Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
currentValue) do
      ref
ref ref -> Bool -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$=! Bool
newValue

    Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
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 :: String -> ref -> ImGuiTabBarFlags -> (Bool -> m a) -> m a
withTabItem String
tabName ref
ref ImGuiTabBarFlags
flags =
  m Bool -> (Bool -> m ()) -> (Bool -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (String -> ref -> ImGuiTabBarFlags -> m Bool
forall (m :: * -> *) ref.
(MonadIO m, HasGetter ref Bool, HasSetter ref Bool) =>
String -> ref -> ImGuiTabBarFlags -> m Bool
beginTabItem String
tabName ref
ref ImGuiTabBarFlags
flags) (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` m ()
forall (m :: * -> *). MonadIO m => m ()
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 :: String -> ref -> ImGuiTabBarFlags -> m () -> m ()
withTabItemOpen String
tabName ref
ref ImGuiTabBarFlags
flags m ()
action =
  String -> ref -> ImGuiTabBarFlags -> (Bool -> m ()) -> m ()
forall (m :: * -> *) ref a.
(MonadUnliftIO m, HasGetter ref Bool, HasSetter ref Bool) =>
String -> ref -> ImGuiTabBarFlags -> (Bool -> m a) -> m a
withTabItem String
tabName ref
ref ImGuiTabBarFlags
flags (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` m ()
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 :: String -> ImGuiTabItemFlags -> m Bool
tabItemButton String
tabName ImGuiTabItemFlags
flags = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
tabName \CString
namePtr ->
    CString -> ImGuiTabItemFlags -> IO Bool
forall (m :: * -> *).
MonadIO m =>
CString -> ImGuiTabItemFlags -> m Bool
Raw.tabItemButton CString
namePtr ImGuiTabItemFlags
flags


-- | Notify the tab bar (or the docking system) that a tab/window is about to close.
-- Useful to reduce visual flicker on reorderable tab bars.
--
-- __For tab-bar__: call after 'beginTabBar' and before tab submission. Otherwise, call with a window name.
setTabItemClosed :: MonadIO m => String -> m ()
setTabItemClosed :: String -> m ()
setTabItemClosed String
tabName = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
tabName CString -> IO ()
forall (m :: * -> *). MonadIO m => CString -> m ()
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 :: m a -> m a
withTooltip = m () -> m () -> m a -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> m b -> m c -> m c
bracket_ m ()
forall (m :: * -> *). MonadIO m => m ()
Raw.beginTooltip m ()
forall (m :: * -> *). MonadIO m => m ()
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 :: String -> m Bool
beginPopup String
popupId = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
popupId CString -> IO Bool
forall (m :: * -> *). MonadIO m => CString -> m Bool
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 :: String -> (Bool -> m a) -> m a
withPopup String
popupId = m Bool -> (Bool -> m ()) -> (Bool -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (String -> m Bool
forall (m :: * -> *). MonadIO m => String -> m Bool
beginPopup String
popupId) (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` m ()
forall (m :: * -> *). MonadIO m => m ()
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 :: String -> m () -> m ()
withPopupOpen String
popupId m ()
action =
  String -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (Bool -> m a) -> m a
withPopup String
popupId (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` m ()
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 :: String -> m Bool
beginPopupModal String
popupId = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
popupId CString -> IO Bool
forall (m :: * -> *). MonadIO m => CString -> m Bool
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 :: String -> (Bool -> m a) -> m a
withPopupModal String
popupId = m Bool -> (Bool -> m ()) -> (Bool -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (String -> m Bool
forall (m :: * -> *). MonadIO m => String -> m Bool
beginPopupModal String
popupId) (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` m ()
forall (m :: * -> *). MonadIO m => m ()
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 :: String -> m () -> m ()
withPopupModalOpen String
popupId m ()
action =
  String -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (Bool -> m a) -> m a
withPopupModal String
popupId (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` m ()
action)

-- | Call to mark popup as open (don't call every frame!).
--
-- Wraps @ImGui::OpenPopup()@
openPopup :: MonadIO m => String -> m ()
openPopup :: String -> m ()
openPopup String
popupId = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
popupId CString -> IO ()
forall (m :: * -> *). MonadIO m => CString -> m ()
Raw.openPopup


withCStringOrNull :: Maybe String -> (Ptr CChar -> IO a) -> IO a
withCStringOrNull :: Maybe String -> (CString -> IO a) -> IO a
withCStringOrNull Maybe String
Nothing CString -> IO a
k  = CString -> IO a
k CString
forall a. Ptr a
nullPtr
withCStringOrNull (Just String
s) CString -> IO a
k = String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString String
s CString -> IO a
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 :: ref -> ImGuiCond -> Maybe ref -> m ()
setNextWindowPos ref
posRef ImGuiCond
cond Maybe ref
pivotMaybe = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  ImVec2
pos <- ref -> IO ImVec2
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
posRef
  ImVec2 -> (Ptr ImVec2 -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with ImVec2
pos ((Ptr ImVec2 -> IO ()) -> IO ()) -> (Ptr ImVec2 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ImVec2
posPtr ->
    case Maybe ref
pivotMaybe of
      Just ref
pivotRef -> do
        ImVec2
pivot <- ref -> IO ImVec2
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
pivotRef
        ImVec2 -> (Ptr ImVec2 -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with ImVec2
pivot ((Ptr ImVec2 -> IO ()) -> IO ()) -> (Ptr ImVec2 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ImVec2
pivotPtr ->
          Ptr ImVec2 -> ImGuiCond -> Ptr ImVec2 -> IO ()
forall (m :: * -> *).
MonadIO m =>
Ptr ImVec2 -> ImGuiCond -> Ptr ImVec2 -> m ()
Raw.setNextWindowPos Ptr ImVec2
posPtr ImGuiCond
cond Ptr ImVec2
pivotPtr
      Maybe ref
Nothing ->
        Ptr ImVec2 -> ImGuiCond -> Ptr ImVec2 -> IO ()
forall (m :: * -> *).
MonadIO m =>
Ptr ImVec2 -> ImGuiCond -> Ptr ImVec2 -> m ()
Raw.setNextWindowPos Ptr ImVec2
posPtr ImGuiCond
cond Ptr ImVec2
forall a. Ptr a
nullPtr

-- | Set next window size. Call before `begin`
--
-- Wraps @ImGui::SetNextWindowSize()@
setNextWindowSize :: (MonadIO m, HasGetter ref ImVec2) => ref -> ImGuiCond -> m ()
setNextWindowSize :: ref -> ImGuiCond -> m ()
setNextWindowSize ref
sizeRef ImGuiCond
cond = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  ImVec2
size' <- ref -> IO ImVec2
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
sizeRef
  ImVec2 -> (Ptr ImVec2 -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with ImVec2
size' \Ptr ImVec2
sizePtr ->
    Ptr ImVec2 -> ImGuiCond -> IO ()
forall (m :: * -> *). MonadIO m => Ptr ImVec2 -> ImGuiCond -> m ()
Raw.setNextWindowSize Ptr ImVec2
sizePtr ImGuiCond
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 :: ref -> m ()
setNextWindowContentSize ref
sizeRef = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  ImVec2
size' <- ref -> IO ImVec2
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
sizeRef
  ImVec2 -> (Ptr ImVec2 -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with ImVec2
size' Ptr ImVec2 -> IO ()
forall (m :: * -> *). MonadIO m => Ptr ImVec2 -> m ()
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 :: ref -> ref -> m ()
setNextWindowSizeConstraints ref
sizeMinRef ref
sizeMaxRef = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  ImVec2
sizeMin <- ref -> IO ImVec2
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
sizeMinRef
  ImVec2
sizeMax <- ref -> IO ImVec2
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
sizeMaxRef
  ImVec2 -> (Ptr ImVec2 -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with ImVec2
sizeMin \Ptr ImVec2
sizeMinPtr ->
    ImVec2 -> (Ptr ImVec2 -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with ImVec2
sizeMax \Ptr ImVec2
sizeMaxPtr ->
      Ptr ImVec2 -> Ptr ImVec2 -> IO ()
forall (m :: * -> *). MonadIO m => Ptr ImVec2 -> Ptr ImVec2 -> m ()
Raw.setNextWindowSizeConstraints Ptr ImVec2
sizeMinPtr Ptr ImVec2
sizeMaxPtr


-- | Set next window collapsed state. call before `begin`
--
-- Wraps @ImGui::SetNextWindowCollapsed()@
setNextWindowCollapsed :: (MonadIO m) => Bool -> ImGuiCond -> m ()
setNextWindowCollapsed :: Bool -> ImGuiCond -> m ()
setNextWindowCollapsed Bool
b ImGuiCond
cond = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  CBool -> ImGuiCond -> IO ()
forall (m :: * -> *). MonadIO m => CBool -> ImGuiCond -> m ()
Raw.setNextWindowCollapsed (CBool -> CBool -> Bool -> CBool
forall a. a -> a -> Bool -> a
bool CBool
0 CBool
1 Bool
b) ImGuiCond
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 :: Float -> m ()
setNextWindowBgAlpha Float
alpha = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  CFloat -> IO ()
forall (m :: * -> *). MonadIO m => CFloat -> m ()
Raw.setNextWindowBgAlpha (Float -> CFloat
CFloat Float
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 :: ref -> m ()
dummy ref
sizeRef = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  ImVec2
size' <- ref -> IO ImVec2
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
sizeRef
  ImVec2 -> (Ptr ImVec2 -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with ImVec2
size' Ptr ImVec2 -> IO ()
forall (m :: * -> *). MonadIO m => Ptr ImVec2 -> m ()
Raw.dummy


-- | 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 :: Float -> m ()
indent Float
indent_w = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  CFloat -> IO ()
forall (m :: * -> *). MonadIO m => CFloat -> m ()
Raw.indent (Float -> CFloat
CFloat Float
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 :: Float -> m ()
unindent Float
f = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  CFloat -> IO ()
forall (m :: * -> *). MonadIO m => CFloat -> m ()
Raw.unindent (Float -> CFloat
CFloat Float
f)


-- | Affect large frame+labels widgets only.
--
-- Wraps @ImGui::SetNextItemWidth()@
setNextItemWidth :: (MonadIO m) => Float -> m ()
setNextItemWidth :: Float -> m ()
setNextItemWidth Float
itemWidth = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  CFloat -> IO ()
forall (m :: * -> *). MonadIO m => CFloat -> m ()
Raw.setNextItemWidth (Float -> CFloat
CFloat Float
itemWidth)


-- Wraps @ImGui::PushItemWidth()@
pushItemWidth :: (MonadIO m) => Float -> m ()
pushItemWidth :: Float -> m ()
pushItemWidth Float
itemWidth = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  CFloat -> IO ()
forall (m :: * -> *). MonadIO m => CFloat -> m ()
Raw.pushItemWidth (Float -> CFloat
CFloat Float
itemWidth)


-- | Lock horizontal starting position
--
-- Wraps @ImGui::BeginGroup()@ and @ImGui::EndGroup()@
withGroup :: MonadUnliftIO m => m a -> m a
withGroup :: m a -> m a
withGroup = m () -> m () -> m a -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> m b -> m c -> m c
bracket_ m ()
forall (m :: * -> *). MonadIO m => m ()
Raw.beginGroup m ()
forall (m :: * -> *). MonadIO m => m ()
Raw.endGroup

-- | Set cursor position in window-local coordinates
--
-- Wraps @ImGui::SetCursorPos()@
setCursorPos :: (MonadIO m, HasGetter ref ImVec2) => ref -> m ()
setCursorPos :: ref -> m ()
setCursorPos ref
posRef = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  ImVec2
pos <- ref -> IO ImVec2
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
posRef
  ImVec2 -> (Ptr ImVec2 -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with ImVec2
pos Ptr ImVec2 -> IO ()
forall (m :: * -> *). MonadIO m => Ptr ImVec2 -> m ()
Raw.setCursorPos


-- | 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 :: ImGuiCol -> ref -> m ()
pushStyleColor ImGuiCol
col ref
colorRef = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  ImVec4
color <- ref -> IO ImVec4
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
colorRef
  ImVec4 -> (Ptr ImVec4 -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with ImVec4
color \Ptr ImVec4
colorPtr ->
    ImGuiCol -> Ptr ImVec4 -> IO ()
forall (m :: * -> *). MonadIO m => ImGuiCol -> Ptr ImVec4 -> m ()
Raw.pushStyleColor ImGuiCol
col Ptr ImVec4
colorPtr


-- | 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 :: ImGuiStyleVar -> ref -> m ()
pushStyleVar ImGuiStyleVar
style ref
valRef = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  ImVec2
val <- ref -> IO ImVec2
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
get ref
valRef
  ImVec2 -> (Ptr ImVec2 -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with ImVec2
val \Ptr ImVec2
valPtr ->
    ImGuiStyleVar -> Ptr ImVec2 -> IO ()
forall (m :: * -> *).
MonadIO m =>
ImGuiStyleVar -> Ptr ImVec2 -> m ()
Raw.pushStyleVar ImGuiStyleVar
style Ptr ImVec2
valPtr


-- | Remove style variable modifications from the shared stack
--
-- Wraps @ImGui::PopStyleVar()@
popStyleVar :: (MonadIO m) => Int -> m ()
popStyleVar :: Int -> m ()
popStyleVar Int
n = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  CInt -> IO ()
forall (m :: * -> *). MonadIO m => CInt -> m ()
Raw.popStyleVar (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)