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

Author: jship

dear-imgui.cabal

@@ -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.
@@ -260,6 +269,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
@@ -358,6 +373,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

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

src/DearImGui.hs

@@ -45,6 +45,7 @@ module DearImGui
     -- * Windows
   , withWindow
   , withWindowOpen
+  , withCloseableWindow
   , withFullscreen
   , fullscreenFlags
 
@@ -335,6 +336,7 @@ module DearImGui
   , Raw.getBackgroundDrawList
   , Raw.getForegroundDrawList
   , Raw.imCol32
+  , Raw.framerate
 
     -- * Types
   , module DearImGui.Enums
@@ -415,6 +417,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.

src/DearImGui/Raw.hs

@@ -249,6 +249,7 @@ module DearImGui.Raw
   , getBackgroundDrawList
   , getForegroundDrawList
   , imCol32
+  , framerate
 
     -- * Types
   , module DearImGui.Enums
@@ -1779,6 +1780,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/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 )) } |]