Compare commits

...

11 Commits

Author SHA1 Message Date
Jason Shipman
b48ef7904b
Link against system-cxx-std-lib for GHC 9.4+ (#197)
* Link against system-cxx-std-lib for GHC 9.4+

* Drop OS checks for linking with stdc++ when GHC < 9.4
2024-02-23 14:43:53 +02:00
Jason Shipman
f6cad45dab
Add support for disabled blocks (#196) 2024-02-20 19:20:46 +00:00
Jason Shipman
49f7bb245e
Add support for dispatching raw SDL events to Dear ImGui (#195) 2024-02-20 21:16:37 +02:00
svært
47402c1a93
Update README (#194) 2024-02-04 18:24:06 +00:00
Jason Shipman
4d1c66e9a1
Add support for SDL2 Renderer backend (#193)
* Add DearImGui.Raw.framerate
* Add DearImGui.withCloseableWindow
* Closes #191: Add support for SDL2 Renderer backend
* Add sdl-renderer flag to protect against older SDL versions that do not have SDL_RenderGeometry
2023-12-15 15:31:04 +02:00
Alexander Bondarenko
7ec260c359
Bump megaparsec (#190) 2023-09-10 18:55:24 +00:00
Alexander Bondarenko
bab4d769ea
V2.2.0 (#189)
* Upgrade upstream and prepare 2.2.0
* Update vulkan example
2023-09-10 13:24:33 +00:00
Alexander Bondarenko
eec8b57ce8
Use FIFO for vulkan demo (#188) 2023-09-04 10:10:10 +00:00
Carter Tazio Schonwald
d40fa4f6db
fix intem->item (#184) 2023-08-09 13:03:43 +03:00
Alexander Bondarenko
8df98e075c
Fix TabItem flags type (#183)
Resolves #175
2023-07-20 16:42:11 +00:00
Alexander Bondarenko
6dbb455d62
Fix vulkan init wrapper (#180)
`init_info` got dynamic render flag, which is a breaking change with its default value.
Setting it to `false` will fix validation errors coming from misconfiguration.
2023-07-20 16:25:02 +00:00
14 changed files with 454 additions and 129 deletions

View File

@ -1,5 +1,13 @@
# 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.
@ -107,7 +115,9 @@ Initial Hackage release based on [1.83].
[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

View File

@ -79,10 +79,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 ImGuiTabBarFlags_None >>= whenTrue do
beginTabItem "Tab 1" tab1Ref ImGuiTabItemFlags_None >>= whenTrue do
text "Tab 1 is currently selected."
endTabItem
beginTabItem "Tab 2" tab2Ref ImGuiTabBarFlags_None >>= whenTrue do
beginTabItem "Tab 2" tab2Ref ImGuiTabItemFlags_None >>= whenTrue do
text "Tab 2 is selected now."
endTabItem
reOpen <- tabItemButton "ReopenTabs" ImGuiTabItemFlags_Trailing

View File

@ -31,29 +31,30 @@ 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.OpenGL2
import DearImGui.OpenGL3
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 need to enable OpenGL too.
runManaged $ do
-- Create a window using SDL; as we're using OpenGL, we enable OpenGL too
window <- do
let title = "Hello, Dear ImGui!"
let config = defaultWindow { windowGraphicsContext = OpenGLContext defaultOpenGL }
@ -61,64 +62,59 @@ 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_ openGL2Init openGL2Shutdown
managed_ $ bracket_ openGL3Init openGL3Shutdown
liftIO $ mainLoop window
mainLoop :: Window -> IO ()
mainLoop window = unlessQuit do
mainLoop window = unlessQuit $ do
-- Tell ImGui we're starting a new frame
openGL2NewFrame
openGL3NewFrame
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" >>= \case
False -> return ()
True -> putStrLn "Ow!"
button "Clickety Click" >>= \clicked ->
when clicked $ putStrLn "Ow!"
-- Show the ImGui demo window
showDemoWindow
-- Render
glClear GL_COLOR_BUFFER_BIT
render
openGL2RenderDrawData =<< getDrawData
openGL3RenderDrawData =<< getDrawData
glSwapWindow window
mainLoop window
where
-- Process the event loop
unlessQuit action = do
shouldQuit <- checkEvents
if shouldQuit then pure () else action
-- Process the event loop
unlessQuit action = do
shouldQuit <- gotQuitEvent
unless shouldQuit action
checkEvents = do
pollEventWithImGui >>= \case
Nothing ->
return False
Just event ->
(isQuit event ||) <$> checkEvents
gotQuitEvent = do
ev <- pollEventWithImGui
isQuit event =
SDL.eventPayload event == SDL.QuitEvent
case ev of
Nothing ->
return False
Just event ->
(isQuit event ||) <$> gotQuitEvent
isQuit event =
eventPayload event == QuitEvent
```
# Hacking

View File

@ -1,7 +1,7 @@
cabal-version: 3.0
name: dear-imgui
version: 2.1.3
version: 2.2.0
author: Oliver Charles
maintainer: ollie@ocharles.org.uk, aenor.realm@gmail.com
license: BSD-3-Clause
@ -94,6 +94,15 @@ 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.
@ -170,8 +179,10 @@ library
imgui/imgui_draw.cpp
imgui/imgui_tables.cpp
imgui/imgui_widgets.cpp
extra-libraries:
stdc++
if impl(ghc >= 9.4)
build-depends: system-cxx-std-lib
else
extra-libraries: stdc++
include-dirs:
imgui
build-depends:
@ -260,6 +271,12 @@ 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
@ -301,7 +318,7 @@ library dear-imgui-generator
, inline-c
>= 0.9.0.0 && < 0.10
, megaparsec
>= 9.0 && < 9.3
>= 9.0 && < 9.4
, parser-combinators
>= 1.2.0 && < 1.4
, scientific
@ -358,6 +375,14 @@ executable image
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))
buildable: False
executable vulkan
import: common, exe-flags
main-is: Main.hs
@ -370,25 +395,25 @@ executable vulkan
build-depends:
dear-imgui
, bytestring
>= 0.10.10.0 && < 0.12
>= 0.10.10.0 && < 0.13
, containers
^>= 0.6.2.1
>= 0.6.2.1 && < 0.7
, logging-effect
^>= 1.3.12
>= 1.3.12 && < 1.5
, resourcet
^>= 1.2.4.2
>= 1.2.4.2 && < 1.3
, sdl2
^>= 2.5.3.0
, text-short
^>= 0.1.3
>= 2.5.3.0 && < 2.6
, text
>= 1.2.4 && < 2.1
, transformers
>= 0.5.6 && < 0.7
, unliftio
>= 0.2.13 && < 0.2.19
>= 0.2.13 && < 0.3
, unliftio-core
^>= 0.2.0.1
>= 0.2.0.1 && < 0.3
, vector
^>= 0.12.1.2
>= 0.12.1.2 && < 0.14
, vulkan
>= 3.12
, vulkan-utils

View File

@ -1,29 +1,30 @@
-- 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.OpenGL2
import DearImGui.OpenGL3
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 need to enable OpenGL too.
runManaged $ do
-- Create a window using SDL; as we're using OpenGL, we enable OpenGL too
window <- do
let title = "Hello, Dear ImGui!"
let config = defaultWindow { windowGraphicsContext = OpenGLContext defaultOpenGL }
@ -31,61 +32,56 @@ 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_ openGL2Init openGL2Shutdown
managed_ $ bracket_ openGL3Init openGL3Shutdown
liftIO $ mainLoop window
mainLoop :: Window -> IO ()
mainLoop window = unlessQuit do
mainLoop window = unlessQuit $ do
-- Tell ImGui we're starting a new frame
openGL2NewFrame
openGL3NewFrame
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" >>= \case
False -> return ()
True -> putStrLn "Ow!"
button "Clickety Click" >>= \clicked ->
when clicked $ putStrLn "Ow!"
-- Show the ImGui demo window
showDemoWindow
-- Render
glClear GL_COLOR_BUFFER_BIT
render
openGL2RenderDrawData =<< getDrawData
openGL3RenderDrawData =<< getDrawData
glSwapWindow window
mainLoop window
where
-- Process the event loop
unlessQuit action = do
shouldQuit <- checkEvents
if shouldQuit then pure () else action
-- Process the event loop
unlessQuit action = do
shouldQuit <- gotQuitEvent
unless shouldQuit action
checkEvents = do
pollEventWithImGui >>= \case
Nothing ->
return False
Just event ->
(isQuit event ||) <$> checkEvents
gotQuitEvent = do
ev <- pollEventWithImGui
isQuit event =
SDL.eventPayload event == SDL.QuitEvent
case ev of
Nothing ->
return False
Just event ->
(isQuit event ||) <$> gotQuitEvent
isQuit event =
eventPayload event == QuitEvent

146
examples/sdl/Renderer.hs Normal file
View File

@ -0,0 +1,146 @@
{-# 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
( CString )
( peekCString )
import Foreign.C.Types
( CInt )
import Foreign.Ptr
@ -53,8 +53,6 @@ import Foreign.Ptr
-- bytestring
import Data.ByteString
( ByteString )
import qualified Data.ByteString.Short as ShortByteString
( packCString )
-- containers
import qualified Data.Map.Strict as Map
@ -77,11 +75,13 @@ import qualified SDL
import qualified SDL.Raw
import qualified SDL.Video.Vulkan
-- text-short
import Data.Text.Short
( ShortText )
import qualified Data.Text.Short as ShortText
( intercalate, pack, fromShortByteString, toByteString, unpack )
-- text
import Data.Text
( Text )
import qualified Data.Text as Text
( intercalate, pack, unpack )
import Data.Text.Encoding
( encodeUtf8 )
-- transformers
import Control.Monad.IO.Class
@ -118,7 +118,7 @@ import Attachments
--------------------------------------------------------------------------------
type LogMessage = WithSeverity ShortText
type LogMessage = WithSeverity Text
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 . ShortText.unpack $ showSeverity sev <> " " <> mess
= liftIO . putStrLn . Text.unpack $ showSeverity sev <> " " <> mess
showSeverity :: Severity -> ShortText
showSeverity :: Severity -> Text
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 " <> ShortText.pack ( show enabledLayers ) )
Just _ -> logInfo ( "Enabled validation layers " <> Text.pack ( show enabledLayers ) )
pure createInfo
@ -305,26 +305,23 @@ 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 . 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
extensionNames <- traverse ( liftIO . fmap fromString . peekCString ) neededExtensions
logInfo $ "Needed instance extensions are: " <> Text.intercalate ", " extensionNames
pure ( window, map encodeUtf8 extensionNames )
data WindowInfo
= WindowInfo
{ width :: CInt
, height :: CInt
, windowName :: ShortText
, windowName :: Text
, mouseMode :: SDL.LocationMode
}
createWindow :: MonadVulkan m => CInt -> CInt -> ShortText -> m SDL.Window
createWindow :: MonadVulkan m => CInt -> CInt -> Text -> m SDL.Window
createWindow x y title =
snd <$> ResourceT.allocate
( SDL.createWindow
( fromString ( ShortText.unpack title ) )
( fromString ( Text.unpack title ) )
SDL.defaultWindow
{ SDL.windowGraphicsContext = SDL.VulkanContext
, SDL.windowInitialSize = SDL.V2 x y
@ -404,15 +401,11 @@ 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_MAILBOX_KHR `elem` presentModes
= Vulkan.PRESENT_MODE_MAILBOX_KHR
| otherwise
= Vulkan.PRESENT_MODE_FIFO_KHR
presentMode =
Vulkan.PRESENT_MODE_FIFO_KHR -- run at presentation rate
-- Vulkan.PRESENT_MODE_MAILBOX_KHR -- max-FPS alternative for benchmarks, input lag debugging, etc.
Vulkan.SurfaceCapabilitiesKHR{currentExtent, currentTransform} = surfaceCapabilities
Vulkan.SurfaceFormatKHR{format=fmt, colorSpace=csp} = surfaceFormat

2
imgui

@ -1 +1 @@
Subproject commit d4ddc46e7773e9a9b68f965d007968f35ca4e09a
Subproject commit c6e0284ac58b3f205c95365478888f7b53b077e2

View File

@ -45,6 +45,7 @@ module DearImGui
-- * Windows
, withWindow
, withWindowOpen
, withCloseableWindow
, withFullscreen
, fullscreenFlags
@ -278,6 +279,11 @@ module DearImGui
, Raw.beginTooltip
, Raw.endTooltip
-- ** Disabled blocks
, withDisabled
, Raw.beginDisabled
, Raw.endDisabled
-- * Popups/Modals
-- ** Generic
@ -335,6 +341,7 @@ module DearImGui
, Raw.getBackgroundDrawList
, Raw.getForegroundDrawList
, Raw.imCol32
, Raw.framerate
-- * Types
, module DearImGui.Enums
@ -415,6 +422,26 @@ withWindowOpen :: MonadUnliftIO m => Text -> m () -> m ()
withWindowOpen name action =
withWindow name (`when` action)
-- | Append items to a closeable window unless it is collapsed or fully clipped.
--
-- You may append multiple times to the same window during the same frame
-- by calling 'withWindowOpen' in multiple places.
--
-- The 'Bool' state variable will be set to 'False' when the window's close
-- button is pressed.
withCloseableWindow :: (HasSetter ref Bool, MonadUnliftIO m) => Text -> ref -> m () -> m ()
withCloseableWindow name ref action = bracket open close (`when` action)
where
open = liftIO do
with 1 \boolPtr -> do
Text.withCString name \namePtr -> do
isVisible <- Raw.begin namePtr (Just boolPtr) Nothing
isOpen <- peek boolPtr
when (isOpen == 0) $ ref $=! False
pure isVisible
close = liftIO . const Raw.end
-- | Append items to a fullscreen window.
--
-- The action runs inside a window that is set to behave as a backdrop.
@ -1690,7 +1717,7 @@ withTabBarOpen tabBarID flags action =
-- | Create a new tab. Returns @True@ if the tab is selected.
--
-- Wraps @ImGui::BeginTabItem@.
beginTabItem :: (MonadIO m, HasGetter ref Bool, HasSetter ref Bool) => Text -> ref -> ImGuiTabBarFlags -> m Bool
beginTabItem :: (MonadIO m, HasGetter ref Bool, HasSetter ref Bool) => Text -> ref -> ImGuiTabItemFlags -> m Bool
beginTabItem tabName ref flags = liftIO do
currentValue <- get ref
with (bool 0 1 currentValue) \refPtr -> do
@ -1706,14 +1733,14 @@ beginTabItem tabName ref flags = liftIO do
-- | Create a new tab.
--
-- The action will get 'True' if the tab is selected.
withTabItem :: (MonadUnliftIO m, HasGetter ref Bool, HasSetter ref Bool) => Text -> ref -> ImGuiTabBarFlags -> (Bool -> m a) -> m a
withTabItem :: (MonadUnliftIO m, HasGetter ref Bool, HasSetter ref Bool) => Text -> ref -> ImGuiTabItemFlags -> (Bool -> m a) -> m a
withTabItem tabName ref flags =
bracket (beginTabItem tabName ref flags) (`when` Raw.endTabItem)
-- | Create a new tab.
--
-- The action will be skipped unless the tab is selected.
withTabItemOpen :: (MonadUnliftIO m, HasGetter ref Bool, HasSetter ref Bool) => Text -> ref -> ImGuiTabBarFlags -> m () -> m ()
withTabItemOpen :: (MonadUnliftIO m, HasGetter ref Bool, HasSetter ref Bool) => Text -> ref -> ImGuiTabItemFlags -> m () -> m ()
withTabItemOpen tabName ref flags action =
withTabItem tabName ref flags (`when` action)
@ -1741,6 +1768,17 @@ setTabItemClosed tabName = liftIO do
withTooltip :: MonadUnliftIO m => m a -> m a
withTooltip = bracket_ Raw.beginTooltip Raw.endTooltip
-- | Action wrapper for disabled blocks.
--
-- See 'Raw.beginDisabled' and 'Raw.endDisabled' for more info.
withDisabled :: (MonadUnliftIO m, HasGetter ref Bool) => ref -> m a -> m a
withDisabled disabledRef action = do
disabled <- get disabledRef
if disabled then bracket_ (Raw.beginDisabled 1) Raw.endDisabled action else action
-- | Returns 'True' if the popup is open, and you can start outputting to it.
--
-- Wraps @ImGui::BeginPopup()@
@ -1748,7 +1786,7 @@ beginPopup :: MonadIO m => Text -> m Bool
beginPopup popupId = liftIO do
Text.withCString popupId Raw.beginPopup
-- | Append intems to a non-modal Popup.
-- | Append items to a non-modal Popup.
--
-- Non-modal popups can be closed by clicking anywhere outside them,
-- or by pressing ESCAPE.
@ -1759,7 +1797,7 @@ beginPopup popupId = liftIO do
withPopup :: MonadUnliftIO m => Text -> (Bool -> m a) -> m a
withPopup popupId = bracket (beginPopup popupId) (`when` Raw.endPopup)
-- | Append intems to a non-modal Popup.
-- | Append items to a non-modal Popup.
--
-- Non-modal popups can be closed by clicking anywhere outside them,
-- or by pressing ESCAPE.
@ -1778,7 +1816,7 @@ beginPopupModal :: MonadIO m => Text -> m Bool
beginPopupModal popupId = liftIO do
Text.withCString popupId Raw.beginPopupModal
-- | Append intems to a modal Popup.
-- | Append items to a modal Popup.
--
-- Modal popups can be closed only with 'closeCurrentPopup'.
--

View File

@ -65,6 +65,8 @@ module DearImGui.Raw
, setNextWindowSizeConstraints
, setNextWindowCollapsed
, setNextWindowBgAlpha
, beginDisabled
, endDisabled
-- ** Child Windows
, beginChild
@ -249,6 +251,7 @@ module DearImGui.Raw
, getBackgroundDrawList
, getForegroundDrawList
, imCol32
, framerate
-- * Types
, module DearImGui.Enums
@ -1346,9 +1349,9 @@ endTabBar = liftIO do
-- | Create a new tab. Returns @True@ if the tab is selected.
--
-- Wraps @ImGui::BeginTabItem@.
beginTabItem :: (MonadIO m) => CString -> Ptr CBool -> ImGuiTabBarFlags -> m Bool
beginTabItem :: (MonadIO m) => CString -> Ptr CBool -> ImGuiTabItemFlags -> m Bool
beginTabItem namePtr refPtr flags = liftIO do
(0 /=) <$> [C.exp| bool { BeginTabItem($(char* namePtr), $(bool* refPtr), $(ImGuiTabBarFlags flags) ) } |]
(0 /=) <$> [C.exp| bool { BeginTabItem($(char* namePtr), $(bool* refPtr), $(ImGuiTabItemFlags flags) ) } |]
-- | Finish appending elements to a tab. Only call if 'beginTabItem' returns @True@.
@ -1581,6 +1584,29 @@ 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()@
@ -1779,6 +1805,12 @@ 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

@ -120,14 +120,11 @@ 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

@ -21,12 +21,14 @@ module DearImGui.SDL (
, sdl2Shutdown
, pollEventWithImGui
, pollEventsWithImGui
-- *** Raw
, dispatchRawEvent
)
where
-- base
import Control.Monad
( when )
( void, when )
import Foreign.Marshal.Alloc
( alloca )
import Foreign.Ptr
@ -42,6 +44,7 @@ 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
@ -77,11 +80,24 @@ pollEventWithImGui = liftIO do
nEvents <- Raw.peepEvents evPtr 1 Raw.SDL_PEEKEVENT Raw.SDL_FIRSTEVENT Raw.SDL_LASTEVENT
when (nEvents > 0) do
let evPtr' = castPtr evPtr :: Ptr ()
[C.exp| void { ImGui_ImplSDL2_ProcessEvent((SDL_Event*) $(void* evPtr')) } |]
void $ dispatchRawEvent 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

@ -0,0 +1,74 @@
{-# 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

@ -134,6 +134,8 @@ 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 )