Compare commits

..

No commits in common. "main" and "v1.4.0" have entirely different histories.
main ... v1.4.0

31 changed files with 440 additions and 1706 deletions

View File

@ -4,16 +4,16 @@ jobs:
build:
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v2.4.0
- uses: actions/checkout@v2.3.4
with:
persist-credentials: false
submodules: true
- uses: cachix/install-nix-action@v20
- uses: cachix/install-nix-action@v16
with:
nix_path: nixpkgs=channel:nixos-unstable
- uses: cachix/cachix-action@v12
- uses: cachix/cachix-action@v10
with:
name: hs-dear-imgui
authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}'

View File

@ -1,46 +1,5 @@
# Changelog for dear-imgui
## [2.2.0]
- `imgui` updated to [1.89.9].
- Update bounds for ghc-9.6.
- Exposed `DearImGui.Raw.Context`.
- Added `getCursorPos``.
- Fix TabItem flags type.
## [2.1.3]
- Fixed off-by-1 in internal Text wrapper.
- Fixed sliderFloat* Raw calls
- Added `formatPtr` to Raw.dragFloat* and Raw.sliderFloat*
## [2.1.2]
- Fixed glfw example build flags.
- Added `plotLines`.
- Added `setNextItemOpen`.
## [2.1.1]
- Build flag fix for MacOS.
## [2.1.0]
- `imgui` updated to [1.88].
* Breaking: `ImGuiKeyModFlags` renamed to `ImGuiModFlags`.
## [2.0.0]
- `String` arguments replaced with `Text`.
* Upgrading to `text-2` recommended to reap the UTF-8 benefits.
## [1.5.0]
- Added table wrappers.
- Added popup wrappers.
- Added `selectableWith`/`SelectableOptions` to expose optional arguments.
- Fix GHC-9.2 compatibility.
## [1.4.0]
- `imgui` updated to [1.87].
@ -109,15 +68,7 @@ Initial Hackage release based on [1.83].
[1.3.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.3.0
[1.3.1]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.3.1
[1.4.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.4.0
[1.5.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.5.0
[2.0.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v2.0.0
[2.1.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v2.1.0
[2.1.1]: https://github.com/haskell-game/dear-imgui.hs/tree/v2.1.1
[2.1.2]: https://github.com/haskell-game/dear-imgui.hs/tree/v2.1.2
[2.1.3]: https://github.com/haskell-game/dear-imgui.hs/tree/v2.1.3
[2.2.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v2.2.0
[1.89.9]: https://github.com/ocornut/imgui/releases/tag/v1.89.9
[1.87]: https://github.com/ocornut/imgui/releases/tag/v1.87
[1.86]: https://github.com/ocornut/imgui/releases/tag/v1.86
[1.85]: https://github.com/ocornut/imgui/releases/tag/v1.85

11
Main.hs
View File

@ -10,7 +10,6 @@ import Data.IORef
import qualified Data.Vector as Vector
import DearImGui
import DearImGui.OpenGL3
import DearImGui.Internal.Text (pack)
import DearImGui.SDL
import DearImGui.SDL.OpenGL
import Control.Exception
@ -79,10 +78,10 @@ loop window checked color slider r pos size' selected tab1Ref tab2Ref = do
text "Hello!"
beginTabBar "My tab bar" ImGuiTabBarFlags_Reorderable >>= whenTrue do
beginTabItem "Tab 1" tab1Ref ImGuiTabItemFlags_None >>= whenTrue do
beginTabItem "Tab 1" tab1Ref ImGuiTabBarFlags_None >>= whenTrue do
text "Tab 1 is currently selected."
endTabItem
beginTabItem "Tab 2" tab2Ref ImGuiTabItemFlags_None >>= whenTrue do
beginTabItem "Tab 2" tab2Ref ImGuiTabBarFlags_None >>= whenTrue do
text "Tab 2 is selected now."
endTabItem
reOpen <- tabItemButton "ReopenTabs" ImGuiTabItemFlags_Trailing
@ -135,18 +134,18 @@ loop window checked color slider r pos size' selected tab1Ref tab2Ref = do
text "ListClipper"
withChildOpen "##fixed" (ImVec2 0 200) True ImGuiWindowFlags_None do
let lotsOfItems = Vector.generate 50 (pack . mappend "Item " . show)
let lotsOfItems = Vector.generate 50 (mappend "Item " . show)
withListClipper Nothing lotsOfItems text
text "ListClipper, Haskell-powered"
withChildOpen "##infinite" (ImVec2 0 200) True ImGuiWindowFlags_None do
let infiniteItems = map (pack . mappend "Item " . show) [0 :: Int ..]
let infiniteItems = map (mappend "Item " . show) [0 :: Int ..]
withListClipper Nothing infiniteItems text
text "Ethereal ListClipper"
withChildOpen "##ethereal" (ImVec2 0 200) True ImGuiWindowFlags_None do
withListClipper Nothing (ClipRange (0 :: Int) 1000) $
text . pack . mappend "Item " . show
text . mappend "Item " . show
plotHistogram "A histogram" [ 10, 10, 20, 30, 90 ]

View File

@ -31,30 +31,29 @@ package dear-imgui
With this done, the following module is the "Hello, World!" of ImGui:
``` haskell
{-# language BlockArguments #-}
{-# language LambdaCase #-}
{-# language OverloadedStrings #-}
module Main ( main ) where
import Control.Exception
import Control.Monad.IO.Class
import Control.Monad.Managed
import DearImGui
import DearImGui.OpenGL3
import DearImGui.OpenGL2
import DearImGui.SDL
import DearImGui.SDL.OpenGL
import Graphics.GL
import SDL
import Control.Monad.Managed
import Control.Monad.IO.Class ()
import Control.Monad (when, unless)
import Control.Exception (bracket, bracket_)
main :: IO ()
main = do
-- Initialize SDL
initializeAll
runManaged $ do
-- Create a window using SDL; as we're using OpenGL, we enable OpenGL too
runManaged do
-- Create a window using SDL. As we're using OpenGL, we need to enable OpenGL too.
window <- do
let title = "Hello, Dear ImGui!"
let config = defaultWindow { windowGraphicsContext = OpenGLContext defaultOpenGL }
@ -62,59 +61,64 @@ main = do
-- Create an OpenGL context
glContext <- managed $ bracket (glCreateContext window) glDeleteContext
-- Create an ImGui context
_ <- managed $ bracket createContext destroyContext
-- Initialize ImGui's SDL2 backend
managed_ $ bracket_ (sdl2InitForOpenGL window glContext) sdl2Shutdown
_ <- managed_ $ bracket_ (sdl2InitForOpenGL window glContext) sdl2Shutdown
-- Initialize ImGui's OpenGL backend
managed_ $ bracket_ openGL3Init openGL3Shutdown
_ <- managed_ $ bracket_ openGL2Init openGL2Shutdown
liftIO $ mainLoop window
mainLoop :: Window -> IO ()
mainLoop window = unlessQuit $ do
mainLoop window = unlessQuit do
-- Tell ImGui we're starting a new frame
openGL3NewFrame
openGL2NewFrame
sdl2NewFrame
newFrame
-- Build the GUI
withWindowOpen "Hello, ImGui!" $ do
withWindowOpen "Hello, ImGui!" do
-- Add a text widget
text "Hello, ImGui!"
-- Add a button widget, and call 'putStrLn' when it's clicked
button "Clickety Click" >>= \clicked ->
when clicked $ putStrLn "Ow!"
button "Clickety Click" >>= \case
False -> return ()
True -> putStrLn "Ow!"
-- Show the ImGui demo window
showDemoWindow
-- Render
glClear GL_COLOR_BUFFER_BIT
render
openGL3RenderDrawData =<< getDrawData
openGL2RenderDrawData =<< getDrawData
glSwapWindow window
mainLoop window
where
-- Process the event loop
unlessQuit action = do
shouldQuit <- gotQuitEvent
unless shouldQuit action
shouldQuit <- checkEvents
if shouldQuit then pure () else action
gotQuitEvent = do
ev <- pollEventWithImGui
case ev of
checkEvents = do
pollEventWithImGui >>= \case
Nothing ->
return False
Just event ->
(isQuit event ||) <$> gotQuitEvent
(isQuit event ||) <$> checkEvents
isQuit event =
eventPayload event == QuitEvent
SDL.eventPayload event == SDL.QuitEvent
```
# Hacking

View File

@ -1,4 +1,4 @@
packages: *.cabal
package dear-imgui
flags: +sdl +glfw +opengl2 +opengl3 +vulkan +examples
flags: +sdl2 +glfw +opengl2 +opengl3 +vulkan +examples
ghc-options: -Wall -Wcompat -fno-warn-unused-do-bind

View File

@ -1,7 +1,7 @@
cabal-version: 3.0
name: dear-imgui
version: 2.2.0
version: 1.4.0
author: Oliver Charles
maintainer: ollie@ocharles.org.uk, aenor.realm@gmail.com
license: BSD-3-Clause
@ -94,15 +94,6 @@ flag sdl
manual:
True
flag sdl-renderer
description:
Enable SDL Renderer backend (requires the SDL_RenderGeometry function available in SDL 2.0.18+).
The sdl configuration flag must also be enabled when using this flag.
default:
False
manual:
True
flag glfw
description:
Enable GLFW backend.
@ -135,21 +126,10 @@ flag use-wchar32
manual:
True
flag use-ImDrawIdx32
description:
Use 32-bit vertex indices (default is 16-bit) is one way to allow large meshes with more than 64K vertices.
Your renderer backend will need to support it (most example renderer backends support both 16/32-bit indices).
Another way to allow large meshes while keeping 16-bit indices is to handle ImDrawCmd::VtxOffset in your renderer.
Read about ImGuiBackendFlags_RendererHasVtxOffset for details.
default:
True
manual:
True
common common
build-depends:
base
>= 4.12 && < 4.19
>= 4.12 && < 4.17
default-language:
Haskell2010
@ -160,16 +140,15 @@ library
exposed-modules:
DearImGui
DearImGui.FontAtlas
DearImGui.Internal.Text
DearImGui.Raw
DearImGui.Raw.DrawList
DearImGui.Raw.Font
DearImGui.Raw.Font.Config
DearImGui.Raw.Font.GlyphRanges
DearImGui.Raw.IO
DearImGui.Raw.ListClipper
DearImGui.Raw.Context
DearImGui.Raw.IO
other-modules:
DearImGui.Context
DearImGui.Enums
DearImGui.Structs
cxx-options: -std=c++11
@ -179,10 +158,8 @@ library
imgui/imgui_draw.cpp
imgui/imgui_tables.cpp
imgui/imgui_widgets.cpp
if impl(ghc >= 9.4)
build-depends: system-cxx-std-lib
else
extra-libraries: stdc++
extra-libraries:
stdc++
include-dirs:
imgui
build-depends:
@ -194,11 +171,6 @@ library
, StateVar
, unliftio
, vector
, text
if os(darwin)
ghc-options:
-optcxx-std=c++11
if flag(disable-obsolete)
cxx-options: -DIMGUI_DISABLE_OBSOLETE_FUNCTIONS
@ -207,10 +179,6 @@ library
cxx-options: -DIMGUI_USE_WCHAR32
cpp-options: -DIMGUI_USE_WCHAR32
if flag(use-ImDrawIdx32)
cxx-options: "-DImDrawIdx=unsigned int"
cpp-options: "-DImDrawIdx=unsigned int"
if flag(opengl2)
exposed-modules:
DearImGui.OpenGL2
@ -254,7 +222,7 @@ library
build-depends:
sdl2
cxx-sources:
imgui/backends/imgui_impl_sdl2.cpp
imgui/backends/imgui_impl_sdl.cpp
if os(windows) || os(darwin)
extra-libraries:
@ -271,12 +239,6 @@ library
exposed-modules:
DearImGui.SDL.Vulkan
if flag(sdl-renderer)
exposed-modules:
DearImGui.SDL.Renderer
cxx-sources:
imgui/backends/imgui_impl_sdlrenderer2.cpp
if flag(glfw)
exposed-modules:
DearImGui.GLFW
@ -308,7 +270,7 @@ library dear-imgui-generator
, DearImGui.Generator.Types
build-depends:
template-haskell
>= 2.15 && < 2.21
>= 2.15 && < 2.19
, containers
^>= 0.6.2.1
, directory
@ -318,17 +280,17 @@ library dear-imgui-generator
, inline-c
>= 0.9.0.0 && < 0.10
, megaparsec
>= 9.0 && < 9.4
>= 9.0 && < 9.3
, parser-combinators
>= 1.2.0 && < 1.4
, scientific
>= 0.3.6.2 && < 0.3.8
, text
>= 1.2.4 && < 2.1
>= 1.2.4 && < 1.3
, th-lift
>= 0.7 && < 0.9
, transformers
>= 0.5.6 && < 0.7
>= 0.5.6 && < 0.6
, unordered-containers
>= 0.2.11 && < 0.3
@ -349,7 +311,7 @@ executable glfw
if (!flag(examples) || !flag(glfw) || !flag(opengl2))
buildable: False
else
build-depends: base, GLFW-b, gl, dear-imgui, managed, text
build-depends: base, GLFW-b, gl, dear-imgui, managed
executable readme
import: common, exe-flags
@ -372,15 +334,7 @@ executable image
main-is: Image.hs
hs-source-dirs: examples/sdl
build-depends: sdl2, gl, dear-imgui, managed, vector
if (!flag(examples) || !flag(sdl) || !flag(opengl3))
buildable: False
executable sdlrenderer
import: common, exe-flags
main-is: Renderer.hs
hs-source-dirs: examples/sdl
build-depends: sdl2, dear-imgui, managed, text
if (!flag(examples) || !flag(sdl) || !flag(sdl-renderer))
if (!flag(examples) || !flag(sdl) || !flag(opengl2))
buildable: False
executable vulkan
@ -395,29 +349,28 @@ executable vulkan
build-depends:
dear-imgui
, bytestring
>= 0.10.10.0 && < 0.13
>= 0.10.10.0 && < 0.12
, containers
>= 0.6.2.1 && < 0.7
^>= 0.6.2.1
, logging-effect
>= 1.3.12 && < 1.5
^>= 1.3.12
, resourcet
>= 1.2.4.2 && < 1.3
^>= 1.2.4.2
, sdl2
>= 2.5.3.0 && < 2.6
, text
>= 1.2.4 && < 2.1
^>= 2.5.3.0
, text-short
^>= 0.1.3
, transformers
>= 0.5.6 && < 0.7
^>= 0.5.6.2
, unliftio
>= 0.2.13 && < 0.3
>= 0.2.13 && < 0.2.19
, unliftio-core
>= 0.2.0.1 && < 0.3
^>= 0.2.0.1
, vector
>= 0.12.1.2 && < 0.14
^>= 0.12.1.2
, vulkan
>= 3.12
^>= 3.9
, vulkan-utils
>= 0.5
^>= 0.4.1
, VulkanMemoryAllocator
>= 0.7.1
, JuicyPixels

View File

@ -1,30 +1,29 @@
-- NOTE: If this is file is edited, please also copy and paste it into
-- README.md.
{-# language BlockArguments #-}
{-# language LambdaCase #-}
{-# language OverloadedStrings #-}
module Main ( main ) where
import Control.Exception
import Control.Monad.IO.Class
import Control.Monad.Managed
import DearImGui
import DearImGui.OpenGL3
import DearImGui.OpenGL2
import DearImGui.SDL
import DearImGui.SDL.OpenGL
import Graphics.GL
import SDL
import Control.Monad.Managed
import Control.Monad.IO.Class ()
import Control.Monad (when, unless)
import Control.Exception (bracket, bracket_)
main :: IO ()
main = do
-- Initialize SDL
initializeAll
runManaged $ do
-- Create a window using SDL; as we're using OpenGL, we enable OpenGL too
runManaged do
-- Create a window using SDL. As we're using OpenGL, we need to enable OpenGL too.
window <- do
let title = "Hello, Dear ImGui!"
let config = defaultWindow { windowGraphicsContext = OpenGLContext defaultOpenGL }
@ -32,56 +31,61 @@ main = do
-- Create an OpenGL context
glContext <- managed $ bracket (glCreateContext window) glDeleteContext
-- Create an ImGui context
_ <- managed $ bracket createContext destroyContext
-- Initialize ImGui's SDL2 backend
managed_ $ bracket_ (sdl2InitForOpenGL window glContext) sdl2Shutdown
_ <- managed_ $ bracket_ (sdl2InitForOpenGL window glContext) sdl2Shutdown
-- Initialize ImGui's OpenGL backend
managed_ $ bracket_ openGL3Init openGL3Shutdown
_ <- managed_ $ bracket_ openGL2Init openGL2Shutdown
liftIO $ mainLoop window
mainLoop :: Window -> IO ()
mainLoop window = unlessQuit $ do
mainLoop window = unlessQuit do
-- Tell ImGui we're starting a new frame
openGL3NewFrame
openGL2NewFrame
sdl2NewFrame
newFrame
-- Build the GUI
withWindowOpen "Hello, ImGui!" $ do
withWindowOpen "Hello, ImGui!" do
-- Add a text widget
text "Hello, ImGui!"
-- Add a button widget, and call 'putStrLn' when it's clicked
button "Clickety Click" >>= \clicked ->
when clicked $ putStrLn "Ow!"
button "Clickety Click" >>= \case
False -> return ()
True -> putStrLn "Ow!"
-- Show the ImGui demo window
showDemoWindow
-- Render
glClear GL_COLOR_BUFFER_BIT
render
openGL3RenderDrawData =<< getDrawData
openGL2RenderDrawData =<< getDrawData
glSwapWindow window
mainLoop window
where
-- Process the event loop
unlessQuit action = do
shouldQuit <- gotQuitEvent
unless shouldQuit action
shouldQuit <- checkEvents
if shouldQuit then pure () else action
gotQuitEvent = do
ev <- pollEventWithImGui
case ev of
checkEvents = do
pollEventWithImGui >>= \case
Nothing ->
return False
Just event ->
(isQuit event ||) <$> gotQuitEvent
(isQuit event ||) <$> checkEvents
isQuit event =
eventPayload event == QuitEvent
SDL.eventPayload event == SDL.QuitEvent

View File

@ -1,7 +1,6 @@
{-# language BlockArguments #-}
{-# language LambdaCase #-}
{-# language OverloadedStrings #-}
{-# language RecordWildCards #-}
module Main ( main ) where
@ -9,12 +8,6 @@ import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Managed
import Data.Bits ((.|.))
import Data.IORef
import Data.List (sortBy)
import Data.Foldable (traverse_)
import Data.Text (Text, pack)
import DearImGui
import DearImGui.OpenGL2
import DearImGui.GLFW
@ -47,23 +40,14 @@ main = do
-- Initialize ImGui's OpenGL backend
_ <- managed_ $ bracket_ openGL2Init openGL2Shutdown
tableRef <- liftIO $ newIORef
[ (1, "foo")
, (2, "bar")
, (3, "baz")
, (10, "spam")
, (11, "spam")
, (12, "spam")
]
liftIO $ mainLoop win tableRef
liftIO $ mainLoop win
Nothing -> do
error "GLFW createWindow failed"
GLFW.terminate
mainLoop :: Window -> IORef [(Integer, Text)] -> IO ()
mainLoop win tableRef = do
mainLoop :: Window -> IO ()
mainLoop win = do
-- Process the event loop
GLFW.pollEvents
close <- GLFW.windowShouldClose win
@ -80,18 +64,12 @@ mainLoop win tableRef = do
text "Hello, ImGui!"
-- Add a button widget, and call 'putStrLn' when it's clicked
clicking <- button "Clickety Click"
when clicking $
putStrLn "Ow!"
itemContextPopup do
text "pop!"
button "ok" >>= \clicked ->
when clicked $
closeCurrentPopup
button "Clickety Click" >>= \case
False -> return ()
True -> putStrLn "Ow!"
newLine
mkTable tableRef
-- Show the ImGui demo window
showDemoWindow
-- Render
glClear GL_COLOR_BUFFER_BIT
@ -101,41 +79,4 @@ mainLoop win tableRef = do
GLFW.swapBuffers win
mainLoop win tableRef
mkTable :: IORef [(Integer, Text)] -> IO ()
mkTable tableRef =
withTableOpen sortable "MyTable" 3 $ do
tableSetupColumn "Hello"
tableSetupColumnWith defTableColumnOptions "World"
withSortableTable \isDirty sortSpecs ->
when (isDirty && not (null sortSpecs)) do
-- XXX: do your sorting & cache it. Dont sort every frame.
putStrLn "So dirty!"
print sortSpecs
modifyIORef' tableRef . sortBy $
foldMap mkCompare sortSpecs
tableHeadersRow
readIORef tableRef >>=
traverse_ \(ix, title) -> do
tableNextRow
tableNextColumn $ text (pack $ show ix)
tableNextColumn $ text title
tableNextColumn $ void (button "")
where
mkCompare TableSortingSpecs{..} a b =
let
dir = if tableSortingReverse then flip else id
in
case tableSortingColumn of
0 -> dir compare (fst a) (fst b)
1 -> dir compare (snd a) (snd b)
_ -> EQ
sortable = defTableOptions
{ tableFlags =
ImGuiTableFlags_Sortable .|.
ImGuiTableFlags_SortMulti
}
mainLoop win

View File

@ -1,146 +0,0 @@
{-# language BlockArguments #-}
{-# language LambdaCase #-}
{-# language OverloadedStrings #-}
-- | Port of [example_sdl2_sdlrenderer2](https://github.com/ocornut/imgui/blob/54c1bdecebf3c9bb9259c07c5f5666bb4bd5c3ea/examples/example_sdl2_sdlrenderer2/main.cpp).
--
-- Minor differences:
-- - No changing of the clear color via @ImGui::ColorEdit3@ as a Haskell binding
-- doesn't yet exist for this function.
-- - No high DPI renderer scaling as this seems to be in flux [upstream](https://github.com/ocornut/imgui/issues/6065)
module Main ( main ) where
import Control.Exception (bracket, bracket_)
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.Managed (managed, managed_, runManaged)
import Data.IORef (IORef, newIORef)
import Data.Text (pack)
import DearImGui
import DearImGui.SDL (pollEventWithImGui, sdl2NewFrame, sdl2Shutdown)
import DearImGui.SDL.Renderer
( sdl2InitForSDLRenderer, sdlRendererInit, sdlRendererNewFrame, sdlRendererRenderDrawData
, sdlRendererShutdown
)
import SDL (V4(V4), ($=), ($~), get)
import Text.Printf (printf)
import qualified SDL
main :: IO ()
main = do
-- Initialize SDL2
SDL.initializeAll
runManaged do
-- Create a window using SDL2
window <- do
let title = "ImGui + SDL2 Renderer"
let config = SDL.defaultWindow
{ SDL.windowInitialSize = SDL.V2 1280 720
, SDL.windowResizable = True
, SDL.windowPosition = SDL.Centered
}
managed $ bracket (SDL.createWindow title config) SDL.destroyWindow
-- Create an SDL2 renderer
renderer <- managed do
bracket
(SDL.createRenderer window (-1) SDL.defaultRenderer)
SDL.destroyRenderer
-- Create an ImGui context
_ <- managed $ bracket createContext destroyContext
-- Initialize ImGui's SDL2 backend
_ <- managed_ do
bracket_ (sdl2InitForSDLRenderer window renderer) sdl2Shutdown
-- Initialize ImGui's SDL2 renderer backend
_ <- managed_ $ bracket_ (sdlRendererInit renderer) sdlRendererShutdown
liftIO $ mainLoop renderer
mainLoop :: SDL.Renderer -> IO ()
mainLoop renderer = do
refs <- newRefs
go refs
where
go refs = unlessQuit do
-- Tell ImGui we're starting a new frame
sdlRendererNewFrame
sdl2NewFrame
newFrame
-- Show the ImGui demo window
get (refsShowDemoWindow refs) >>= \case
False -> pure ()
True -> showDemoWindow
withWindowOpen "Hello, world!" do
text "This is some useful text."
_ <- checkbox "Demo Window" $ refsShowDemoWindow refs
_ <- checkbox "Another Window" $ refsShowAnotherWindow refs
_ <- sliderFloat "float" (refsFloat refs) 0 1
button "Button" >>= \case
False -> pure ()
True -> refsCounter refs $~ succ
sameLine
counter <- get $ refsCounter refs
text $ "counter = " <> pack (show counter)
fr <- framerate
text
$ pack
$ printf "Application average %.3f ms/frame (%.1f FPS)" (1000 / fr) fr
get (refsShowAnotherWindow refs) >>= \case
False -> pure ()
True ->
withCloseableWindow "Another Window" (refsShowAnotherWindow refs) do
text "Hello from another window!"
button "Close Me" >>= \case
False -> pure ()
True -> refsShowAnotherWindow refs $= False
-- Render
SDL.rendererDrawColor renderer $= V4 0 0 0 255
SDL.clear renderer
render
sdlRendererRenderDrawData =<< getDrawData
SDL.present renderer
go refs
-- Process the event loop
unlessQuit action = do
shouldQuit <- checkEvents
if shouldQuit then pure () else action
checkEvents = do
pollEventWithImGui >>= \case
Nothing ->
return False
Just event ->
(isQuit event ||) <$> checkEvents
isQuit event =
SDL.eventPayload event == SDL.QuitEvent
data Refs = Refs
{ refsShowDemoWindow :: IORef Bool
, refsShowAnotherWindow :: IORef Bool
, refsFloat :: IORef Float
, refsCounter :: IORef Int
}
newRefs :: IO Refs
newRefs =
Refs
<$> newIORef True
<*> newIORef False
<*> newIORef 0
<*> newIORef 0

View File

@ -44,7 +44,7 @@ import Data.Traversable
import Data.Word
( Word32 )
import Foreign.C.String
( peekCString )
( CString )
import Foreign.C.Types
( CInt )
import Foreign.Ptr
@ -53,6 +53,8 @@ import Foreign.Ptr
-- bytestring
import Data.ByteString
( ByteString )
import qualified Data.ByteString.Short as ShortByteString
( packCString )
-- containers
import qualified Data.Map.Strict as Map
@ -75,13 +77,11 @@ import qualified SDL
import qualified SDL.Raw
import qualified SDL.Video.Vulkan
-- text
import Data.Text
( Text )
import qualified Data.Text as Text
( intercalate, pack, unpack )
import Data.Text.Encoding
( encodeUtf8 )
-- text-short
import Data.Text.Short
( ShortText )
import qualified Data.Text.Short as ShortText
( intercalate, pack, fromShortByteString, toByteString, unpack )
-- transformers
import Control.Monad.IO.Class
@ -118,7 +118,7 @@ import Attachments
--------------------------------------------------------------------------------
type LogMessage = WithSeverity Text
type LogMessage = WithSeverity ShortText
class ( MonadUnliftIO m, MonadResource m, MonadLog LogMessage m ) => MonadVulkan m
instance ( MonadUnliftIO m, MonadResource m, MonadLog LogMessage m ) => MonadVulkan m
@ -127,9 +127,9 @@ instance ( MonadUnliftIO m, MonadResource m, MonadLog LogMessage m ) => MonadVul
logHandler :: MonadIO m => LogMessage -> m ()
logHandler ( WithSeverity sev mess )
= liftIO . putStrLn . Text.unpack $ showSeverity sev <> " " <> mess
= liftIO . putStrLn . ShortText.unpack $ showSeverity sev <> " " <> mess
showSeverity :: Severity -> Text
showSeverity :: Severity -> ShortText
showSeverity Emergency = "! PANIC !"
showSeverity Alert = "! ALERT !"
showSeverity Critical = "! CRIT !"
@ -244,7 +244,7 @@ vulkanInstanceInfo appName = do
case validationLayer of
Nothing -> logInfo "Validation layer unavailable. Is the Vulkan SDK installed?"
Just _ -> logInfo ( "Enabled validation layers " <> Text.pack ( show enabledLayers ) )
Just _ -> logInfo ( "Enabled validation layers " <> ShortText.pack ( show enabledLayers ) )
pure createInfo
@ -305,23 +305,26 @@ initialiseWindow ( WindowInfo { height, width, windowName, mouseMode } ) = do
void ( SDL.setMouseLocationMode mouseMode )
window <- logDebug "Creating SDL window" *> createWindow width height windowName
neededExtensions <- logDebug "Loading needed extensions" *> SDL.Video.Vulkan.vkGetInstanceExtensions window
extensionNames <- traverse ( liftIO . fmap fromString . peekCString ) neededExtensions
logInfo $ "Needed instance extensions are: " <> Text.intercalate ", " extensionNames
pure ( window, map encodeUtf8 extensionNames )
extensionNames <- traverse ( liftIO . peekCString ) neededExtensions
logInfo $ "Needed instance extensions are: " <> ShortText.intercalate ", " extensionNames
pure ( window, map ShortText.toByteString extensionNames )
peekCString :: CString -> IO ShortText
peekCString = fmap ( fromMaybe "???" . ShortText.fromShortByteString ) . ShortByteString.packCString
data WindowInfo
= WindowInfo
{ width :: CInt
, height :: CInt
, windowName :: Text
, windowName :: ShortText
, mouseMode :: SDL.LocationMode
}
createWindow :: MonadVulkan m => CInt -> CInt -> Text -> m SDL.Window
createWindow :: MonadVulkan m => CInt -> CInt -> ShortText -> m SDL.Window
createWindow x y title =
snd <$> ResourceT.allocate
( SDL.createWindow
( fromString ( Text.unpack title ) )
( fromString ( ShortText.unpack title ) )
SDL.defaultWindow
{ SDL.windowGraphicsContext = SDL.VulkanContext
, SDL.windowInitialSize = SDL.V2 x y
@ -371,9 +374,10 @@ chooseSwapchainFormat
case sortOn ( Down . score ) ( Boxed.Vector.toList surfaceFormats ) of
[] -> error "No formats found."
Vulkan.SurfaceFormatKHR{format=Vulkan.FORMAT_UNDEFINED} : _rest ->
pure preferredFormat
best : _rest
( best : _ )
| Vulkan.FORMAT_UNDEFINED <- ( Vulkan.format :: Vulkan.SurfaceFormatKHR -> Vulkan.Format ) best
-> pure preferredFormat
| otherwise
-> pure best
where
@ -401,14 +405,21 @@ createSwapchain physicalDevice device surface surfaceFormat imageUsage imageCoun
surfaceCapabilities <- Vulkan.getPhysicalDeviceSurfaceCapabilitiesKHR physicalDevice ( Vulkan.SurfaceKHR surface )
( _, presentModes ) <- Vulkan.getPhysicalDeviceSurfacePresentModesKHR physicalDevice ( Vulkan.SurfaceKHR surface )
let
presentMode :: Vulkan.PresentModeKHR
presentMode =
Vulkan.PRESENT_MODE_FIFO_KHR -- run at presentation rate
-- Vulkan.PRESENT_MODE_MAILBOX_KHR -- max-FPS alternative for benchmarks, input lag debugging, etc.
presentMode
| Vulkan.PRESENT_MODE_MAILBOX_KHR `elem` presentModes
= Vulkan.PRESENT_MODE_MAILBOX_KHR
| otherwise
= Vulkan.PRESENT_MODE_FIFO_KHR
Vulkan.SurfaceCapabilitiesKHR{currentExtent, currentTransform} = surfaceCapabilities
Vulkan.SurfaceFormatKHR{format=fmt, colorSpace=csp} = surfaceFormat
currentExtent :: Vulkan.Extent2D
currentExtent = ( Vulkan.currentExtent :: Vulkan.SurfaceCapabilitiesKHR -> Vulkan.Extent2D ) surfaceCapabilities
currentTransform :: Vulkan.SurfaceTransformFlagBitsKHR
currentTransform = ( Vulkan.currentTransform :: Vulkan.SurfaceCapabilitiesKHR -> Vulkan.SurfaceTransformFlagBitsKHR ) surfaceCapabilities
swapchainCreateInfo :: Vulkan.SwapchainCreateInfoKHR '[]
swapchainCreateInfo =
@ -417,8 +428,8 @@ createSwapchain physicalDevice device surface surfaceFormat imageUsage imageCoun
, Vulkan.flags = Vulkan.zero
, Vulkan.surface = Vulkan.SurfaceKHR surface
, Vulkan.minImageCount = imageCount
, Vulkan.imageFormat = fmt
, Vulkan.imageColorSpace = csp
, Vulkan.imageFormat = ( Vulkan.format :: Vulkan.SurfaceFormatKHR -> Vulkan.Format ) surfaceFormat
, Vulkan.imageColorSpace = ( Vulkan.colorSpace :: Vulkan.SurfaceFormatKHR -> Vulkan.ColorSpaceKHR ) surfaceFormat
, Vulkan.imageExtent = currentExtent
, Vulkan.imageArrayLayers = 1
, Vulkan.imageUsage = imageUsage
@ -580,7 +591,7 @@ createFramebuffer
-> Vulkan.Extent2D
-> f Vulkan.ImageView
-> m ( ResourceT.ReleaseKey, Vulkan.Framebuffer )
createFramebuffer dev renderPass Vulkan.Extent2D{width, height} attachments = Vulkan.withFramebuffer dev createInfo Nothing ResourceT.allocate
createFramebuffer dev renderPass extent attachments = Vulkan.withFramebuffer dev createInfo Nothing ResourceT.allocate
where
createInfo :: Vulkan.FramebufferCreateInfo '[]
createInfo =
@ -589,8 +600,8 @@ createFramebuffer dev renderPass Vulkan.Extent2D{width, height} attachments = Vu
, Vulkan.flags = Vulkan.zero
, Vulkan.renderPass = renderPass
, Vulkan.attachments = Boxed.Vector.fromList . toList $ attachments
, Vulkan.width = width
, Vulkan.height = height
, Vulkan.width = ( Vulkan.width :: Vulkan.Extent2D -> Word32 ) extent
, Vulkan.height = ( Vulkan.height :: Vulkan.Extent2D -> Word32 ) extent
, Vulkan.layers = 1
}

View File

@ -201,7 +201,9 @@ app = do
surfaceCapabilities <- Vulkan.getPhysicalDeviceSurfaceCapabilitiesKHR physicalDevice ( Vulkan.SurfaceKHR surface )
let
Vulkan.SurfaceCapabilitiesKHR{minImageCount, maxImageCount} = surfaceCapabilities
minImageCount, maxImageCount, imageCount :: Word32
minImageCount = ( Vulkan.minImageCount :: Vulkan.SurfaceCapabilitiesKHR -> Word32 ) surfaceCapabilities
maxImageCount = ( Vulkan.maxImageCount :: Vulkan.SurfaceCapabilitiesKHR -> Word32 ) surfaceCapabilities
imageCount
| maxImageCount == 0 = minImageCount + 1
| otherwise = ( minImageCount + 1 ) `min` maxImageCount
@ -211,30 +213,31 @@ app = do
swapchainResources :: Maybe SwapchainResources -> m ( m (), SwapchainResources )
swapchainResources mbOldResources = do
( colFmt, surfaceFormat, imGuiRenderPass ) <- case mbOldResources of
( surfaceFormat, imGuiRenderPass ) <- case mbOldResources of
Nothing -> do
logDebug "Choosing swapchain format & color space"
surfaceFormat <- chooseSwapchainFormat preferredFormat physicalDevice surface
let Vulkan.SurfaceFormatKHR{format=colFmt} = surfaceFormat
let
colFmt :: Vulkan.Format
colFmt = ( Vulkan.format :: Vulkan.SurfaceFormatKHR -> Vulkan.Format ) surfaceFormat
logDebug "Creating Dear ImGui render pass"
( _, imGuiRenderPass ) <-
simpleRenderPass device
( noAttachments
{ colorAttachments = Boxed.Vector.singleton $ presentableColorAttachmentDescription colFmt }
)
pure ( colFmt, surfaceFormat, imGuiRenderPass )
Just oldResources -> do
let surFmt = surfaceFormat oldResources
let Vulkan.SurfaceFormatKHR{format=colFmt} = surFmt
pure ( colFmt, surFmt, imGuiRenderPass oldResources )
pure ( surfaceFormat, imGuiRenderPass )
Just oldResources -> pure ( surfaceFormat oldResources, imGuiRenderPass oldResources )
let
colFmt :: Vulkan.Format
colFmt = ( Vulkan.format :: Vulkan.SurfaceFormatKHR -> Vulkan.Format ) surfaceFormat
logDebug "Creating swapchain"
( swapchainKey, swapchain, swapchainExtent ) <-
createSwapchain
physicalDevice
device
surface
surfaceFormat
physicalDevice device
surface surfaceFormat
surfaceUsage
imageCount
( swapchain <$> mbOldResources )

View File

@ -24,10 +24,6 @@ import Data.Traversable
( for )
import Foreign.Storable
( Storable )
#if MIN_VERSION_template_haskell(2,18,0)
import Data.Coerce
( coerce )
#endif
-- containers
import Data.Map.Strict
@ -175,7 +171,7 @@ declareEnumeration finiteEnumName countName ( Enumeration {..} ) = do
else
\ nm args dir pat ->
TH.patSynD_doc nm args dir pat
( Just $ Text.unpack _patDoc ) []
( Just $ Text.unpack patDoc ) []
)
#else
TH.patSynD

View File

@ -60,7 +60,7 @@ import Data.Text
( Text )
import qualified Data.Text as Text
( all, any, breakOn, drop, dropWhile, dropWhileEnd
, length, stripPrefix, unlines, unpack, pack
, length, stripPrefix, unlines, unpack
)
-- transformers
@ -81,8 +81,6 @@ import DearImGui.Generator.Tokeniser
import DearImGui.Generator.Types
( Comment(..), Enumeration(..), Headers(..) )
import qualified Text.Show as Text
--------------------------------------------------------------------------------
-- Parse error type.
@ -92,9 +90,7 @@ data CustomParseError
, problems :: ![Text]
}
| MissingForwardDeclaration
{ enumName :: !Text
, library :: HashMap Text ( TH.Name, Comment )
}
{ enumName :: !Text }
| UnexpectedSection
{ sectionName :: !Text
, problem :: ![Text]
@ -105,9 +101,8 @@ instance ShowErrorComponent CustomParseError where
showErrorComponent ( Couldn'tLookupEnumValues { enumName, problems } ) = Text.unpack $
"Couldn't lookup the following values in enum " <> enumName <> ":\n"
<> Text.unlines ( map ( " - " <> ) problems )
showErrorComponent ( MissingForwardDeclaration { enumName, library } ) = Text.unpack $
"Missing forward declaration for enum named " <> enumName <> "\n"
<> "In Library: " <> Text.pack ( Text.show library)
showErrorComponent ( MissingForwardDeclaration { enumName } ) = Text.unpack $
"Missing forward declaration for enum named " <> enumName
showErrorComponent ( UnexpectedSection { sectionName, problem } ) = Text.unpack $
"Unexpected section name.\n\
\Expected: " <> sectionName <> "\n\
@ -129,7 +124,6 @@ headers = do
( _defines, basicEnums ) <- partitionEithers <$>
manyTill
( ( Left <$> try ignoreDefine )
<|> ( Left <$> try cppConditional )
<|> ( Right <$> enumeration enumNamesAndTypes )
)
( namedSection "Helpers: Memory allocations macros, ImVector<>" )
@ -140,7 +134,7 @@ headers = do
_ <- skipManyTill anySingle ( namedSection "Misc data structures" )
_ <- skipManyTill anySingle ( namedSection "Helpers (ImGuiOnceUponAFrame, ImGuiTextFilter, ImGuiTextBuffer, ImGuiStorage, ImGuiListClipper, Math Operators, ImColor)" )
_ <- skipManyTill anySingle ( namedSection "Helpers (ImGuiOnceUponAFrame, ImGuiTextFilter, ImGuiTextBuffer, ImGuiStorage, ImGuiListClipper, ImColor)" )
_ <- skipManyTill anySingle ( namedSection "Drawing API (ImDrawCmd, ImDrawIdx, ImDrawVert, ImDrawChannel, ImDrawListSplitter, ImDrawListFlags, ImDrawList, ImDrawData)" )
skipManyTill anySingle ( try . lookAhead $ many comment *> keyword "enum" )
@ -177,24 +171,14 @@ forwardDeclarations = do
pure ( structName, doc )
_ <- many comment
enums <- many do
keyword "enum"
enumName <- identifier
symbol ":"
ty <- cTypeName
reservedSymbol ';'
doc <- commentText <$> comment
pure ( enumName, ( ty, CommentText <$> Text.drop 2 . snd $ Text.breakOn "//" doc ) )
_ <- many comment
typedefs <- many do
keyword "typedef"
ty <- cTypeName
enumName <- identifier
reservedSymbol ';'
doc <- commentText <$> comment
_ <- many comment
pure ( enumName, ( ty, CommentText <$> Text.drop 2 . snd $ Text.breakOn "//" doc ) )
-- Stopping after simple structs and enums for now.
pure ( HashMap.fromList structs, HashMap.fromList (enums <> typedefs) )
pure ( HashMap.fromList structs, HashMap.fromList enums )
cTypeName :: MonadParsec e [Tok] m => m TH.Name
cTypeName = keyword "int" $> ''CInt
@ -216,7 +200,6 @@ enumeration enumNamesAndTypes = do
keyword "enum"
pure inlineDocs
fullEnumName <- identifier
_ <- try $ (symbol ":" >> cTypeName >> pure ()) <|> pure ()
let
enumName :: Text
enumName = Text.dropWhileEnd ( == '_' ) fullEnumName
@ -224,7 +207,7 @@ enumeration enumNamesAndTypes = do
enumTypeName = ()
( underlyingType, forwardDoc ) <- case HashMap.lookup enumName enumNamesAndTypes of
Just res -> pure res
Nothing -> customFailure ( MissingForwardDeclaration { enumName, library=enumNamesAndTypes } )
Nothing -> customFailure ( MissingForwardDeclaration { enumName } )
let
docs :: [Comment]
docs = forwardDoc : CommentText "" : inlineDocs

2
imgui

@ -1 +1 @@
Subproject commit c6e0284ac58b3f205c95365478888f7b53b077e2
Subproject commit c71a50deb5ddf1ea386b91e60fa2e4a26d080074

File diff suppressed because it is too large Load Diff

View File

@ -6,7 +6,7 @@
{-# language PatternSynonyms #-}
{-# language TemplateHaskell #-}
module DearImGui.Raw.Context where
module DearImGui.Context where
-- containers
import qualified Data.Map.Strict as Map
@ -34,7 +34,6 @@ imguiContext = mempty
, ( TypeName "ImVec3", [t| ImVec3 |] )
, ( TypeName "ImVec4", [t| ImVec4 |] )
, ( TypeName "ImU32", [t| ImU32 |] )
, ( TypeName "ImGuiID", [t| ImGuiID |] )
, ( TypeName "ImWchar", [t| ImWchar |] )
, ( TypeName "ImDrawList", [t| ImDrawList |] )
, ( TypeName "ImGuiContext", [t| ImGuiContext |] )
@ -42,6 +41,5 @@ imguiContext = mempty
, ( TypeName "ImFontConfig", [t| ImFontConfig |] )
, ( TypeName "ImFontGlyphRangesBuilder", [t| ImFontGlyphRangesBuilder |] )
, ( TypeName "ImGuiListClipper", [t| ImGuiListClipper |] )
, ( TypeName "ImGuiTableSortSpecs", [t| ImGuiTableSortSpecs |] )
]
}

View File

@ -119,8 +119,6 @@ import DearImGui.Raw.Font.Config (FontConfig(..))
import qualified DearImGui.Raw.Font.Config as FontConfig
import DearImGui.Raw.Font.GlyphRanges (GlyphRanges(..), GlyphRangesBuilder(..))
import qualified DearImGui.Raw.Font.GlyphRanges as GlyphRanges
import DearImGui.Internal.Text (Text)
import qualified DearImGui.Internal.Text as Text
import DearImGui.Structs (ImVec2(..), ImWchar)
@ -334,10 +332,10 @@ addChar char =
GlyphRanges.addChar builder char
-- | UTF-8 string
addText :: Text -> RangesBuilderSetup
addText :: String -> RangesBuilderSetup
addText str =
RangesBuilderSetup \builder ->
Text.withCString str (GlyphRanges.addText builder)
withCString str (GlyphRanges.addText builder)
-- | Existing ranges (as is)
addRangesRaw :: GlyphRanges -> RangesBuilderSetup

View File

@ -1,76 +0,0 @@
{-# LANGUAGE CPP #-}
module DearImGui.Internal.Text
( withCString
, withCStringOrNull
, withCStringLen
, withCStringEnd
, peekCString
, Text
, pack
, unpack
) where
-- base
import Foreign (nullPtr, plusPtr)
import Foreign.C.String (CString)
import qualified GHC.Foreign as Foreign
import System.IO (utf8)
-- text
import Data.Text (Text, pack, unpack)
import Data.Text.Foreign (withCStringLen)
-- unliftio-core
import UnliftIO (MonadUnliftIO, UnliftIO(..), withUnliftIO)
#if MIN_VERSION_text(2,0,1)
-- XXX: just wrap the provided combinator
import qualified Data.Text.Foreign as Text
withCString :: MonadUnliftIO m => Text -> (CString -> m a) -> m a
withCString text action =
withUnliftIO $ \(UnliftIO unlift) ->
Text.withCString text $ \buf ->
unlift $ action buf
#elif MIN_VERSION_text(2,0,0)
-- XXX: the text is UTF-8, alas no withCString is available
import Data.Text.Foreign (lengthWord8, unsafeCopyToPtr)
import Data.Word (Word8)
import Foreign (allocaBytes, castPtr, pokeByteOff)
withCString :: MonadUnliftIO m => Text -> (CString -> m a) -> m a
withCString t@(Text _arr _off len) action =
withUnliftIO $ \(UnliftIO unlift) ->
allocaBytes (len + 1) $ \buf -> do
unsafeCopyToPtr t buf
pokeByteOff buf len (0 :: Word8)
unlift $ action (castPtr buf)
#else
-- XXX: the text is UTF-16, let GHC do it
withCString :: MonadUnliftIO m => Text -> (CString -> m a) -> m a
withCString t action = do
withUnliftIO $ \(UnliftIO unlift) ->
Foreign.withCString utf8 (unpack t) $ \textPtr ->
unlift $ action textPtr
#endif
peekCString :: CString -> IO Text
peekCString = fmap pack . Foreign.peekCString utf8
withCStringOrNull :: Maybe Text -> (CString -> IO a) -> IO a
withCStringOrNull Nothing k = k nullPtr
withCStringOrNull (Just s) k = withCString s k
withCStringEnd :: MonadUnliftIO m => Text -> (CString -> CString -> m a) -> m a
withCStringEnd t action =
withUnliftIO $ \(UnliftIO unlift) ->
withCStringLen t $ \(textPtr, size) ->
unlift $ action textPtr (textPtr `plusPtr` size)

View File

@ -6,7 +6,6 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
@ -65,8 +64,6 @@ module DearImGui.Raw
, setNextWindowSizeConstraints
, setNextWindowCollapsed
, setNextWindowBgAlpha
, beginDisabled
, endDisabled
-- ** Child Windows
, beginChild
@ -92,7 +89,6 @@ module DearImGui.Raw
, popItemWidth
, beginGroup
, endGroup
, getCursorPos
, setCursorPos
, getCursorScreenPos
, alignTextToFramePadding
@ -161,34 +157,10 @@ module DearImGui.Raw
, colorPicker3
, colorButton
-- * Tables
, beginTable
, endTable
, tableNextRow
, tableNextColumn
, tableSetColumnIndex
, tableSetupColumn
, tableSetupScrollFreeze
, tableHeadersRow
, tableHeader
, tableGetSortSpecs
, tableClearSortSpecsDirty
, tableGetColumnCount
, tableGetColumnIndex
, tableGetRowIndex
, tableGetColumnName
, tableGetColumnFlags
, tableSetColumnEnabled
, tableSetBgColor
-- * Trees
, treeNode
, treePush
, treePop
, setNextItemOpen
-- ** Selectables
, selectable
@ -197,7 +169,6 @@ module DearImGui.Raw
, listBox
-- * Data Plotting
, plotLines
, plotHistogram
-- ** Menus
@ -226,12 +197,7 @@ module DearImGui.Raw
, beginPopupModal
, endPopup
, openPopup
, openPopupOnItemClick
, closeCurrentPopup
, beginPopupContextItem
, beginPopupContextWindow
, beginPopupContextVoid
, isPopupOpen
-- * ID stack/scopes
, pushIDInt
@ -251,7 +217,6 @@ module DearImGui.Raw
, getBackgroundDrawList
, getForegroundDrawList
, imCol32
, framerate
-- * Types
, module DearImGui.Enums
@ -268,7 +233,7 @@ import System.IO.Unsafe
( unsafePerformIO )
-- dear-imgui
import DearImGui.Raw.Context
import DearImGui.Context
( imguiContext )
import DearImGui.Enums
import DearImGui.Structs
@ -697,27 +662,27 @@ combo labelPtr iPtr itemsPtr itemsLen = liftIO do
-- | Wraps @ImGui::DragFloat()@
dragFloat :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CFloat -> CString -> m Bool
dragFloat descPtr floatPtr speed minValue maxValue formatPtr = liftIO do
(0 /=) <$> [C.exp| bool { DragFloat( $(char* descPtr), $(float* floatPtr), $(float speed), $(float minValue), $(float maxValue), $(char* formatPtr)) } |]
dragFloat :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CFloat -> m Bool
dragFloat descPtr floatPtr speed minValue maxValue = liftIO do
(0 /=) <$> [C.exp| bool { DragFloat( $(char* descPtr), $(float* floatPtr), $(float speed), $(float minValue), $(float maxValue)) } |]
-- | Wraps @ImGui::DragFloat2()@
dragFloat2 :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CFloat -> CString -> m Bool
dragFloat2 descPtr floatPtr speed minValue maxValue formatPtr = liftIO do
(0 /=) <$> [C.exp| bool { DragFloat2( $(char* descPtr), $(float* floatPtr), $(float speed), $(float minValue), $(float maxValue), $(char* formatPtr)) } |]
dragFloat2 :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CFloat -> m Bool
dragFloat2 descPtr floatPtr speed minValue maxValue = liftIO do
(0 /=) <$> [C.exp| bool { DragFloat2( $(char* descPtr), $(float* floatPtr), $(float speed), $(float minValue), $(float maxValue)) } |]
-- | Wraps @ImGui::DragFloat3()@
dragFloat3 :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CFloat -> CString -> m Bool
dragFloat3 descPtr floatPtr speed minValue maxValue formatPtr = liftIO do
(0 /=) <$> [C.exp| bool { DragFloat3( $(char* descPtr), $(float* floatPtr), $(float speed), $(float minValue), $(float maxValue), $(char* formatPtr)) } |]
dragFloat3 :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CFloat -> m Bool
dragFloat3 descPtr floatPtr speed minValue maxValue = liftIO do
(0 /=) <$> [C.exp| bool { DragFloat3( $(char* descPtr), $(float* floatPtr), $(float speed), $(float minValue), $(float maxValue)) } |]
-- | Wraps @ImGui::DragFloat4()@
dragFloat4 :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CFloat -> CString -> m Bool
dragFloat4 descPtr floatPtr speed minValue maxValue formatPtr = liftIO do
(0 /=) <$> [C.exp| bool { DragFloat4( $(char* descPtr), $(float* floatPtr), $(float speed), $(float minValue), $(float maxValue), $(char* formatPtr)) } |]
dragFloat4 :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CFloat -> m Bool
dragFloat4 descPtr floatPtr speed minValue maxValue = liftIO do
(0 /=) <$> [C.exp| bool { DragFloat4( $(char* descPtr), $(float* floatPtr), $(float speed), $(float minValue), $(float maxValue)) } |]
-- | Wraps @ImGui::DragFloatRange2()@
@ -857,27 +822,27 @@ dragScalarN labelPtr dataType dataPtr components vSpeed minPtr maxPtr formatPtr
maxPtr_ = castPtr maxPtr
-- | Wraps @ImGui::SliderFloat()@
sliderFloat :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CString -> m Bool
sliderFloat descPtr floatPtr minValue maxValue formatPtr = liftIO do
(0 /=) <$> [C.exp| bool { SliderFloat( $(char* descPtr), $(float* floatPtr), $(float minValue), $(float maxValue), $(char* formatPtr)) } |]
sliderFloat :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> m Bool
sliderFloat descPtr floatPtr minValue maxValue = liftIO do
(0 /=) <$> [C.exp| bool { SliderFloat( $(char* descPtr), $(float* floatPtr), $(float minValue), $(float maxValue)) } |]
-- | Wraps @ImGui::SliderFloat2()@
sliderFloat2 :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CString -> m Bool
sliderFloat2 descPtr floatPtr minValue maxValue formatPtr = liftIO do
(0 /=) <$> [C.exp| bool { SliderFloat2( $(char* descPtr), $(float* floatPtr), $(float minValue), $(float maxValue), $(char* formatPtr)) } |]
sliderFloat2 :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> m Bool
sliderFloat2 descPtr floatPtr minValue maxValue = liftIO do
(0 /=) <$> [C.exp| bool { SliderFloat2( $(char* descPtr), $(float* floatPtr), $(float minValue), $(float maxValue)) } |]
-- | Wraps @ImGui::SliderFloat3()@
sliderFloat3 :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CString -> m Bool
sliderFloat3 descPtr floatPtr minValue maxValue formatPtr = liftIO do
(0 /=) <$> [C.exp| bool { SliderFloat3( $(char* descPtr), $(float* floatPtr), $(float minValue), $(float maxValue), $(char* formatPtr)) } |]
sliderFloat3 :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> m Bool
sliderFloat3 descPtr floatPtr minValue maxValue = liftIO do
(0 /=) <$> [C.exp| bool { SliderFloat3( $(char* descPtr), $(float* floatPtr), $(float minValue), $(float maxValue)) } |]
-- | Wraps @ImGui::SliderFloat4()@
sliderFloat4 :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CString -> m Bool
sliderFloat4 descPtr floatPtr minValue maxValue formatPtr = liftIO do
(0 /=) <$> [C.exp| bool { SliderFloat4( $(char* descPtr), $(float* floatPtr), $(float minValue), $(float maxValue), $(char* formatPtr)) } |]
sliderFloat4 :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> m Bool
sliderFloat4 descPtr floatPtr minValue maxValue = liftIO do
(0 /=) <$> [C.exp| bool { SliderFloat4( $(char* descPtr), $(float* floatPtr), $(float minValue), $(float maxValue)) } |]
-- | Wraps @ImGui::SliderAngle()@
sliderAngle :: (MonadIO m) => CString -> Ptr CFloat -> CFloat -> CFloat -> CString -> ImGuiSliderFlags -> m Bool
@ -1098,128 +1063,6 @@ colorButton descPtr refPtr = liftIO do
(0 /=) <$> [C.exp| bool { ColorButton( $(char* descPtr), *$(ImVec4* refPtr) ) } |]
-- | Wraps @ImGui::BeginTable()@.
beginTable :: MonadIO m => CString -> CInt -> ImGuiTableFlags -> Ptr ImVec2 -> CFloat -> m Bool
beginTable labelPtr column flags outerSizePtr innerWidth = liftIO do
(0 /=) <$> [C.exp| bool { BeginTable($(char* labelPtr), $(int column), $(ImGuiTableFlags flags), *$(ImVec2* outerSizePtr), $(float innerWidth)) } |]
-- | Only call 'endTable' if 'beginTable' returns true!
--
-- Wraps @ImGui::EndTable()@.
endTable :: MonadIO m => m ()
endTable = liftIO do
[C.exp| void { EndTable() } |]
-- | Wraps @ImGui::TableNextRow()@.
-- append into the first cell of a new row.
tableNextRow :: MonadIO m => ImGuiTableRowFlags -> CFloat -> m ()
tableNextRow flags minRowHeight = liftIO do
[C.exp| void { TableNextRow($(ImGuiTableRowFlags flags), $(float minRowHeight)) } |]
-- | Wraps @ImGui::TableNextColumn()@.
-- append into the next column (or first column of next row if currently in
-- last column). Return true when column is visible.
tableNextColumn :: MonadIO m => m Bool
tableNextColumn = liftIO do
(0 /=) <$> [C.exp| bool { TableNextColumn() } |]
-- | Wraps @ImGui::TableSetColumnIndex()@.
-- append into the specified column. Return true when column is visible.
tableSetColumnIndex :: MonadIO m => CInt -> m Bool
tableSetColumnIndex column= liftIO do
(0 /=) <$> [C.exp| bool { TableSetColumnIndex($(int column)) } |]
-- | Wraps @ImGui::TableSetupColumn()@.
tableSetupColumn :: MonadIO m => CString -> ImGuiTableColumnFlags -> CFloat -> ImGuiID-> m ()
tableSetupColumn labelPtr flags initWidthOrWeight userId = liftIO do
[C.exp| void { TableSetupColumn($(char* labelPtr), $(ImGuiTableColumnFlags flags), $(float initWidthOrWeight), $(ImGuiID userId)) } |]
-- | Wraps @ImGui::TableSetupScrollFreeze()@.
tableSetupScrollFreeze :: MonadIO m => CInt -> CInt -> m ()
tableSetupScrollFreeze cols rows = liftIO do
[C.exp| void { TableSetupScrollFreeze($(int cols), $(int rows)) } |]
-- | Wraps @ImGui::TableHeadersRow()@.
-- submit all headers cells based on data provided to 'tableSetupColumn'
-- + submit context menu
tableHeadersRow :: MonadIO m => m ()
tableHeadersRow = liftIO do
[C.exp| void { TableHeadersRow() } |]
-- | Wraps @ImGui::TableHeader()@.
-- submit one header cell manually (rarely used)
tableHeader :: MonadIO m => CString -> m ()
tableHeader labelPtr = liftIO do
[C.exp| void { TableHeader($(char* labelPtr)) } |]
-- | Wraps @ImGui::TableGetSortSpecs()@.
-- Low-level-Function. Better use the wrapper that outomatically conform
-- to the things described below
--
-- Tables: Sorting
-- - Call TableGetSortSpecs() to retrieve latest sort specs for the table.
-- NULL when not sorting.
-- - When 'SpecsDirty == true' you should sort your data. It will be true when
-- sorting specs have changed since last call, or the first time. Make sure
-- to set 'SpecsDirty = false' after sorting, else you may wastefully sort
-- your data every frame!
-- - Lifetime: don't hold on this pointer over multiple frames or past any
-- subsequent call to BeginTable().
tableGetSortSpecs :: MonadIO m => m (Maybe (Ptr ImGuiTableSortSpecs))
tableGetSortSpecs = liftIO do
ptr <- [C.exp| ImGuiTableSortSpecs* { TableGetSortSpecs() } |]
if ptr == nullPtr then
return Nothing
else
return $ Just ptr
tableClearSortSpecsDirty :: MonadIO m => Ptr ImGuiTableSortSpecs -> m ()
tableClearSortSpecsDirty specsPtr = liftIO do
[C.block| void {
$(ImGuiTableSortSpecs* specsPtr)->SpecsDirty = false;
} |]
-- | Wraps @ImGui::TableGetColumnCount()@.
tableGetColumnCount :: MonadIO m => m CInt
tableGetColumnCount = liftIO do
[C.exp| int { TableGetColumnCount() } |]
-- | Wraps @ImGui::TableGetColumnIndex()@.
tableGetColumnIndex :: MonadIO m => m CInt
tableGetColumnIndex = liftIO do
[C.exp| int { TableGetColumnIndex() } |]
-- | Wraps @ImGui::TableGetRowIndex()@.
tableGetRowIndex :: MonadIO m => m CInt
tableGetRowIndex = liftIO do
[C.exp| int { TableGetRowIndex() } |]
-- | Wraps @ImGui::TableGetColumnName
-- 'Nothing' returns the current column name
tableGetColumnName :: MonadIO m => Maybe CInt -> m CString
tableGetColumnName Nothing = tableGetColumnName (Just (-1))
tableGetColumnName (Just column_n) = liftIO do
[C.exp| const char* { TableGetColumnName($(int column_n)) } |]
-- | Wraps @ImGui::TableGetRowIndex()@.
-- 'Nothing' returns the current column flags
tableGetColumnFlags :: MonadIO m => Maybe CInt -> m ImGuiTableColumnFlags
tableGetColumnFlags Nothing = tableGetColumnFlags (Just (-1))
tableGetColumnFlags (Just column_n) = liftIO do
[C.exp| ImGuiTableColumnFlags { TableGetColumnFlags($(int column_n)) } |]
-- | Wraps @ImGui::TableSetColumnEnabled()@.
tableSetColumnEnabled :: MonadIO m => CInt -> CBool -> m ()
tableSetColumnEnabled column_n v = liftIO do
[C.exp| void { TableSetColumnEnabled($(int column_n), $(bool v)) } |]
-- | Wraps @ImGui::TableSetBgColor()@.
-- 'Nothing' sets the current row/column color
tableSetBgColor :: MonadIO m => ImGuiTableBgTarget -> ImU32 -> Maybe CInt -> m ()
tableSetBgColor target color Nothing = tableSetBgColor target color (Just (-1))
tableSetBgColor target color (Just column_n) = liftIO do
[C.exp| void { TableSetBgColor($(ImGuiTableBgTarget target), $(ImU32 color), $(int column_n)) } |]
-- | Wraps @ImGui::TreeNode()@.
treeNode :: (MonadIO m) => CString -> m Bool
treeNode labelPtr = liftIO do
@ -1238,22 +1081,10 @@ treePop = liftIO do
[C.exp| void { TreePop() } |]
-- | Wraps @ImGui::SetNextItemOpen()@.
setNextItemOpen :: (MonadIO m) => CBool -> m ()
setNextItemOpen is_open = liftIO do
[C.exp| void { SetNextItemOpen($(bool is_open)) } |]
-- -- | Wraps @ImGui::Selectable()@.
-- selectable :: (MonadIO m) => CString -> m Bool
-- selectable labelPtr = liftIO do
-- (0 /=) <$> [C.exp| bool { Selectable($(char* labelPtr)) } |]
-- | Wraps @ImGui::Selectable()@.
selectable :: (MonadIO m) => CString -> CBool -> ImGuiSelectableFlags -> Ptr ImVec2 -> m Bool
selectable labelPtr selected flags size = liftIO do
(0 /=) <$> [C.exp| bool { Selectable($(char* labelPtr), $(bool selected), $(ImGuiSelectableFlags flags), *$(ImVec2 *size)) } |]
selectable :: (MonadIO m) => CString -> m Bool
selectable labelPtr = liftIO do
(0 /=) <$> [C.exp| bool { Selectable($(char* labelPtr)) } |]
-- | Wraps @ImGui::ListBox()@.
@ -1261,10 +1092,6 @@ listBox :: (MonadIO m) => CString -> Ptr CInt -> Ptr CString -> CInt -> m Bool
listBox labelPtr iPtr itemsPtr itemsLen = liftIO do
(0 /=) <$> [C.exp| bool { ListBox($(char* labelPtr), $(int* iPtr), $(char** itemsPtr), $(int itemsLen)) }|]
-- | Wraps @ImGui::PlotLines()@.
plotLines :: (MonadIO m) => CString -> Ptr CFloat -> CInt -> m ()
plotLines labelPtr valuesPtr valuesLen = liftIO do
[C.exp| void { PlotLines($(char* labelPtr), $(float* valuesPtr), $(int valuesLen)) } |]
-- | Wraps @ImGui::PlotHistogram()@.
plotHistogram :: (MonadIO m) => CString -> Ptr CFloat -> CInt -> m ()
@ -1349,9 +1176,9 @@ endTabBar = liftIO do
-- | Create a new tab. Returns @True@ if the tab is selected.
--
-- Wraps @ImGui::BeginTabItem@.
beginTabItem :: (MonadIO m) => CString -> Ptr CBool -> ImGuiTabItemFlags -> m Bool
beginTabItem :: (MonadIO m) => CString -> Ptr CBool -> ImGuiTabBarFlags -> m Bool
beginTabItem namePtr refPtr flags = liftIO do
(0 /=) <$> [C.exp| bool { BeginTabItem($(char* namePtr), $(bool* refPtr), $(ImGuiTabItemFlags flags) ) } |]
(0 /=) <$> [C.exp| bool { BeginTabItem($(char* namePtr), $(bool* refPtr), $(ImGuiTabBarFlags flags) ) } |]
-- | Finish appending elements to a tab. Only call if 'beginTabItem' returns @True@.
@ -1426,16 +1253,6 @@ openPopup popupIdPtr = liftIO do
[C.exp| void { OpenPopup($(char* popupIdPtr)) } |]
-- | Open popup when clicked on last item.
--
-- Note: actually triggers on the mouse _released_ event to be consistent with popup behaviors.
--
-- Wraps @ImGui::OpenPopupOnItemClick()@
openPopupOnItemClick :: (MonadIO m) => CString -> ImGuiPopupFlags-> m ()
openPopupOnItemClick popupIdPtr flags = liftIO do
[C.exp| void { OpenPopupOnItemClick($(char* popupIdPtr), $(ImGuiPopupFlags flags)) } |]
-- | Manually close the popup we have begin-ed into.
--
-- Wraps @ImGui::ClosePopup()@
@ -1443,36 +1260,6 @@ closeCurrentPopup :: (MonadIO m) => m ()
closeCurrentPopup = liftIO do
[C.exp| void { CloseCurrentPopup() } |]
-- | Open+begin popup when clicked on last item.
--
-- Use str_id==NULL to associate the popup to previous item.
--
-- If you want to use that on a non-interactive item such as 'text' you need to pass in an explicit ID here.
beginPopupContextItem :: (MonadIO m) => CString -> ImGuiPopupFlags-> m Bool
beginPopupContextItem popupIdPtr flags = liftIO do
(0 /=) <$> [C.exp| bool { BeginPopupContextItem($(char* popupIdPtr), $(ImGuiPopupFlags flags)) } |]
-- | Open+begin popup when clicked on current window.
beginPopupContextWindow :: (MonadIO m) => CString -> ImGuiPopupFlags-> m Bool
beginPopupContextWindow popupIdPtr flags = liftIO do
(0 /=) <$> [C.exp| bool { BeginPopupContextWindow($(char* popupIdPtr), $(ImGuiPopupFlags flags)) } |]
-- | Open+begin popup when clicked in void (where there are no windows).
beginPopupContextVoid :: (MonadIO m) => CString -> ImGuiPopupFlags-> m Bool
beginPopupContextVoid popupIdPtr flags = liftIO do
(0 /=) <$> [C.exp| bool { BeginPopupContextVoid($(char* popupIdPtr), $(ImGuiPopupFlags flags)) } |]
-- | Query popup status
--
-- - return 'True' if the popup is open at the current 'beginPopup' level of the popup stack.
-- - with 'ImGuiPopupFlags_AnyPopupId': return 'True' if any popup is open at the current 'beginPopup' level of the popup stack.
-- - with 'ImGuiPopupFlags_AnyPopupId' | 'ImGuiPopupFlags_AnyPopupLevel': return 'True' if any popup is open.
--
-- Wraps @ImGui::IsPopupOpen()@
isPopupOpen :: (MonadIO m) => CString -> ImGuiPopupFlags-> m Bool
isPopupOpen popupIdPtr flags = liftIO do
(0 /=) <$> [C.exp| bool { IsPopupOpen($(char* popupIdPtr), $(ImGuiPopupFlags flags)) } |]
-- | Is the last item hovered? (and usable, aka not blocked by a popup, etc.).
--
@ -1584,29 +1371,6 @@ setNextWindowBgAlpha alpha = liftIO do
[C.exp| void { SetNextWindowBgAlpha($(float alpha)) } |]
-- | Begin a block that may be disabled. This disables all user interactions
-- and dims item visuals.
--
-- Always call a matching 'endDisabled' for each 'beginDisabled' call.
--
-- The boolean argument is only intended to facilitate use of boolean
-- expressions. If you can avoid calling @beginDisabled 0@ altogether,
-- that should be preferred.
--
-- Wraps @ImGui::BeginDisabled()@
beginDisabled :: (MonadIO m) => CBool -> m ()
beginDisabled disabled = liftIO do
[C.exp| void { BeginDisabled($(bool disabled)) } |]
-- | Ends a block that may be disabled.
--
-- Wraps @ImGui::EndDisabled()@
endDisabled :: (MonadIO m) => m ()
endDisabled = liftIO do
[C.exp| void { EndDisabled() } |]
-- | undo a sameLine or force a new line when in an horizontal-layout context.
--
-- Wraps @ImGui::NewLine()@
@ -1698,20 +1462,6 @@ setCursorPos :: (MonadIO m) => Ptr ImVec2 -> m ()
setCursorPos posPtr = liftIO do
[C.exp| void { SetCursorPos(*$(ImVec2* posPtr)) } |]
-- | Get cursor position in window-local coordinates.
--
-- Useful to overlap draw using 'setCursorPos'.
--
-- Wraps @ImGui::SetCursorPos()@
getCursorPos :: (MonadIO m) => m ImVec2
getCursorPos = liftIO do
C.withPtr_ \ptr ->
[C.block|
void {
*$(ImVec2 * ptr) = GetCursorPos();
}
|]
-- | Cursor position in absolute coordinates.
--
-- Useful to work with 'DrawList' API.
@ -1805,12 +1555,6 @@ wantCaptureKeyboard :: MonadIO m => m Bool
wantCaptureKeyboard = liftIO do
(0 /=) <$> [C.exp| bool { GetIO().WantCaptureKeyboard } |]
-- | Estimate of application framerate (rolling average over 60 frames), in
-- frame per second. Solely for convenience.
framerate :: MonadIO m => m Float
framerate = liftIO do
realToFrac <$> [C.exp| float { GetIO().Framerate } |]
-- | This draw list will be the first rendering one.
--
-- Useful to quickly draw shapes/text behind dear imgui contents.

View File

@ -115,7 +115,7 @@ import Foreign hiding (new)
import Foreign.C
-- dear-imgui
import DearImGui.Raw.Context
import DearImGui.Context
( imguiContext )
import DearImGui.Enums
import DearImGui.Structs

View File

@ -41,7 +41,7 @@ import Foreign ( Ptr, castPtr )
import Foreign.C
-- dear-imgui
import DearImGui.Raw.Context
import DearImGui.Context
( imguiContext )
import DearImGui.Structs
import DearImGui.Raw.Font.Config

View File

@ -46,7 +46,7 @@ import Foreign ( Ptr )
import Foreign.C
-- dear-imgui
import DearImGui.Raw.Context
import DearImGui.Context
( imguiContext )
import DearImGui.Structs
import DearImGui.Raw.Font.GlyphRanges

View File

@ -75,7 +75,7 @@ import Foreign.C
import System.IO.Unsafe (unsafePerformIO)
-- dear-imgui
import DearImGui.Raw.Context
import DearImGui.Context
( imguiContext )
import DearImGui.Structs

View File

@ -39,7 +39,7 @@ import Foreign.C
)
-- dear-imgui
import DearImGui.Raw.Context
import DearImGui.Context
( imguiContext )
-- import DearImGui.Enums
-- import DearImGui.Structs
@ -120,11 +120,14 @@ setUserData ptr = liftIO do
{- TODO:
bool WantCaptureMouse; // Set when Dear ImGui will use mouse inputs, in this case do not dispatch them to your main game/application (either way, always pass on mouse inputs to imgui). (e.g. unclicked mouse is hovering over an imgui window, widget is active, mouse was clicked over an imgui window, etc.).
bool WantCaptureKeyboard; // Set when Dear ImGui will use keyboard inputs, in this case do not dispatch them to your main game/application (either way, always pass keyboard inputs to imgui). (e.g. InputText active, or an imgui window is focused and navigation is enabled, etc.).
bool WantTextInput; // Mobile/console: when set, you may display an on-screen keyboard. This is set by Dear ImGui when it wants textual keyboard input to happen (e.g. when a InputText widget is active).
bool WantSetMousePos; // MousePos has been altered, backend should reposition mouse on next frame. Rarely used! Set only when ImGuiConfigFlags_NavEnableSetMousePos flag is enabled.
bool WantSaveIniSettings; // When manual .ini load/save is active (io.IniFilename == NULL), this will be set to notify your application that you can call SaveIniSettingsToMemory() and save yourself. Important: clear io.WantSaveIniSettings yourself after saving!
bool NavActive; // Keyboard/Gamepad navigation is currently allowed (will handle ImGuiKey_NavXXX events) = a window is focused and it doesn't use the ImGuiWindowFlags_NoNavInputs flag.
bool NavVisible; // Keyboard/Gamepad navigation is visible and allowed (will handle ImGuiKey_NavXXX events).
float Framerate; // Rough estimate of application framerate, in frame per second. Solely for convenience. Rolling average estimation based on io.DeltaTime over 120 frames.
int MetricsRenderVertices; // Vertices output during last call to Render()
int MetricsRenderIndices; // Indices output during last call to Render() = number of triangles * 3
int MetricsRenderWindows; // Number of visible windows

View File

@ -59,7 +59,7 @@ import Foreign.C
import System.IO.Unsafe (unsafePerformIO)
-- dear-imgui
import DearImGui.Raw.Context
import DearImGui.Context
( imguiContext )
import DearImGui.Structs
( ImGuiListClipper )

View File

@ -21,14 +21,12 @@ module DearImGui.SDL (
, sdl2Shutdown
, pollEventWithImGui
, pollEventsWithImGui
-- *** Raw
, dispatchRawEvent
)
where
-- base
import Control.Monad
( void, when )
( when )
import Foreign.Marshal.Alloc
( alloca )
import Foreign.Ptr
@ -44,7 +42,6 @@ import qualified Language.C.Inline.Cpp as Cpp
import SDL
import SDL.Raw.Enum as Raw
import qualified SDL.Raw.Event as Raw
import qualified SDL.Raw.Types as Raw
-- transformers
import Control.Monad.IO.Class
@ -53,7 +50,7 @@ import Control.Monad.IO.Class
C.context (Cpp.cppCtx <> C.bsCtx)
C.include "imgui.h"
C.include "backends/imgui_impl_sdl2.h"
C.include "backends/imgui_impl_sdl.h"
C.include "SDL.h"
Cpp.using "namespace ImGui"
@ -80,24 +77,11 @@ pollEventWithImGui = liftIO do
nEvents <- Raw.peepEvents evPtr 1 Raw.SDL_PEEKEVENT Raw.SDL_FIRSTEVENT Raw.SDL_LASTEVENT
when (nEvents > 0) do
void $ dispatchRawEvent evPtr
let evPtr' = castPtr evPtr :: Ptr ()
[C.exp| void { ImGui_ImplSDL2_ProcessEvent((SDL_Event*) $(void* evPtr')) } |]
pollEvent
-- | Dispatch a raw 'Raw.Event' value to Dear ImGui.
--
-- You may want this function instead of 'pollEventWithImGui' if you do not use
-- @sdl2@'s higher-level 'Event' type (e.g. your application has its own polling
-- mechanism).
--
-- __It is your application's responsibility to both manage the input__
-- __pointer's memory and to fill the memory location with a raw 'Raw.Event'__
-- __value.__
dispatchRawEvent :: MonadIO m => Ptr Raw.Event -> m Bool
dispatchRawEvent evPtr = liftIO do
let evPtr' = castPtr evPtr :: Ptr ()
(0 /=) <$> [C.exp| bool { ImGui_ImplSDL2_ProcessEvent((const SDL_Event*) $(void* evPtr')) } |]
-- | Like the SDL2 'pollEvents' function, while also dispatching the events to
-- Dear ImGui. See 'pollEventWithImGui'.
pollEventsWithImGui :: MonadIO m => m [Event]

View File

@ -42,7 +42,7 @@ import Control.Monad.IO.Class
C.context (Cpp.cppCtx <> C.bsCtx)
C.include "imgui.h"
C.include "backends/imgui_impl_opengl2.h"
C.include "backends/imgui_impl_sdl2.h"
C.include "backends/imgui_impl_sdl.h"
C.include "SDL.h"
C.include "SDL_opengl.h"
Cpp.using "namespace ImGui"

View File

@ -1,74 +0,0 @@
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-|
Module: DearImGUI.SDL.Renderer
Initialising the SDL2 renderer backend for Dear ImGui.
-}
module DearImGui.SDL.Renderer
( sdl2InitForSDLRenderer
, sdlRendererInit
, sdlRendererShutdown
, sdlRendererNewFrame
, sdlRendererRenderDrawData
)
where
-- inline-c
import qualified Language.C.Inline as C
-- inline-c-cpp
import qualified Language.C.Inline.Cpp as Cpp
-- sdl2
import SDL.Internal.Types
( Renderer(..), Window(..) )
-- transformers
import Control.Monad.IO.Class
( MonadIO, liftIO )
-- DearImGui
import DearImGui
( DrawData(..) )
C.context (Cpp.cppCtx <> C.bsCtx)
C.include "imgui.h"
C.include "backends/imgui_impl_sdlrenderer2.h"
C.include "backends/imgui_impl_sdl2.h"
C.include "SDL.h"
Cpp.using "namespace ImGui"
-- | Wraps @ImGui_ImplSDL2_InitForSDLRenderer@.
sdl2InitForSDLRenderer :: MonadIO m => Window -> Renderer -> m Bool
sdl2InitForSDLRenderer (Window windowPtr) (Renderer renderPtr) = liftIO do
(0 /=) <$> [C.exp| bool { ImGui_ImplSDL2_InitForSDLRenderer((SDL_Window*)$(void* windowPtr), (SDL_Renderer*)$(void* renderPtr)) } |]
-- | Wraps @ImGui_ImplSDLRenderer2_Init@.
sdlRendererInit :: MonadIO m => Renderer -> m Bool
sdlRendererInit (Renderer renderPtr) = liftIO do
(0 /=) <$> [C.exp| bool { ImGui_ImplSDLRenderer2_Init((SDL_Renderer*)$(void* renderPtr)) } |]
-- | Wraps @ImGui_ImplSDLRenderer2_Shutdown@.
sdlRendererShutdown :: MonadIO m => m ()
sdlRendererShutdown = liftIO do
[C.exp| void { ImGui_ImplSDLRenderer2_Shutdown(); } |]
-- | Wraps @ImGui_ImplSDLRenderer2_NewFrame@.
sdlRendererNewFrame :: MonadIO m => m ()
sdlRendererNewFrame = liftIO do
[C.exp| void { ImGui_ImplSDLRenderer2_NewFrame(); } |]
-- | Wraps @ImGui_ImplSDLRenderer2_RenderDrawData@.
sdlRendererRenderDrawData :: MonadIO m => DrawData -> m ()
sdlRendererRenderDrawData (DrawData ptr) = liftIO do
[C.exp| void { ImGui_ImplSDLRenderer2_RenderDrawData((ImDrawData*) $( void* ptr )) } |]

View File

@ -33,7 +33,7 @@ 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_sdl2.h"
C.include "backends/imgui_impl_sdl.h"
C.include "SDL.h"
C.include "SDL_vulkan.h"
Cpp.using "namespace ImGui"

View File

@ -1,6 +1,5 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}
module DearImGui.Structs where
@ -14,12 +13,7 @@ import Data.Word
)
import Foreign
( Storable(..), castPtr, plusPtr, Ptr, Int16, nullPtr )
import Foreign.C
( CInt, CBool )
import DearImGui.Enums
import Data.Bits ((.&.))
( Storable(..), castPtr, plusPtr )
--------------------------------------------------------------------------------
data ImVec2 = ImVec2 { x, y :: {-# unpack #-} !Float }
@ -104,111 +98,12 @@ data ImDrawList
-- | 'DearImGui.Raw.ListClipper.ListClipper' pointer tag.
data ImGuiListClipper
-- | A unique ID used by widgets (typically the result of hashing a stack of string)
-- unsigned Integer (same as ImU32)
type ImGuiID = ImU32
-- | 32-bit unsigned integer (often used to store packed colors).
type ImU32 = Word32
type ImS16 = Int16
-- | Single wide character (used mostly in glyph management)
#ifdef IMGUI_USE_WCHAR32
type ImWchar = Word32
#else
type ImWchar = Word16
#endif
--------------------------------------------------------------------------------
-- | Sorting specifications for a table (often handling sort specs for a single column, occasionally more)
-- Obtained by calling TableGetSortSpecs().
-- When @SpecsDirty == true@ you can sort your data. It will be true with sorting specs have changed since last call, or the first time.
-- Make sure to set @SpecsDirty = false@ after sorting, else you may wastefully sort your data every frame!
data ImGuiTableSortSpecs = ImGuiTableSortSpecs
{ specs :: Ptr ImGuiTableColumnSortSpecs
, specsCount :: CInt
, specsDirty :: CBool
} deriving (Show, Eq)
instance Storable ImGuiTableSortSpecs where
sizeOf _ =
sizeOf (undefined :: Ptr ImGuiTableColumnSortSpecs) +
sizeOf (undefined :: CInt) +
sizeOf (undefined :: CBool)
alignment _ =
alignment nullPtr
poke ptr ImGuiTableSortSpecs{..} = do
let specsPtr = castPtr ptr
poke specsPtr specs
let specsCountPtr = castPtr $ specsPtr `plusPtr` sizeOf specs
poke specsCountPtr specsCount
let specsDirtyPtr = castPtr $ specsCountPtr `plusPtr` sizeOf specsCount
poke specsDirtyPtr specsDirty
peek ptr = do
let specsPtr = castPtr ptr
specs <- peek specsPtr
let specsCountPtr = castPtr $ specsPtr `plusPtr` sizeOf specs
specsCount <- peek specsCountPtr
let specsDirtyPtr = castPtr $ specsCountPtr `plusPtr` sizeOf specsCount
specsDirty <- peek specsDirtyPtr
pure ImGuiTableSortSpecs{..}
-- | Sorting specification for one column of a table
data ImGuiTableColumnSortSpecs = ImGuiTableColumnSortSpecs
{ columnUserID :: ImGuiID -- ^ User id of the column (if specified by a TableSetupColumn() call)
, columnIndex :: ImS16 -- ^ Index of the column
, sortOrder :: ImS16 -- ^ Index within parent ImGuiTableSortSpecs (always stored in order starting from 0, tables sorted on a single criteria will always have a 0 here)
, sortDirection :: ImGuiSortDirection -- ^ 'ImGuiSortDirection_Ascending' or 'ImGuiSortDirection_Descending'
} deriving (Show, Eq)
instance Storable ImGuiTableColumnSortSpecs where
sizeOf _ = 12
alignment _ = 4
poke ptr ImGuiTableColumnSortSpecs{..} = do
let columnUserIDPtr = castPtr ptr
poke columnUserIDPtr columnUserID
let columnIndexPtr = castPtr $ columnUserIDPtr `plusPtr` sizeOf columnUserID
poke columnIndexPtr columnIndex
let sortOrderPtr = castPtr $ columnIndexPtr `plusPtr` sizeOf columnIndex
poke sortOrderPtr sortOrder
let sortDirectionPtr = castPtr $ sortOrderPtr `plusPtr` sizeOf sortOrder
poke sortDirectionPtr sortDirection
peek ptr = do
let columnUserIDPtr = castPtr ptr
columnUserID <- peek columnUserIDPtr
let columnIndexPtr = castPtr $ columnUserIDPtr `plusPtr` sizeOf columnUserID
columnIndex <- peek columnIndexPtr
let sortOrderPtr = castPtr $ columnIndexPtr `plusPtr` sizeOf columnIndex
sortOrder <- peek sortOrderPtr
let sortDirectionPtr = castPtr $ sortOrderPtr `plusPtr` sizeOf sortOrder
sortDirection' <- peek sortDirectionPtr :: IO CInt
-- XXX: Specs struct uses trimmed field: @SortDirection : 8@
let sortDirection = case sortDirection' .&. 0xFF of
0 ->
ImGuiSortDirection_None
1 ->
ImGuiSortDirection_Ascending
2 ->
ImGuiSortDirection_Descending
_ ->
error $ "Unexpected value for ImGuiSortDirection: " <> show sortDirection
pure ImGuiTableColumnSortSpecs{..}

View File

@ -134,8 +134,6 @@ vulkanInit ( InitInfo {..} ) renderPass = do
initInfo.MSAASamples = $(VkSampleCountFlagBits msaaSamples);
initInfo.Allocator = $(VkAllocationCallbacks* callbacksPtr);
initInfo.CheckVkResultFn = $( void (*checkResultFunPtr)(VkResult) );
initInfo.UseDynamicRendering = false;
// TODO: initInfo.ColorAttachmentFormat
return ImGui_ImplVulkan_Init(&initInfo, $(VkRenderPass renderPass) );
}|]
pure ( checkResultFunPtr, initResult /= 0 )