From bbe0aa73a03f13e4d41bdffd0d541494238bce0e Mon Sep 17 00:00:00 2001 From: Jason Shipman Date: Thu, 14 Dec 2023 13:03:51 -0500 Subject: [PATCH] Closes #191: Add support for SDL2 Renderer backend --- dear-imgui.cabal | 10 +++ examples/sdl/Renderer.hs | 146 ++++++++++++++++++++++++++++++++++ src/DearImGui/SDL/Renderer.hs | 74 +++++++++++++++++ 3 files changed, 230 insertions(+) create mode 100644 examples/sdl/Renderer.hs create mode 100644 src/DearImGui/SDL/Renderer.hs diff --git a/dear-imgui.cabal b/dear-imgui.cabal index bd6be44..81b00d7 100644 --- a/dear-imgui.cabal +++ b/dear-imgui.cabal @@ -240,10 +240,12 @@ library if flag(sdl) exposed-modules: DearImGui.SDL + DearImGui.SDL.Renderer build-depends: sdl2 cxx-sources: imgui/backends/imgui_impl_sdl2.cpp + imgui/backends/imgui_impl_sdlrenderer2.cpp if os(windows) || os(darwin) extra-libraries: @@ -358,6 +360,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)) + buildable: False + executable vulkan import: common, exe-flags main-is: Main.hs diff --git a/examples/sdl/Renderer.hs b/examples/sdl/Renderer.hs new file mode 100644 index 0000000..68e95ad --- /dev/null +++ b/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 diff --git a/src/DearImGui/SDL/Renderer.hs b/src/DearImGui/SDL/Renderer.hs new file mode 100644 index 0000000..416c596 --- /dev/null +++ b/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 )) } |]