From bbef66b2021f5cc37b6a7d310a04d90377568157 Mon Sep 17 00:00:00 2001 From: sheaf Date: Sun, 24 Jan 2021 19:25:40 +0100 Subject: [PATCH] add cabal flags for backend selection --- Main.hs | 3 + hs-dear-imgui.cabal | 82 +++++++++++++++++++++++----- src/DearImGui.hs | 106 +++++++----------------------------- src/DearImGui/OpenGL.hs | 65 ++++++++++++++++++++++ src/DearImGui/SDL.hs | 83 ++++++++++++++++++++++++++++ src/DearImGui/SDL/OpenGL.hs | 57 +++++++++++++++++++ 6 files changed, 296 insertions(+), 100 deletions(-) create mode 100644 src/DearImGui/OpenGL.hs create mode 100644 src/DearImGui/SDL.hs create mode 100644 src/DearImGui/SDL/OpenGL.hs diff --git a/Main.hs b/Main.hs index d540f04..45dafd9 100644 --- a/Main.hs +++ b/Main.hs @@ -7,6 +7,9 @@ module Main (main) where import Data.IORef import DearImGui +import DearImGui.OpenGL +import DearImGui.SDL +import DearImGui.SDL.OpenGL import Control.Exception import Graphics.GL import SDL diff --git a/hs-dear-imgui.cabal b/hs-dear-imgui.cabal index a6ce3b3..8218b68 100644 --- a/hs-dear-imgui.cabal +++ b/hs-dear-imgui.cabal @@ -3,25 +3,79 @@ name: dear-imgui version: 1.0.0 build-type: Simple +flag opengl + description: + Enable OpenGL backend. + default: + True + manual: + False + +flag sdl + description: + Enable SDL backend. + default: + True + manual: + False + library - exposed-modules: DearImGui - hs-source-dirs: src - default-language: Haskell2010 - ghc-options: -Wall + exposed-modules: + DearImGui + hs-source-dirs: + src + default-language: + Haskell2010 + ghc-options: + -Wall cxx-sources: imgui/imgui.cpp - imgui/backends/imgui_impl_opengl2.cpp - imgui/backends/imgui_impl_sdl.cpp + imgui/imgui_demo.cpp + imgui/imgui_draw.cpp imgui/imgui_tables.cpp imgui/imgui_widgets.cpp - imgui/imgui_draw.cpp - imgui/imgui_demo.cpp - cxx-options: -std=c++11 - extra-libraries: stdc++ - pkgconfig-depends: sdl2 - include-dirs: imgui - build-depends: base, inline-c, inline-c-cpp, sdl2, StateVar - extra-libraries: GL + cxx-options: + -std=c++11 + extra-libraries: + stdc++ + include-dirs: + imgui + build-depends: + base + , inline-c + , inline-c-cpp + , StateVar + + if flag(opengl) + exposed-modules: + DearImGui.OpenGL + cxx-sources: + imgui/backends/imgui_impl_opengl2.cpp + if os(windows) + extra-libraries: + opengl32 + else + extra-libraries: + GL + + if flag(sdl) + exposed-modules: + DearImGui.SDL + build-depends: + sdl2 + cxx-sources: + imgui/backends/imgui_impl_sdl.cpp + + if os(windows) || os(darwin) + extra-libraries: + sdl2 + else + pkgconfig-depends: + sdl2 + + if flag(opengl) + exposed-modules: + DearImGui.SDL.OpenGL executable test diff --git a/src/DearImGui.hs b/src/DearImGui.hs index 7dfee56..f1caf51 100644 --- a/src/DearImGui.hs +++ b/src/DearImGui.hs @@ -6,6 +6,12 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} +{-| +Module: DearImGui + +Main ImGui module, exporting the functions to create a GUI. +-} + module DearImGui ( -- * Context Creation and Access Context(..) @@ -20,18 +26,6 @@ module DearImGui , getDrawData , checkVersion - -- ** SDL2 - , sdl2InitForOpenGL - , sdl2NewFrame - , sdl2Shutdown - , pollEventWithImGui - - -- ** OpenGL 2 - , openGL2Init - , openGL2Shutdown - , openGL2NewFrame - , openGL2RenderDrawData - -- * Demo, Debug, Information , showDemoWindow , showMetricsWindow @@ -103,26 +97,28 @@ module DearImGui ) where -import Control.Monad ( when ) -import Control.Monad.IO.Class ( MonadIO, liftIO ) +-- base import Data.Bool -import Data.StateVar import Foreign import Foreign.C + +-- inline-c import qualified Language.C.Inline as C + +-- inline-c-cpp import qualified Language.C.Inline.Cpp as Cpp -import SDL -import SDL.Internal.Types -import SDL.Raw.Enum as Raw -import qualified SDL.Raw.Event as Raw -import Unsafe.Coerce ( unsafeCoerce ) + +-- StateVar +import Data.StateVar + ( HasGetter(get), HasSetter, ($=!) ) + +-- transformers +import Control.Monad.IO.Class + ( MonadIO, liftIO ) + C.context (Cpp.cppCtx <> C.bsCtx) C.include "imgui.h" -C.include "backends/imgui_impl_opengl2.h" -C.include "backends/imgui_impl_sdl.h" -C.include "SDL.h" -C.include "SDL_opengl.h" Cpp.using "namespace ImGui" @@ -184,68 +180,6 @@ checkVersion = liftIO do [C.exp| void { IMGUI_CHECKVERSION(); } |] --- | Wraps @ImGui_ImplSDL2_InitForOpenGL@. -sdl2InitForOpenGL :: MonadIO m => Window -> GLContext -> m () -sdl2InitForOpenGL (Window windowPtr) glContext = liftIO do - [C.exp| void { ImGui_ImplSDL2_InitForOpenGL((SDL_Window*)$(void* windowPtr), $(void* glContextPtr)); } |] - where - glContextPtr :: Ptr () - glContextPtr = unsafeCoerce glContext - - --- | Wraps @ImGui_ImplSDL2_NewFrame@. -sdl2NewFrame :: MonadIO m => Window -> m () -sdl2NewFrame (Window windowPtr) = liftIO do - [C.exp| void { ImGui_ImplSDL2_NewFrame((SDL_Window*)($(void* windowPtr))); } |] - - --- | Wraps @ImGui_ImplSDL2_Shutdown@. -sdl2Shutdown :: MonadIO m => m () -sdl2Shutdown = liftIO do - [C.exp| void { ImGui_ImplSDL2_Shutdown(); } |] - - --- | Call the SDL2 'pollEvent' function, while also dispatching the event to --- Dear ImGui. You should use this in your application instead of 'pollEvent'. -pollEventWithImGui :: MonadIO m => m (Maybe Event) -pollEventWithImGui = liftIO do - alloca \evPtr -> do - pumpEvents - - -- We use NULL first to check if there's an event. - 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')) } |] - - pollEvent - - --- | Wraps @ImGui_ImplOpenGL2_Init@. -openGL2Init :: MonadIO m => m () -openGL2Init = liftIO do - [C.exp| void { ImGui_ImplOpenGL2_Init(); } |] - - --- | Wraps @ImGui_ImplOpenGL2_Shutdown@. -openGL2Shutdown :: MonadIO m => m () -openGL2Shutdown = liftIO do - [C.exp| void { ImGui_ImplOpenGL2_Shutdown(); } |] - - --- | Wraps @ImGui_ImplOpenGL2_NewFrame@. -openGL2NewFrame :: MonadIO m => m () -openGL2NewFrame = liftIO do - [C.exp| void { ImGui_ImplOpenGL2_NewFrame(); } |] - - --- | Wraps @ImGui_ImplOpenGL2_RenderDrawData@. -openGL2RenderDrawData :: MonadIO m => DrawData -> m () -openGL2RenderDrawData (DrawData ptr) = liftIO do - [C.exp| void { ImGui_ImplOpenGL2_RenderDrawData((ImDrawData*) $( void* ptr )) } |] - - -- | Create demo window. Demonstrate most ImGui features. Call this to learn -- about the library! Try to make it always available in your application! showDemoWindow :: MonadIO m => m () diff --git a/src/DearImGui/OpenGL.hs b/src/DearImGui/OpenGL.hs new file mode 100644 index 0000000..3497b7b --- /dev/null +++ b/src/DearImGui/OpenGL.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} + +{-| +Module: DearImGui.OpenGL + +OpenGL backend for Dear ImGui. +-} + +module DearImGui.OpenGL + ( openGL2Init + , openGL2Shutdown + , openGL2NewFrame + , openGL2RenderDrawData + ) + where + +-- inline-c +import qualified Language.C.Inline as C + +-- inline-c-cpp +import qualified Language.C.Inline.Cpp as Cpp + +-- 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_opengl2.h" +Cpp.using "namespace ImGui" + + +-- | Wraps @ImGui_ImplOpenGL2_Init@. +openGL2Init :: MonadIO m => m () +openGL2Init = liftIO do + [C.exp| void { ImGui_ImplOpenGL2_Init(); } |] + + +-- | Wraps @ImGui_ImplOpenGL2_Shutdown@. +openGL2Shutdown :: MonadIO m => m () +openGL2Shutdown = liftIO do + [C.exp| void { ImGui_ImplOpenGL2_Shutdown(); } |] + + +-- | Wraps @ImGui_ImplOpenGL2_NewFrame@. +openGL2NewFrame :: MonadIO m => m () +openGL2NewFrame = liftIO do + [C.exp| void { ImGui_ImplOpenGL2_NewFrame(); } |] + + +-- | Wraps @ImGui_ImplOpenGL2_RenderDrawData@. +openGL2RenderDrawData :: MonadIO m => DrawData -> m () +openGL2RenderDrawData (DrawData ptr) = liftIO do + [C.exp| void { ImGui_ImplOpenGL2_RenderDrawData((ImDrawData*) $( void* ptr )) } |] diff --git a/src/DearImGui/SDL.hs b/src/DearImGui/SDL.hs new file mode 100644 index 0000000..6fb7b30 --- /dev/null +++ b/src/DearImGui/SDL.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} + +{-| +Module: DearImGui.SDL + +SDL2 specific functions backend for Dear ImGui. + +Modules for initialising a backend with SDL2 can be found under the corresponding backend, +e.g. "DearImGui.SDL.OpenGL". +-} + +module DearImGui.SDL ( + -- ** SDL2 + sdl2NewFrame + , sdl2Shutdown + , pollEventWithImGui + ) + where + +-- base +import Control.Monad + ( when ) +import Foreign.Marshal.Alloc + ( alloca ) +import Foreign.Ptr + ( Ptr, castPtr ) + +-- inline-c +import qualified Language.C.Inline as C + +-- inline-c-cpp +import qualified Language.C.Inline.Cpp as Cpp + +-- sdl2 +import SDL +import SDL.Internal.Types +import SDL.Raw.Enum as Raw +import qualified SDL.Raw.Event as Raw + +-- transformers +import Control.Monad.IO.Class + ( MonadIO, liftIO ) + + +C.context (Cpp.cppCtx <> C.bsCtx) +C.include "imgui.h" +C.include "backends/imgui_impl_sdl.h" +C.include "SDL.h" +Cpp.using "namespace ImGui" + + +-- | Wraps @ImGui_ImplSDL2_NewFrame@. +sdl2NewFrame :: MonadIO m => Window -> m () +sdl2NewFrame (Window windowPtr) = liftIO do + [C.exp| void { ImGui_ImplSDL2_NewFrame((SDL_Window*)($(void* windowPtr))); } |] + + +-- | Wraps @ImGui_ImplSDL2_Shutdown@. +sdl2Shutdown :: MonadIO m => m () +sdl2Shutdown = liftIO do + [C.exp| void { ImGui_ImplSDL2_Shutdown(); } |] + +-- | Call the SDL2 'pollEvent' function, while also dispatching the event to +-- Dear ImGui. You should use this in your application instead of 'pollEvent'. +pollEventWithImGui :: MonadIO m => m (Maybe Event) +pollEventWithImGui = liftIO do + alloca \evPtr -> do + pumpEvents + + -- We use NULL first to check if there's an event. + 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')) } |] + + pollEvent diff --git a/src/DearImGui/SDL/OpenGL.hs b/src/DearImGui/SDL/OpenGL.hs new file mode 100644 index 0000000..2293003 --- /dev/null +++ b/src/DearImGui/SDL/OpenGL.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} + +{-| +Module: DearImGUI.SDL.OpenGL + +Initialising the OpenGL backend for Dear ImGui using SDL2. +-} + +module DearImGui.SDL.OpenGL + ( sdl2InitForOpenGL ) + where + +-- base +import Foreign.Ptr + ( Ptr ) +import Unsafe.Coerce + ( unsafeCoerce ) + +-- inline-c +import qualified Language.C.Inline as C + +-- inline-c-cpp +import qualified Language.C.Inline.Cpp as Cpp + +-- sdl2 +import SDL + ( GLContext ) +import SDL.Internal.Types + ( Window(..) ) + +-- transformers +import Control.Monad.IO.Class + ( MonadIO, liftIO ) + + +C.context (Cpp.cppCtx <> C.bsCtx) +C.include "imgui.h" +C.include "backends/imgui_impl_opengl2.h" +C.include "backends/imgui_impl_sdl.h" +C.include "SDL.h" +C.include "SDL_opengl.h" +Cpp.using "namespace ImGui" + + +-- | Wraps @ImGui_ImplSDL2_InitForOpenGL@. +sdl2InitForOpenGL :: MonadIO m => Window -> GLContext -> m () +sdl2InitForOpenGL (Window windowPtr) glContext = liftIO do + [C.exp| void { ImGui_ImplSDL2_InitForOpenGL((SDL_Window*)$(void* windowPtr), $(void* glContextPtr)); } |] + where + glContextPtr :: Ptr () + glContextPtr = unsafeCoerce glContext