Drezil/dear-imgui.hs
1
0
Fork 0
mirror of https://github.com/Drezil/dear-imgui.hs.git synced 2025-07-20 11:43:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'main' of github.com:haskell-game/dear-imgui.hs into args

Browse Source
This commit is contained in:
Ollie Charles
2021-02-06 15:28:41 +00:00
parent 017ff0e142 f9412effde
commit ab9d2b66fb
21 changed files with 1944 additions and 122 deletions
Download Patch File Download Diff File Expand all files Collapse all files

534
src/DearImGui.hs
View File

@ -1,6 +1,7 @@
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
@ -43,10 +44,35 @@ module DearImGui
, begin
, Begin(..)
, end
, setNextWindowPos
, setNextWindowSize
, setNextWindowContentSize
, setNextWindowSizeConstraints
, setNextWindowCollapsed
, setNextWindowBgAlpha
-- * Child Windows
, beginChild
, endChild
-- * Parameter stacks
, pushStyleColor
, popStyleColor
, pushStyleVar
, popStyleVar
-- * Cursor/Layout
, separator
, sameLine
, newLine
, spacing
, dummy
, indent
, unindent
, beginGroup
, endGroup
, setCursorPos
, alignTextToFramePadding
-- * Widgets
-- ** Text
@ -61,20 +87,38 @@ module DearImGui
, progressBar
, bullet
-- ** Slider
, sliderFloat
-- ** Combo Box
, beginCombo
, endCombo
, combo
-- ** Drag Sliders
, dragFloat
, dragFloat2
, dragFloat3
, dragFloat4
-- ** Slider
, sliderFloat
, sliderFloat2
, sliderFloat3
, sliderFloat4
-- * Color Editor/Picker
, colorPicker3
, colorButton
-- * Trees
, treeNode
, treePush
, treePop
-- ** Selectables
, selectable
-- ** List Boxes
, listBox
-- * Data Plotting
, plotHistogram
@ -87,6 +131,14 @@ module DearImGui
, endMenu
, menuItem
-- ** Tabs, tab bar
, beginTabBar
, endTabBar
, beginTabItem
, endTabItem
, tabItemButton
, setTabItemClosed
-- * Tooltips
, beginTooltip
, endTooltip
@ -102,13 +154,8 @@ module DearImGui
, isItemHovered
-- * Types
, ImGuiDir
, pattern ImGuiDirLeft
, pattern ImGuiDirRight
, pattern ImGuiDirUp
, pattern ImGuiDirDown
, ImVec3(..)
, ImVec4(..)
, module DearImGui.Enums
, module DearImGui.Structs
-- * TODO
, toStateVar
@ -117,11 +164,18 @@ module DearImGui
-- base
import Data.Bool
import Data.Coerce
( coerce )
import Data.Int
( Int32 )
import Foreign
import Foreign.C
-- dear-imgui
import DearImGui.Context
( imguiContext )
import DearImGui.Enums
import DearImGui.Structs
-- inline-c
import qualified Language.C.Inline as C
@ -129,6 +183,9 @@ import qualified Language.C.Inline as C
-- inline-c-cpp
import qualified Language.C.Inline.Cpp as Cpp
-- managed
import qualified Control.Monad.Managed as Managed
-- StateVar
import Data.StateVar
( HasGetter(get), HasSetter, ($=!), mapStateVar, StateVar(..) )
@ -292,6 +349,19 @@ end = liftIO do
[C.exp| void { ImGui::End(); } |]
-- | Wraps @ImGui::BeginChild()@.
beginChild :: MonadIO m => String -> m Bool
beginChild name = liftIO do
withCString name \namePtr ->
(0 /=) <$> [C.exp| bool { ImGui::BeginChild($(char* namePtr)) } |]
-- | Wraps @ImGui::EndChild()@.
endChild :: MonadIO m => m ()
endChild = liftIO do
[C.exp| void { ImGui::EndChild(); } |]
-- | Separator, generally horizontal. inside a menu bar or in horizontal layout
-- mode, this becomes a vertical separator.
--
@ -340,9 +410,9 @@ smallButton label = liftIO do
--
-- Wraps @ImGui::ArrowButton()@.
arrowButton :: MonadIO m => String -> ImGuiDir -> m Bool
arrowButton strId (ImGuiDir dir) = liftIO do
arrowButton strId dir = liftIO do
withCString strId \strIdPtr ->
(0 /=) <$> [C.exp| bool { ArrowButton($(char* strIdPtr), $(int dir)) } |]
(0 /=) <$> [C.exp| bool { ArrowButton($(char* strIdPtr), $(ImGuiDir dir)) } |]
-- | Wraps @ImGui::Checkbox()@.
@ -388,7 +458,7 @@ beginCombo label previewValue = liftIO $
(0 /=) <$> [C.exp| bool { BeginCombo($(char* labelPtr), $(char* previewValuePtr)) } |]
-- | Only call 'endCombo' if 'beginCombon' returns 'True'!
-- | Only call 'endCombo' if 'beginCombo' returns 'True'!
--
-- Wraps @ImGui::EndCombo()@.
endCombo :: MonadIO m => m ()
@ -396,18 +466,102 @@ endCombo = liftIO do
[C.exp| void { EndCombo() } |]
-- | Wraps @ImGui::ColorPicker3()@.
colorPicker3 :: (MonadIO m, HasSetter ref ImVec3, HasGetter ref ImVec3) => String -> ref -> m Bool
colorPicker3 desc ref = liftIO do
ImVec3{x, y, z} <- get ref
withArray (realToFrac <$> [x, y, z]) \refPtr -> do
changed <- withCString desc \descPtr ->
(0 /= ) <$> [C.exp| bool { ColorPicker3( $(char* descPtr), $(float *refPtr) ) } |]
-- | Wraps @ImGui::Combo()@.
combo :: (MonadIO m, HasGetter ref Int, HasSetter ref Int) => String -> ref -> [String] -> m Bool
combo label selectedIndex items = liftIO $ Managed.with m return
where
m = do
i <- get selectedIndex
[x', y', z'] <- peekArray 3 refPtr
ref $=! ImVec3 (realToFrac x') (realToFrac y') (realToFrac z')
cStrings <- traverse (\str -> Managed.managed (withCString str)) items
labelPtr <- Managed.managed $ withCString label
iPtr <- Managed.managed $ with (fromIntegral i)
liftIO $ withArrayLen cStrings \len itemsPtr -> do
let len' = fromIntegral len
[C.exp| bool { Combo($(char* labelPtr), $(int* iPtr), $(char** itemsPtr), $(int len')) }|] >>= \case
0 -> return False
_ -> do
i' <- peek iPtr
selectedIndex $=! fromIntegral i'
return True
-- | Wraps @ImGui::DragFloat()@
dragFloat :: (MonadIO m, HasSetter ref Float, HasGetter ref Float) => String -> ref -> Float -> Float -> Float -> m Bool
dragFloat desc ref speed minValue maxValue = liftIO do
currentValue <- get ref
with (realToFrac currentValue) \floatPtr -> do
changed <- withCString desc \descPtr ->
(0 /=) <$> [C.exp| bool { DragFloat( $(char* descPtr), $(float *floatPtr), $(float speed'), $(float min'), $(float max')) } |]
newValue <- peek floatPtr
ref $=! realToFrac newValue
return changed
where
min', max', speed' :: CFloat
min' = realToFrac minValue
max' = realToFrac maxValue
speed' = realToFrac speed
-- | Wraps @ImGui::DragFloat2()@
dragFloat2 :: (MonadIO m, HasSetter ref (Float, Float), HasGetter ref (Float, Float)) => String -> ref -> Float -> Float -> Float -> m Bool
dragFloat2 desc ref speed minValue maxValue = liftIO do
(x, y) <- get ref
withArray [ realToFrac x, realToFrac y ] \floatPtr -> do
changed <- withCString desc \descPtr ->
(0 /=) <$> [C.exp| bool { DragFloat2( $(char* descPtr), $(float *floatPtr), $(float speed'), $(float min'), $(float max')) } |]
[x', y'] <- peekArray 2 floatPtr
ref $=! (realToFrac x', realToFrac y')
return changed
where
min', max', speed' :: CFloat
min' = realToFrac minValue
max' = realToFrac maxValue
speed' = realToFrac speed
-- | Wraps @ImGui::DragFloat3()@
dragFloat3 :: (MonadIO m, HasSetter ref (Float, Float, Float), HasGetter ref (Float, Float, Float)) => String -> ref -> Float -> Float -> Float -> m Bool
dragFloat3 desc ref speed minValue maxValue = liftIO do
(x, y, z) <- get ref
withArray [ realToFrac x, realToFrac y, realToFrac z ] \floatPtr -> do
changed <- withCString desc \descPtr ->
(0 /=) <$> [C.exp| bool { DragFloat3( $(char* descPtr), $(float *floatPtr), $(float speed'), $(float min'), $(float max')) } |]
[x', y', z'] <- peekArray 3 floatPtr
ref $=! (realToFrac x', realToFrac y', realToFrac z')
return changed
where
min', max', speed' :: CFloat
min' = realToFrac minValue
max' = realToFrac maxValue
speed' = realToFrac speed
-- | Wraps @ImGui::DragFloat4()@
dragFloat4 :: (MonadIO m, HasSetter ref (Float, Float, Float, Float), HasGetter ref (Float, Float, Float, Float)) => String -> ref -> Float -> Float -> Float -> m Bool
dragFloat4 desc ref speed minValue maxValue = liftIO do
(x, y, z, u) <- get ref
withArray [ realToFrac x, realToFrac y, realToFrac z, realToFrac u ] \floatPtr -> do
changed <- withCString desc \descPtr ->
(0 /=) <$> [C.exp| bool { DragFloat4( $(char* descPtr), $(float *floatPtr), $(float speed'), $(float min'), $(float max')) } |]
[x', y', z', u'] <- peekArray 4 floatPtr
ref $=! (realToFrac x', realToFrac y', realToFrac z', realToFrac u')
return changed
where
min', max', speed' :: CFloat
min' = realToFrac minValue
max' = realToFrac maxValue
speed' = realToFrac speed
-- | Wraps @ImGui::SliderFloat()@
sliderFloat :: (MonadIO m, HasSetter ref Float, HasGetter ref Float) => String -> ref -> Float -> Float -> m Bool
@ -426,6 +580,75 @@ sliderFloat desc ref minValue maxValue = liftIO do
min' = realToFrac minValue
max' = realToFrac maxValue
-- | Wraps @ImGui::SliderFloat2()@
sliderFloat2 :: (MonadIO m, HasSetter ref (Float, Float), HasGetter ref (Float, Float)) => String -> ref -> Float -> Float -> m Bool
sliderFloat2 desc ref minValue maxValue = liftIO do
(x, y) <- get ref
withArray [ realToFrac x, realToFrac y ] \floatPtr -> do
changed <- withCString desc \descPtr ->
(0 /=) <$> [C.exp| bool { SliderFloat2( $(char* descPtr), $(float *floatPtr), $(float min'), $(float max')) } |]
[x', y'] <- peekArray 2 floatPtr
ref $=! (realToFrac x', realToFrac y')
return changed
where
min', max' :: CFloat
min' = realToFrac minValue
max' = realToFrac maxValue
-- | Wraps @ImGui::SliderFloat3()@
sliderFloat3 :: (MonadIO m, HasSetter ref (Float, Float, Float), HasGetter ref (Float, Float, Float)) => String -> ref -> Float -> Float -> m Bool
sliderFloat3 desc ref minValue maxValue = liftIO do
(x, y, z) <- get ref
withArray [ realToFrac x, realToFrac y, realToFrac z ] \floatPtr -> do
changed <- withCString desc \descPtr ->
(0 /=) <$> [C.exp| bool { SliderFloat3( $(char* descPtr), $(float *floatPtr), $(float min'), $(float max')) } |]
[x', y', z'] <- peekArray 3 floatPtr
ref $=! (realToFrac x', realToFrac y', realToFrac z')
return changed
where
min', max' :: CFloat
min' = realToFrac minValue
max' = realToFrac maxValue
-- | Wraps @ImGui::SliderFloat4()@
sliderFloat4 :: (MonadIO m, HasSetter ref (Float, Float, Float, Float), HasGetter ref (Float, Float, Float, Float)) => String -> ref -> Float -> Float -> m Bool
sliderFloat4 desc ref minValue maxValue = liftIO do
(x, y, z, u) <- get ref
withArray [ realToFrac x, realToFrac y, realToFrac z, realToFrac u ] \floatPtr -> do
changed <- withCString desc \descPtr ->
(0 /=) <$> [C.exp| bool { SliderFloat4( $(char* descPtr), $(float *floatPtr), $(float min'), $(float max')) } |]
[x', y', z', u'] <- peekArray 4 floatPtr
ref $=! (realToFrac x', realToFrac y', realToFrac z', realToFrac u')
return changed
where
min', max' :: CFloat
min' = realToFrac minValue
max' = realToFrac maxValue
-- | Wraps @ImGui::ColorPicker3()@.
colorPicker3 :: (MonadIO m, HasSetter ref ImVec3, HasGetter ref ImVec3) => String -> ref -> m Bool
colorPicker3 desc ref = liftIO do
ImVec3{x, y, z} <- get ref
withArray (realToFrac <$> [x, y, z]) \refPtr -> do
changed <- withCString desc \descPtr ->
(0 /= ) <$> [C.exp| bool { ColorPicker3( $(char* descPtr), $(float *refPtr) ) } |]
[x', y', z'] <- peekArray 3 refPtr
ref $=! ImVec3 (realToFrac x') (realToFrac y') (realToFrac z')
return changed
-- | Display a color square/button, hover for details, return true when pressed.
--
-- Wraps @ImGui::ColorButton()@.
@ -441,6 +664,25 @@ colorButton desc ref = liftIO do
return changed
-- | Wraps @ImGui::TreeNode()@.
treeNode :: MonadIO m => String -> m Bool
treeNode label = liftIO do
withCString label \labelPtr ->
(0 /=) <$> [C.exp| bool { TreeNode($(char* labelPtr)) } |]
-- | Wraps @ImGui::TreePush()@.
treePush :: MonadIO m => String -> m ()
treePush label = liftIO do
withCString label \labelPtr ->
[C.exp| void { TreePush($(char* labelPtr)) } |]
-- | Wraps @ImGui::TreePop()@.
treePop :: MonadIO m => m ()
treePop = liftIO do
[C.exp| void { TreePop() } |]
-- | Wraps @ImGui::Selectable()@.
selectable :: MonadIO m => String -> m Bool
@ -448,6 +690,25 @@ selectable label = liftIO do
withCString label \labelPtr ->
(0 /=) <$> [C.exp| bool { Selectable($(char* labelPtr)) } |]
listBox :: (MonadIO m, HasGetter ref Int, HasSetter ref Int) => String -> ref -> [String] -> m Bool
listBox label selectedIndex items = liftIO $ Managed.with m return
where
m = do
i <- get selectedIndex
cStrings <- traverse (\str -> Managed.managed (withCString str)) items
labelPtr <- Managed.managed $ withCString label
iPtr <- Managed.managed $ with (fromIntegral i)
liftIO $ withArrayLen cStrings \len itemsPtr -> do
let len' = fromIntegral len
[C.exp| bool { ListBox($(char* labelPtr), $(int* iPtr), $(char** itemsPtr), $(int len')) }|] >>= \case
0 -> return False
_ -> do
i' <- peek iPtr
selectedIndex $=! fromIntegral i'
return True
-- | Wraps @ImGui::PlotHistogram()@.
plotHistogram :: MonadIO m => String -> [CFloat] -> m ()
@ -508,7 +769,7 @@ endMenu = liftIO do
[C.exp| void { EndMenu(); } |]
-- Return true when activated. Shortcuts are displayed for convenience but not
-- | Return true when activated. Shortcuts are displayed for convenience but not
-- processed by ImGui at the moment
--
-- Wraps @ImGui::MenuItem()@
@ -517,6 +778,57 @@ menuItem label = liftIO do
withCString label \labelPtr ->
(0 /=) <$> [C.exp| bool { MenuItem($(char* labelPtr)) } |]
-- | Create a @TabBar@ and start appending to it.
--
-- Wraps @ImGui::BeginTabBar@.
beginTabBar :: MonadIO m => String -> ImGuiTabBarFlags -> m Bool
beginTabBar tabBarID flags = liftIO do
withCString tabBarID \ptr ->
(0 /=) <$> [C.exp| bool { BeginTabBar($(char* ptr), $(ImGuiTabBarFlags flags) ) } |]
-- | Finish appending elements to a tab bar. Only call if 'beginTabBar' returns @True@.
--
-- Wraps @ImGui::EndTabBar@.
endTabBar :: MonadIO m => m ()
endTabBar = liftIO do
[C.exp| void { EndTabBar(); } |]
-- | Create a new tab. Returns @True@ if the tab is selected.
--
-- Wraps @ImGui::BeginTabItem@.
beginTabItem :: ( MonadIO m, HasGetter ref Bool, HasSetter ref Bool ) => String -> ref -> ImGuiTabBarFlags -> m Bool
beginTabItem tabName ref flags = liftIO do
currentValue <- get ref
with ( bool 0 1 currentValue :: CBool ) \ refPtr -> do
open <- withCString tabName \ ptrName ->
(0 /=) <$> [C.exp| bool { BeginTabItem($(char* ptrName), $(bool* refPtr), $(ImGuiTabBarFlags flags) ) } |]
newValue <- (0 /=) <$> peek refPtr
ref $=! newValue
pure open
-- | Finish appending elements to a tab. Only call if 'beginTabItem' returns @True@.
--
-- Wraps @ImGui::EndTabItem@.
endTabItem :: MonadIO m => m ()
endTabItem = liftIO do
[C.exp| void { EndTabItem(); } |]
-- | Create a tab that behaves like a button. Returns @True@ when clicked. Cannot be selected in the tab bar.
--
-- Wraps @ImGui.TabItemButton@.
tabItemButton :: MonadIO m => String -> ImGuiTabItemFlags -> m Bool
tabItemButton tabName flags = liftIO do
withCString tabName \ namePtr ->
(0 /=) <$> [C.exp| bool { TabItemButton($(char* 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 tabName = liftIO do
withCString tabName \ namePtr ->
[C.exp| void { SetTabItemClosed($(char* namePtr)); } |]
-- | Begin/append a tooltip window to create full-featured tooltip (with any
-- kind of items).
@ -584,22 +896,176 @@ isItemHovered = liftIO do
(0 /=) <$> [C.exp| bool { IsItemHovered() } |]
-- | A cardinal direction.
newtype ImGuiDir = ImGuiDir CInt
pattern ImGuiDirLeft, ImGuiDirRight, ImGuiDirUp, ImGuiDirDown :: ImGuiDir
pattern ImGuiDirLeft = ImGuiDir 0
pattern ImGuiDirRight = ImGuiDir 1
pattern ImGuiDirUp = ImGuiDir 2
pattern ImGuiDirDown = ImGuiDir 3
withCStringOrNull :: Maybe String -> (Ptr CChar -> IO a) -> IO a
withCStringOrNull Nothing k = k nullPtr
withCStringOrNull (Just s) k = withCString s k
-- | Set next window position. Call before `begin` Use pivot=(0.5,0.5) to center on given point, etc.
--
-- Wraps @ImGui::SetNextWindowPos()@
setNextWindowPos :: (MonadIO m, HasGetter ref ImVec2) => ref -> ImGuiCond -> Maybe ref -> m ()
setNextWindowPos posRef cond pivotMaybe = liftIO do
pos <- get posRef
with pos $ \posPtr ->
case pivotMaybe of
Just pivotRef -> do
pivot <- get pivotRef
with pivot $ \pivotPtr ->
[C.exp| void { SetNextWindowPos(*$(ImVec2 *posPtr), $(ImGuiCond cond), *$(ImVec2 *pivotPtr)) } |]
Nothing ->
[C.exp| void { SetNextWindowPos(*$(ImVec2 *posPtr), $(ImGuiCond cond)) } |]
-- | Set next window size. Call before `begin`
--
-- Wraps @ImGui::SetNextWindowSize()@
setNextWindowSize :: (MonadIO m, HasGetter ref ImVec2) => ref -> ImGuiCond -> m ()
setNextWindowSize sizeRef cond = liftIO do
size' <- get sizeRef
with size' $
\sizePtr ->[C.exp| void { SetNextWindowSize(*$(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 sizeRef = liftIO do
size' <- get sizeRef
with size' $
\sizePtr ->[C.exp| void { SetNextWindowContentSize(*$(ImVec2 *sizePtr)) } |]
-- | Set next window size limits. use -1,-1 on either X/Y axis to preserve the current size. Sizes will be rounded down.
--
-- Wraps @ImGui::SetNextWindowContentSize()@
setNextWindowSizeConstraints :: (MonadIO m, HasGetter ref ImVec2) => ref -> ref -> m ()
setNextWindowSizeConstraints sizeMinRef sizeMaxRef = liftIO do
sizeMin <- get sizeMinRef
sizeMax <- get sizeMaxRef
with sizeMin $
\sizeMinPtr ->
with sizeMax $ \sizeMaxPtr ->
[C.exp| void { SetNextWindowSizeConstraints(*$(ImVec2 *sizeMinPtr), *$(ImVec2 *sizeMaxPtr)) } |]
-- | Set next window collapsed state. call before `begin`
--
-- Wraps @ImGui::SetNextWindowCollapsed()@
setNextWindowCollapsed :: (MonadIO m) => Bool -> ImGuiCond -> m ()
setNextWindowCollapsed b cond = liftIO do
let b' = bool 0 1 b
[C.exp| void { SetNextWindowCollapsed($(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 f = liftIO do
let f' = coerce f
[C.exp| void { SetNextWindowBgAlpha($(float f')) } |]
-- | undo a sameLine or force a new line when in an horizontal-layout context.
--
-- Wraps @ImGui::NewLine()@
newLine :: (MonadIO m) => m ()
newLine = liftIO do
[C.exp| void { NewLine() } |]
-- | Add vertical spacing.
--
-- Wraps @ImGui::Spacing()@
spacing :: (MonadIO m) => m ()
spacing = liftIO do
[C.exp| void { Spacing() } |]
-- | Add a dummy item of given size. unlike `invisibleButton`, `dummy` won't take the mouse click or be navigable into.
--
-- Wraps @ImGui::Dummy()@
dummy :: (MonadIO m, HasGetter ref ImVec2) => ref -> m ()
dummy sizeRef = liftIO do
size' <- get sizeRef
with size' $ \ sizePtr -> [C.exp| void { Dummy(*$(ImVec2 *sizePtr)) } |]
-- | Move content position toward the right, by indent_w, or style.IndentSpacing if indent_w <= 0
--
-- Wraps @ImGui::Indent()@
indent :: (MonadIO m) => Float -> m ()
indent indent_w = liftIO do
let indent_w' = coerce indent_w
[C.exp| void { Indent($(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 f = liftIO do
let f' = coerce f
[C.exp| void { Unindent($(float f')) } |]
-- | lock horizontal starting position
--
-- Wraps @ImGui::BeginGroup()@
beginGroup :: (MonadIO m) => m ()
beginGroup = liftIO do
[C.exp| void { BeginGroup() } |]
-- | unlock horizontal starting position + capture the whole group bounding box into one "item" (so you can use `isItemHovered` or layout primitives such as `sameLine` on whole group, etc.)
--
-- Wraps @ImGui::EndGroup()@
endGroup :: (MonadIO m) => m ()
endGroup = liftIO do
[C.exp| void { EndGroup() } |]
-- | Vertically align upcoming text baseline to FramePadding.y so that it will align properly to regularly framed items (call if you have text on a line before a framed item)
--
-- Wraps @ImGui::AlignTextToFramePadding()@
alignTextToFramePadding :: (MonadIO m) => m ()
alignTextToFramePadding = liftIO do
[C.exp| void { AlignTextToFramePadding() } |]
-- | Set cursor position in window-local coordinates
--
-- Wraps @ImGui::SetCursorPos()@
setCursorPos :: (MonadIO m, HasGetter ref ImVec2) => ref -> m ()
setCursorPos posRef = liftIO do
pos <- get posRef
with pos $ \ posPtr -> [C.exp| void { SetCursorPos(*$(ImVec2 *posPtr)) } |]
-- | Modify a style color by pushing to the shared stack. always use this if you modify the style after `newFrame`
--
-- Wraps @ImGui::PushStyleColor()@
pushStyleColor :: (MonadIO m, HasGetter ref ImVec4) => ImGuiCol -> ref -> m ()
pushStyleColor col colorRef = liftIO do
color <- get colorRef
with color $ \ colorPtr -> [C.exp| void { PushStyleColor($(ImGuiCol col), *$(ImVec4 *colorPtr)) } |]
-- | Remove style color modifications from the shared stack
--
-- Wraps @ImGui::PopStyleColor()@
popStyleColor :: (MonadIO m) => Int32 -> m ()
popStyleColor n = liftIO do
let
m :: CInt
m = coerce n
[C.exp| void { PopStyleColor($(int m)) } |]
-- | Modify a style variable by pushing to the shared stack. always use this if you modify the style after `newFrame`
--
-- Wraps @ImGui::PushStyleVar()@
pushStyleVar :: (MonadIO m, HasGetter ref ImVec2) => ImGuiStyleVar -> ref -> m ()
pushStyleVar style valRef = liftIO do
val <- get valRef
with val $ \ valPtr -> [C.exp| void { PushStyleVar($(ImGuiStyleVar style), *$(ImVec2 *valPtr)) } |]
-- | Remove style variable modifications from the shared stack
--
-- Wraps @ImGui::PopStyleVar()@
popStyleVar :: (MonadIO m) => Int32 -> m ()
popStyleVar n = liftIO do
let
m :: CInt
m = coerce n
[C.exp| void { PopStyleVar($(int m)) } |]
withMaybeStateVar :: Storable x => Maybe (StateVar x) -> (Ptr x -> IO r) -> IO r
withMaybeStateVar Nothing k = k nullPtr
withMaybeStateVar (Just r) k = withStateVar r k

65
src/DearImGui/Context.hs
View File

@ -1,62 +1,39 @@
{-# language DerivingStrategies #-}
{-# language DuplicateRecordFields #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language NamedFieldPuns #-}
{-# language OverloadedStrings #-}
{-# language PatternSynonyms #-}
{-# language TemplateHaskell #-}
module DearImGui.Context where
import Language.C.Types
import Language.C.Inline.Context
-- containers
import qualified Data.Map.Strict as Map
import Foreign
-- inline-c
import Language.C.Inline.Context
( Context(..) )
import Language.C.Types
( pattern TypeName )
data ImVec3 = ImVec3 { x, y, z :: {-# unpack #-} !Float }
instance Storable ImVec3 where
sizeOf ~ImVec3{x, y, z} = sizeOf x + sizeOf y + sizeOf z
alignment _ = 0
poke ptr ImVec3{ x, y, z } = do
poke (castPtr ptr `plusPtr` (sizeOf x * 0)) x
poke (castPtr ptr `plusPtr` (sizeOf x * 1)) y
poke (castPtr ptr `plusPtr` (sizeOf x * 2)) z
peek ptr = do
x <- peek (castPtr ptr )
y <- peek (castPtr ptr `plusPtr` (sizeOf x * 1))
z <- peek (castPtr ptr `plusPtr` (sizeOf x * 2))
return ImVec3{ x, y, z }
data ImVec4 = ImVec4 { x, y, z, w :: {-# unpack #-} !Float }
instance Storable ImVec4 where
sizeOf ~ImVec4{x, y, z, w} = sizeOf x + sizeOf y + sizeOf z + sizeOf w
alignment _ = 0
poke ptr ImVec4{ x, y, z, w } = do
poke (castPtr ptr `plusPtr` (sizeOf x * 0)) x
poke (castPtr ptr `plusPtr` (sizeOf x * 1)) y
poke (castPtr ptr `plusPtr` (sizeOf x * 2)) z
poke (castPtr ptr `plusPtr` (sizeOf x * 3)) w
peek ptr = do
x <- peek (castPtr ptr )
y <- peek (castPtr ptr `plusPtr` (sizeOf x * 1))
z <- peek (castPtr ptr `plusPtr` (sizeOf x * 2))
w <- peek (castPtr ptr `plusPtr` (sizeOf x * 3))
return ImVec4{ x, y, z, w }
-- dear-imgui
import DearImGui.Enums
import DearImGui.Structs
--------------------------------------------------------------------------------
imguiContext :: Context
imguiContext = mempty
{ ctxTypesTable = Map.fromList
[ ( TypeName "ImVec3", [t| ImVec3 |] )
[ ( TypeName "ImGuiCol" , [t| ImGuiCol |] )
, ( TypeName "ImGuiCond", [t| ImGuiCond |] )
, ( TypeName "ImGuiDir" , [t| ImGuiDir |] )
, ( TypeName "ImGuiStyleVar" , [t| ImGuiStyleVar |] )
, ( TypeName "ImGuiTabBarFlags" , [t| ImGuiTabBarFlags |] )
, ( TypeName "ImGuiTabItemFlags", [t| ImGuiTabItemFlags |] )
, ( TypeName "ImVec2", [t| ImVec2 |] )
, ( TypeName "ImVec3", [t| ImVec3 |] )
, ( TypeName "ImVec4", [t| ImVec4 |] )
]
}

34
src/DearImGui/Enums.hs Normal file
View File

@ -0,0 +1,34 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module DearImGui.Enums where
-- base
import GHC.Exts
( proxy# )
import GHC.TypeNats
( Nat, KnownNat, natVal' )
import Numeric.Natural
( Natural )
-- dear-imgui-generator
import DearImGui.Generator
( declareEnumerations )
--------------------------------------------------------------------------------
class KnownNat ( Count a ) => FiniteEnum a where
type Count a :: Nat
count :: Natural
count = natVal' @( Count a ) proxy#
declareEnumerations ''FiniteEnum ''Count

51
src/DearImGui/GLFW.hs Normal file
View File

@ -0,0 +1,51 @@
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-|
Module: DearImGui.GLFW
GLFW specific functions backend for Dear ImGui.
Modules for initialising a backend with GLFW can be found under the corresponding backend,
e.g. "DearImGui.GLFW.OpenGL".
-}
module DearImGui.GLFW (
-- ** GLFW
glfwNewFrame
, glfwShutdown
)
where
-- inline-c
import qualified Language.C.Inline as C
-- inline-c-cpp
import qualified Language.C.Inline.Cpp as Cpp
-- transformers
import Control.Monad.IO.Class
( MonadIO, liftIO )
C.context (Cpp.cppCtx <> C.bsCtx)
C.include "imgui.h"
C.include "backends/imgui_impl_glfw.h"
Cpp.using "namespace ImGui"
-- | Wraps @ImGui_ImplGlfw_NewFrame@.
glfwNewFrame :: MonadIO m => m ()
glfwNewFrame = liftIO do
[C.exp| void { ImGui_ImplGlfw_NewFrame(); } |]
-- | Wraps @ImGui_ImplGlfw_Shutdown@.
glfwShutdown :: MonadIO m => m ()
glfwShutdown = liftIO do
[C.exp| void { ImGui_ImplGlfw_Shutdown(); } |]

61
src/DearImGui/GLFW/OpenGL.hs Normal file
View File

@ -0,0 +1,61 @@
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-|
Module: DearImGUI.GLFW.OpenGL
Initialising the OpenGL backend for Dear ImGui using GLFW3.
-}
module DearImGui.GLFW.OpenGL
( glfwInitForOpenGL )
where
-- base
import Data.Bool
( bool )
import Foreign.C.Types
( CBool )
import Foreign.Ptr
( Ptr )
import Unsafe.Coerce
( unsafeCoerce )
-- inline-c
import qualified Language.C.Inline as C
-- inline-c-cpp
import qualified Language.C.Inline.Cpp as Cpp
-- GLFW
import Graphics.UI.GLFW
( Window )
-- transformers
import Control.Monad.IO.Class
( MonadIO, liftIO )
C.context (Cpp.cppCtx <> C.bsCtx)
C.include "imgui.h"
C.include "backends/imgui_impl_opengl2.h"
C.include "backends/imgui_impl_glfw.h"
C.include "GLFW/glfw3.h"
Cpp.using "namespace ImGui"
-- | Wraps @ImGui_ImplGlfw_InitForOpenGL@.
glfwInitForOpenGL :: MonadIO m => Window -> Bool -> m Bool
glfwInitForOpenGL window installCallbacks = liftIO do
( 0 /= ) <$> [C.exp| bool { ImGui_ImplGlfw_InitForOpenGL((GLFWwindow*)$(void* windowPtr), $(bool cInstallCallbacks)) } |]
where
windowPtr :: Ptr ()
windowPtr = unsafeCoerce window
cInstallCallbacks :: CBool
cInstallCallbacks = bool 0 1 installCallbacks

60
src/DearImGui/GLFW/Vulkan.hs Normal file
View File

@ -0,0 +1,60 @@
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-|
Module: DearImGui.GLFW.Vulkan
Initialising the Vulkan backend for Dear ImGui using GLFW3.
-}
module DearImGui.GLFW.Vulkan
( glfwInitForVulkan )
where
-- base
import Data.Bool
( bool )
import Foreign.C.Types
( CBool )
import Foreign.Ptr
( Ptr )
import Unsafe.Coerce
( unsafeCoerce )
-- inline-c
import qualified Language.C.Inline as C
-- inline-c-cpp
import qualified Language.C.Inline.Cpp as Cpp
-- GLFW
import Graphics.UI.GLFW
( Window )
-- transformers
import Control.Monad.IO.Class ( MonadIO, liftIO )
C.context Cpp.cppCtx
C.include "imgui.h"
C.include "backends/imgui_impl_vulkan.h"
C.include "backends/imgui_impl_glfw.h"
C.include "GLFW/glfw3.h"
Cpp.using "namespace ImGui"
-- | Wraps @ImGui_ImplGlfw_InitForVulkan@.
glfwInitForVulkan :: MonadIO m => Window -> Bool -> m Bool
glfwInitForVulkan window installCallbacks = liftIO do
( 0 /= ) <$> [C.exp| bool { ImGui_ImplGlfw_InitForVulkan((GLFWwindow*)$(void* windowPtr), $(bool cInstallCallbacks)) } |]
where
windowPtr :: Ptr ()
windowPtr = unsafeCoerce window
cInstallCallbacks :: CBool
cInstallCallbacks = bool 0 1 installCallbacks

4
src/DearImGui/OpenGL.hs → src/DearImGui/OpenGL2.hs
View File

@ -9,10 +9,10 @@
{-|
Module: DearImGui.OpenGL
OpenGL backend for Dear ImGui.
OpenGL 2 backend for Dear ImGui.
-}
module DearImGui.OpenGL
module DearImGui.OpenGL2
( openGL2Init
, openGL2Shutdown
, openGL2NewFrame

69
src/DearImGui/OpenGL3.hs Normal file
View File

@ -0,0 +1,69 @@
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-|
Module: DearImGui.OpenGL
OpenGL 3 backend for Dear ImGui.
-}
module DearImGui.OpenGL3
( openGL3Init
, openGL3Shutdown
, openGL3NewFrame
, openGL3RenderDrawData
)
where
-- inline-c
import qualified Language.C.Inline as C
-- inline-c-cpp
import qualified Language.C.Inline.Cpp as Cpp
-- transformers
import Control.Monad.IO.Class
( MonadIO, liftIO )
-- DearImGui
import DearImGui
( DrawData(..) )
C.context (Cpp.cppCtx <> C.bsCtx)
C.include "imgui.h"
C.include "GL/glew.h"
C.include "backends/imgui_impl_opengl3.h"
Cpp.using "namespace ImGui"
-- | Wraps @ImGui_ImplOpenGL3_Init@.
openGL3Init :: MonadIO m => m Bool
openGL3Init = liftIO $
( 0 /= ) <$> [C.block| bool {
glewInit();
return ImGui_ImplOpenGL3_Init();
} |]
-- | Wraps @ImGui_ImplOpenGL3_Shutdown@.
openGL3Shutdown :: MonadIO m => m ()
openGL3Shutdown = liftIO do
[C.exp| void { ImGui_ImplOpenGL3_Shutdown(); } |]
-- | Wraps @ImGui_ImplOpenGL3_NewFrame@.
openGL3NewFrame :: MonadIO m => m ()
openGL3NewFrame = liftIO do
[C.exp| void { ImGui_ImplOpenGL3_NewFrame(); } |]
-- | Wraps @ImGui_ImplOpenGL3_RenderDrawData@.
openGL3RenderDrawData :: MonadIO m => DrawData -> m ()
openGL3RenderDrawData (DrawData ptr) = liftIO do
[C.exp| void { ImGui_ImplOpenGL3_RenderDrawData((ImDrawData*) $( void* ptr )) } |]

68
src/DearImGui/Structs.hs Normal file
View File

@ -0,0 +1,68 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
module DearImGui.Structs where
-- base
import Foreign
( Storable(..), castPtr, plusPtr )
--------------------------------------------------------------------------------
data ImVec2 = ImVec2 { x, y :: {-# unpack #-} !Float }
instance Storable ImVec2 where
sizeOf ~ImVec2{x, y} = sizeOf x + sizeOf y
alignment _ = 0
poke ptr ImVec2{ x, y } = do
poke (castPtr ptr `plusPtr` (sizeOf x * 0)) x
poke (castPtr ptr `plusPtr` (sizeOf x * 1)) y
peek ptr = do
x <- peek (castPtr ptr )
y <- peek (castPtr ptr `plusPtr` (sizeOf x * 1))
return ImVec2{ x, y }
data ImVec3 = ImVec3 { x, y, z :: {-# unpack #-} !Float }
instance Storable ImVec3 where
sizeOf ~ImVec3{x, y, z} = sizeOf x + sizeOf y + sizeOf z
alignment _ = 0
poke ptr ImVec3{ x, y, z } = do
poke (castPtr ptr `plusPtr` (sizeOf x * 0)) x
poke (castPtr ptr `plusPtr` (sizeOf x * 1)) y
poke (castPtr ptr `plusPtr` (sizeOf x * 2)) z
peek ptr = do
x <- peek (castPtr ptr )
y <- peek (castPtr ptr `plusPtr` (sizeOf x * 1))
z <- peek (castPtr ptr `plusPtr` (sizeOf x * 2))
return ImVec3{ x, y, z }
data ImVec4 = ImVec4 { x, y, z, w :: {-# unpack #-} !Float }
instance Storable ImVec4 where
sizeOf ~ImVec4{x, y, z, w} = sizeOf x + sizeOf y + sizeOf z + sizeOf w
alignment _ = 0
poke ptr ImVec4{ x, y, z, w } = do
poke (castPtr ptr `plusPtr` (sizeOf x * 0)) x
poke (castPtr ptr `plusPtr` (sizeOf x * 1)) y
poke (castPtr ptr `plusPtr` (sizeOf x * 2)) z
poke (castPtr ptr `plusPtr` (sizeOf x * 3)) w
peek ptr = do
x <- peek (castPtr ptr )
y <- peek (castPtr ptr `plusPtr` (sizeOf x * 1))
z <- peek (castPtr ptr `plusPtr` (sizeOf x * 2))
w <- peek (castPtr ptr `plusPtr` (sizeOf x * 3))
return ImVec4{ x, y, z, w }