Add support for GLFW (#26)

Co-authored-by: Oliver Charles <ollie@ocharles.org.uk>

cabal.project

@@ -1,3 +1,3 @@
 packages: *.cabal
 package dear-imgui
-  flags: +sdl2 +opengl +vulkan
+  flags: +sdl2 +glfw +opengl +vulkan

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

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 ];
+  } ];
 }

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

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(); } |]

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

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