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

ChangeLog.md

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

Main.hs

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

README.md

@@ -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
+  runManaged $ do
-    -- Create a window using SDL. As we're using OpenGL, we need to enable OpenGL too.
+    -- 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
+    button "Clickety Click" >>= \clicked ->
-      False -> return ()
+      when clicked $ putStrLn "Ow!"
-      True  -> 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
+    shouldQuit <- gotQuitEvent
-      if shouldQuit then pure () else action
+    unless shouldQuit action
 
-    checkEvents = do
+  gotQuitEvent = do
-      pollEventWithImGui >>= \case
+    ev <- pollEventWithImGui
+
+    case ev of
       Nothing ->
         return False
       Just event ->
-          (isQuit event ||) <$> checkEvents
+        (isQuit event ||) <$> gotQuitEvent
 
   isQuit event =
-      SDL.eventPayload event == SDL.QuitEvent
+    eventPayload event == QuitEvent
 ```
 
 # Hacking

dear-imgui.cabal

@@ -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:
+  if impl(ghc >= 9.4)
-    stdc++
+    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
+          >= 2.5.3.0 && < 2.6
-      , text-short
+      , text
-         ^>= 0.1.3
+          >= 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

examples/Readme.hs

@@ -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
+  runManaged $ do
-    -- Create a window using SDL. As we're using OpenGL, we need to enable OpenGL too.
+    -- 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
+    button "Clickety Click" >>= \clicked ->
-      False -> return ()
+      when clicked $ putStrLn "Ow!"
-      True  -> 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
+    shouldQuit <- gotQuitEvent
-      if shouldQuit then pure () else action
+    unless shouldQuit action
 
-    checkEvents = do
+  gotQuitEvent = do
-      pollEventWithImGui >>= \case
+    ev <- pollEventWithImGui
+
+    case ev of
       Nothing ->
         return False
       Just event ->
-          (isQuit event ||) <$> checkEvents
+        (isQuit event ||) <$> gotQuitEvent
 
   isQuit event =
-      SDL.eventPayload event == SDL.QuitEvent
+    eventPayload event == QuitEvent

examples/sdl/Renderer.hs

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

examples/vulkan/Backend.hs

@@ -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
+-- text
-import Data.Text.Short
+import Data.Text
-  ( ShortText )
+  ( Text )
-import qualified Data.Text.Short as ShortText
+import qualified Data.Text as Text
-  ( intercalate, pack, fromShortByteString, toByteString, unpack )
+  ( 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
+  extensionNames   <- traverse ( liftIO . fmap fromString . peekCString ) neededExtensions
-  logInfo $ "Needed instance extensions are: " <> ShortText.intercalate ", " extensionNames
+  logInfo $ "Needed instance extensions are: " <> Text.intercalate ", " extensionNames
-  pure ( window, map ShortText.toByteString extensionNames )
+  pure ( window, map encodeUtf8 extensionNames )
-
-peekCString :: CString -> IO ShortText
-peekCString = fmap ( fromMaybe "???" . ShortText.fromShortByteString ) . ShortByteString.packCString
 
 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
+    presentMode =
-      | Vulkan.PRESENT_MODE_MAILBOX_KHR `elem` presentModes
+      Vulkan.PRESENT_MODE_FIFO_KHR -- run at presentation rate
-      = Vulkan.PRESENT_MODE_MAILBOX_KHR
+      -- Vulkan.PRESENT_MODE_MAILBOX_KHR -- max-FPS alternative for benchmarks, input lag debugging, etc.
-      | otherwise
-      = Vulkan.PRESENT_MODE_FIFO_KHR
 
     Vulkan.SurfaceCapabilitiesKHR{currentExtent, currentTransform} = surfaceCapabilities
     Vulkan.SurfaceFormatKHR{format=fmt, colorSpace=csp} = surfaceFormat

imgui

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

src/DearImGui.hs

@@ -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'.
 --

src/DearImGui/Raw.hs

@@ -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.

src/DearImGui/Raw/IO.hs

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

src/DearImGui/SDL.hs

@@ -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 ()
+      void $ dispatchRawEvent evPtr
-      [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]

src/DearImGui/SDL/Renderer.hs

@@ -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 )) } |]

src/DearImGui/Vulkan.hs

@@ -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 )