diff --git a/cabal.project b/cabal.project index b19ede2..74f9cfc 100644 --- a/cabal.project +++ b/cabal.project @@ -1,3 +1,3 @@ packages: *.cabal package dear-imgui - flags: +sdl2 +opengl +vulkan + flags: +sdl2 +glfw +opengl +vulkan diff --git a/dear-imgui.cabal b/dear-imgui.cabal index 358e896..cf1f506 100644 --- a/dear-imgui.cabal +++ b/dear-imgui.cabal @@ -29,6 +29,14 @@ flag sdl manual: False +flag glfw + description: + Enable GLFW backend. + default: + False + manual: + True + common common build-depends: base @@ -128,6 +136,26 @@ library exposed-modules: DearImGui.SDL.Vulkan + if flag(glfw) + exposed-modules: + DearImGui.GLFW + build-depends: + GLFW-b + cxx-sources: + imgui/backends/imgui_impl_glfw.cpp + + if os(linux) || os(darwin) + pkgconfig-depends: + glfw3 + + if flag(opengl) + exposed-modules: + DearImGui.GLFW.OpenGL + + if flag(vulkan) + exposed-modules: + DearImGui.GLFW.Vulkan + library dear-imgui-generator import: common hs-source-dirs: generator @@ -161,7 +189,16 @@ library dear-imgui-generator executable test import: common main-is: Main.hs - build-depends: sdl2, gl, dear-imgui + default-language: Haskell2010 + build-depends: base, sdl2, gl, dear-imgui + ghc-options: -Wall + +executable glfw + main-is: Main.hs + hs-source-dirs: examples/glfw + default-language: Haskell2010 + build-depends: base, GLFW-b, gl, dear-imgui, managed + ghc-options: -Wall executable readme import: common diff --git a/default.nix b/default.nix index 9699393..91194ad 100644 --- a/default.nix +++ b/default.nix @@ -20,4 +20,18 @@ in pkgs.haskell-nix.project { name = "dear-imgui"; src = ./.; }; + modules = [ { + # This library needs libXext to build, but doesn't explicitly state it in + # its .cabal file. + packages.bindings-GLFW.components.library.libs = + pkgs.lib.mkForce ( + pkgs.lib.optionals pkgs.stdenv.isDarwin (with pkgs.darwin.apple_sdk.frameworks; [ AGL Cocoa OpenGL IOKit Kernel CoreVideo pkgs.darwin.CF ]) ++ + pkgs.lib.optionals (!pkgs.stdenv.isDarwin) (with pkgs.xorg; [ libXext libXi libXrandr libXxf86vm libXcursor libXinerama pkgs.libGL ]) + ); + + # Depends on libX11 but doesn't state it in the .cabal file. + packages.GLFW-b.components.library.libs = + with pkgs.xorg; + pkgs.lib.mkForce [ libX11 ]; + } ]; } diff --git a/examples/glfw/Main.hs b/examples/glfw/Main.hs new file mode 100644 index 0000000..161488e --- /dev/null +++ b/examples/glfw/Main.hs @@ -0,0 +1,82 @@ +{-# language BlockArguments #-} +{-# language LambdaCase #-} +{-# language OverloadedStrings #-} + +module Main ( main ) where + +import Control.Exception +import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.Managed +import DearImGui +import DearImGui.OpenGL +import DearImGui.GLFW +import DearImGui.GLFW.OpenGL +import Graphics.GL +import Graphics.UI.GLFW (Window) +import qualified Graphics.UI.GLFW as GLFW + +main :: IO () +main = do + initialised <- GLFW.init + unless initialised $ error "GLFW init failed" + + runManaged $ do + mwin <- managed $ bracket + (GLFW.createWindow 800 600 "Hello, Dear ImGui!" Nothing Nothing) + (maybe (return ()) GLFW.destroyWindow) + case mwin of + Just win -> do + liftIO $ do + GLFW.makeContextCurrent (Just win) + GLFW.swapInterval 1 + + -- Create an ImGui context + _ <- managed $ bracket createContext destroyContext + + -- Initialize ImGui's GLFW backend + _ <- managed_ $ bracket_ (glfwInitForOpenGL win True) glfwShutdown + + -- Initialize ImGui's OpenGL backend + _ <- managed_ $ bracket_ openGL2Init openGL2Shutdown + + liftIO $ mainLoop win + Nothing -> do + error "GLFW createWindow failed" + + GLFW.terminate + +mainLoop :: Window -> IO () +mainLoop win = do + -- Process the event loop + GLFW.pollEvents + close <- GLFW.windowShouldClose win + unless close do + + -- Tell ImGui we're starting a new frame + openGL2NewFrame + glfwNewFrame + newFrame + + -- Build the GUI + bracket_ (begin "Hello, ImGui!") end 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!" + + -- Show the ImGui demo window + showDemoWindow + + -- Render + glClear GL_COLOR_BUFFER_BIT + + render + openGL2RenderDrawData =<< getDrawData + + GLFW.swapBuffers win + + mainLoop win \ No newline at end of file diff --git a/src/DearImGui/GLFW.hs b/src/DearImGui/GLFW.hs new file mode 100644 index 0000000..ee43b3b --- /dev/null +++ b/src/DearImGui/GLFW.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} + +{-| +Module: DearImGui.GLFW + +GLFW specific functions backend for Dear ImGui. + +Modules for initialising a backend with GLFW can be found under the corresponding backend, +e.g. "DearImGui.GLFW.OpenGL". +-} + +module DearImGui.GLFW ( + -- ** GLFW + glfwNewFrame + , glfwShutdown + ) + 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 ) + + +C.context (Cpp.cppCtx <> C.bsCtx) +C.include "imgui.h" +C.include "backends/imgui_impl_glfw.h" +Cpp.using "namespace ImGui" + + +-- | Wraps @ImGui_ImplGlfw_NewFrame@. +glfwNewFrame :: MonadIO m => m () +glfwNewFrame = liftIO do + [C.exp| void { ImGui_ImplGlfw_NewFrame(); } |] + + +-- | Wraps @ImGui_ImplGlfw_Shutdown@. +glfwShutdown :: MonadIO m => m () +glfwShutdown = liftIO do + [C.exp| void { ImGui_ImplGlfw_Shutdown(); } |] \ No newline at end of file diff --git a/src/DearImGui/GLFW/OpenGL.hs b/src/DearImGui/GLFW/OpenGL.hs new file mode 100644 index 0000000..8212ddc --- /dev/null +++ b/src/DearImGui/GLFW/OpenGL.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} + +{-| +Module: DearImGUI.GLFW.OpenGL + +Initialising the OpenGL backend for Dear ImGui using GLFW3. +-} + +module DearImGui.GLFW.OpenGL + ( glfwInitForOpenGL ) + where + +-- base +import Data.Bool + ( bool ) +import Foreign.C.Types + ( CBool ) +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 + +-- GLFW +import Graphics.UI.GLFW + ( 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_glfw.h" +C.include "GLFW/glfw3.h" +Cpp.using "namespace ImGui" + + +-- | Wraps @ImGui_ImplGlfw_InitForOpenGL@. +glfwInitForOpenGL :: MonadIO m => Window -> Bool -> m Bool +glfwInitForOpenGL window installCallbacks = liftIO do + ( 0 /= ) <$> [C.exp| bool { ImGui_ImplGlfw_InitForOpenGL((GLFWwindow*)$(void* windowPtr), $(bool cInstallCallbacks)) } |] + where + windowPtr :: Ptr () + windowPtr = unsafeCoerce window + + cInstallCallbacks :: CBool + cInstallCallbacks = bool 0 1 installCallbacks diff --git a/src/DearImGui/GLFW/Vulkan.hs b/src/DearImGui/GLFW/Vulkan.hs new file mode 100644 index 0000000..0438f70 --- /dev/null +++ b/src/DearImGui/GLFW/Vulkan.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} + +{-| +Module: DearImGui.GLFW.Vulkan + +Initialising the Vulkan backend for Dear ImGui using GLFW3. +-} + +module DearImGui.GLFW.Vulkan + ( glfwInitForVulkan ) + where + +-- base +import Data.Bool + ( bool ) +import Foreign.C.Types + ( CBool ) +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 + +-- GLFW +import Graphics.UI.GLFW + ( Window ) + +-- transformers +import Control.Monad.IO.Class ( MonadIO, liftIO ) + + +C.context Cpp.cppCtx +C.include "imgui.h" +C.include "backends/imgui_impl_vulkan.h" +C.include "backends/imgui_impl_glfw.h" +C.include "GLFW/glfw3.h" +Cpp.using "namespace ImGui" + + +-- | Wraps @ImGui_ImplGlfw_InitForVulkan@. +glfwInitForVulkan :: MonadIO m => Window -> Bool -> m Bool +glfwInitForVulkan window installCallbacks = liftIO do + ( 0 /= ) <$> [C.exp| bool { ImGui_ImplGlfw_InitForVulkan((GLFWwindow*)$(void* windowPtr), $(bool cInstallCallbacks)) } |] + where + windowPtr :: Ptr () + windowPtr = unsafeCoerce window + + cInstallCallbacks :: CBool + cInstallCallbacks = bool 0 1 installCallbacks