From 43989500534bd0a7a67e1272bc44307f6cd79e9c Mon Sep 17 00:00:00 2001 From: Oliver Charles Date: Sun, 24 Jan 2021 15:27:03 +0000 Subject: [PATCH] Initial work --- .gitmodules | 3 + Main.hs | 67 +++++++++++ hs-dear-imgui.cabal | 31 +++++ imgui | 1 + src/DearImGui.hs | 280 ++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 382 insertions(+) create mode 100644 .gitmodules create mode 100644 Main.hs create mode 100644 hs-dear-imgui.cabal create mode 160000 imgui create mode 100644 src/DearImGui.hs diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 0000000..028a4fb --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "imgui"] + path = imgui + url = https://github.com/ocornut/imgui diff --git a/Main.hs b/Main.hs new file mode 100644 index 0000000..a9c7467 --- /dev/null +++ b/Main.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +module Main (main) where + +import DearImGui +import Control.Exception +import Graphics.GL +import SDL + +main :: IO () +main = do + initializeAll + + bracket (createWindow "Hello, Dear ImGui!" defaultWindow { windowGraphicsContext = OpenGLContext defaultOpenGL }) destroyWindow \w -> + bracket (glCreateContext w) glDeleteContext \glContext -> + bracket createContext destroyContext \_imguiContext -> + bracket_ (sdl2InitForOpenGL w glContext) sdl2Shutdown $ + bracket_ openGL2Init openGL2Shutdown do + checkVersion + styleColorsLight + openGL2Init + + loop w + + openGL2Shutdown + +loop :: Window -> IO () +loop w = do + ev <- pollEventWithImGui + + openGL2NewFrame + sdl2NewFrame w + newFrame + + -- showDemoWindow + -- showMetricsWindow + -- showAboutWindow + -- showUserGuide + + begin "My Window" + text "Hello!" + + button "Click me" >>= \case + True -> putStrLn "Oh hi Mark" + False -> return () + + smallButton "Click me" >>= \case + True -> putStrLn "Oh hi Mark" + False -> return () + + end + + render + + glClear GL_COLOR_BUFFER_BIT + openGL2RenderDrawData =<< getDrawData + + glSwapWindow w + + case ev of + Nothing -> loop w + Just Event{ eventPayload } -> case eventPayload of + QuitEvent -> return () + _ -> loop w diff --git a/hs-dear-imgui.cabal b/hs-dear-imgui.cabal new file mode 100644 index 0000000..27f4b32 --- /dev/null +++ b/hs-dear-imgui.cabal @@ -0,0 +1,31 @@ +cabal-version: 3.0 +name: dear-imgui +version: 1.0.0 +build-type: Simple + +library + 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_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 + extra-libraries: GL + + +executable test + main-is: Main.hs + default-language: Haskell2010 + build-depends: base, sdl2, gl, dear-imgui + ghc-options: -Wall diff --git a/imgui b/imgui new file mode 160000 index 0000000..58075c4 --- /dev/null +++ b/imgui @@ -0,0 +1 @@ +Subproject commit 58075c4414b985b352d10718b02a8c43f25efd7c diff --git a/src/DearImGui.hs b/src/DearImGui.hs new file mode 100644 index 0000000..f79b8a5 --- /dev/null +++ b/src/DearImGui.hs @@ -0,0 +1,280 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} + +module DearImGui + ( -- * Context Creation and Access + Context(..) + , createContext + , destroyContext + + -- * Main + , newFrame + , endFrame + , render + , DrawData(..) + , getDrawData + , checkVersion + + -- ** SDL2 + , sdl2InitForOpenGL + , sdl2NewFrame + , sdl2Shutdown + , pollEventWithImGui + + -- ** OpenGL 2 + , openGL2Init + , openGL2Shutdown + , openGL2NewFrame + , openGL2RenderDrawData + + -- * Demo, Debug, Information + , showDemoWindow + , showMetricsWindow + , showAboutWindow + , showUserGuide + , getVersion + + -- * Styles + , styleColorsDark + , styleColorsLight + , styleColorsClassic + + -- * Windows + , begin + , end + + -- * Widgets + -- ** Text + , text + + -- ** Main + , button + , smallButton + ) + where + +import Control.Monad ( when ) +import Foreign +import Foreign.C.String +import qualified Language.C.Inline as C +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 ) + +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 @ImGuiContext*@. +newtype Context = Context (Ptr ()) + + +-- | Wraps @ImGui::CreateContext()@. +createContext :: IO Context +createContext = + Context <$> [C.exp| void* { CreateContext() } |] + + +-- | Wraps @ImGui::DestroyContext()@. +destroyContext :: Context -> IO () +destroyContext (Context contextPtr) = + [C.exp| void { DestroyContext((ImGuiContext*)$(void* contextPtr)); } |] + + +-- | Start a new Dear ImGui frame, you can submit any command from this point +-- until 'render'/'endFrame'. +-- +-- Wraps @ImGui::NewFrame()@. +newFrame :: IO () +newFrame = [C.exp| void { ImGui::NewFrame(); } |] + + +-- | Ends the Dear ImGui frame. automatically called by 'render'. If you don't +-- need to render data (skipping rendering) you may call 'endFrame' without +-- 'render'... but you'll have wasted CPU already! If you don't need to render, +-- better to not create any windows and not call 'newFrame' at all! +endFrame :: IO () +endFrame = [C.exp| void { ImGui::EndFrame(); } |] + + +-- | Ends the Dear ImGui frame, finalize the draw data. You can then get call +-- 'getDrawData'. +render :: IO () +render = [C.exp| void { ImGui::Render(); } |] + + +-- | Wraps @ImDrawData*@. +newtype DrawData = DrawData (Ptr ()) + + +-- | Valid after 'render' and until the next call to 'newFrame'. This is what +-- you have to render. +getDrawData :: IO DrawData +getDrawData = DrawData <$> [C.exp| void* { ImGui::GetDrawData() } |] + + +-- | Wraps @IMGUI_CHECKVERSION()@ +checkVersion :: IO () +checkVersion = + [C.exp| void { IMGUI_CHECKVERSION(); } |] + + +-- | Wraps @ImGui_ImplSDL2_InitForOpenGL@. +sdl2InitForOpenGL :: Window -> GLContext -> IO () +sdl2InitForOpenGL (Window windowPtr) glContext = + [C.exp| void { ImGui_ImplSDL2_InitForOpenGL((SDL_Window*)$(void* windowPtr), $(void* glContextPtr)); } |] + where + glContextPtr :: Ptr () + glContextPtr = unsafeCoerce glContext + + +-- | Wraps @ImGui_ImplSDL2_NewFrame@. +sdl2NewFrame :: Window -> IO () +sdl2NewFrame (Window windowPtr) = + [C.exp| void { ImGui_ImplSDL2_NewFrame((SDL_Window*)($(void* windowPtr))); } |] + + +-- | Wraps @ImGui_ImplSDL2_Shutdown@. +sdl2Shutdown :: IO () +sdl2Shutdown = [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 :: IO (Maybe Event) +pollEventWithImGui = 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 :: IO () +openGL2Init = [C.exp| void { ImGui_ImplOpenGL2_Init(); } |] + + +-- | Wraps @ImGui_ImplOpenGL2_Shutdown@. +openGL2Shutdown :: IO () +openGL2Shutdown = [C.exp| void { ImGui_ImplOpenGL2_Shutdown(); } |] + + +-- | Wraps @ImGui_ImplOpenGL2_NewFrame@. +openGL2NewFrame :: IO () +openGL2NewFrame = [C.exp| void { ImGui_ImplOpenGL2_NewFrame(); } |] + + +-- | Wraps @ImGui_ImplOpenGL2_RenderDrawData@. +openGL2RenderDrawData :: DrawData -> IO () +openGL2RenderDrawData (DrawData ptr) = [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 :: IO () +showDemoWindow = [C.exp| void { ImGui::ShowDemoWindow(); } |] + + +-- | Create Metrics/Debugger window. Display Dear ImGui internals: windows, draw +-- commands, various internal state, etc. +showMetricsWindow :: IO () +showMetricsWindow = [C.exp| void { ImGui::ShowMetricsWindow(); } |] + + +-- | Create About window. display Dear ImGui version, credits and build/system +-- information. +showAboutWindow :: IO () +showAboutWindow = [C.exp| void { ShowAboutWindow(); } |] + + +-- | Add basic help/info block (not a window): how to manipulate ImGui as a +-- end-user (mouse/keyboard controls). +showUserGuide :: IO () +showUserGuide = [C.exp| void { ShowUserGuide() } |] + + +-- | Get the compiled version string e.g. "1.80 WIP" (essentially the value for +-- @IMGUI_VERSION@ from the compiled version of @imgui.cpp@). +getVersion :: IO String +getVersion = peekCString =<< [C.exp| const char* { GetVersion() } |] + + +-- | New, recommended style (default). +-- +-- Wraps @ImGui::StyleColorsDark()@. +styleColorsDark :: IO () +styleColorsDark = [C.exp| void { StyleColorsDark(); } |] + + +-- | Best used with borders and a custom, thicker font. +-- +-- Wraps @ImGui::StyleColorsLight()@. +styleColorsLight :: IO () +styleColorsLight = [C.exp| void { StyleColorsLight(); } |] + + +-- | Classic ImGui style. +-- +-- Wraps @ImGui::StyleColorsClasic()@. +styleColorsClassic :: IO () +styleColorsClassic = [C.exp| void { StyleColorsClassic(); } |] + + +-- | Push window to the stack and start appending to it. +-- +-- Returns 'False' to indicate the window is collapsed or fully clipped, so you +-- may early out and omit submitting anything to the window. Always call a +-- matching 'end' for each 'begin' call, regardless of its return value! +-- +-- Wraps @ImGui::Begin()@. +begin :: String -> IO Bool +begin name = withCString name \namePtr -> + (1 ==) <$> [C.exp| bool { ImGui::Begin($(char* namePtr)) } |] + + +-- | Pop window from the stack. +-- +-- Wraps @ImGui::End()@. +end :: IO () +end = [C.exp| void { ImGui::End(); } |] + + +-- | Formatted text. +-- +-- Wraps @ImGui::Text()@. +text :: String -> IO () +text t = withCString t \textPtr -> + [C.exp| void { Text($(char* textPtr)) } |] + + +-- | A button. Returns 'True' when clicked. +-- +-- Wraps @ImGui::Button()@. +button :: String -> IO Bool +button label = withCString label \labelPtr -> + (1 ==) <$> [C.exp| bool { Button($(char* labelPtr)) } |] + + +-- | Button with @FramePadding=(0,0)@ to easily embed within text. +-- +-- Wraps @ImGui::SmallButton()@. +smallButton :: String -> IO Bool +smallButton label = withCString label \labelPtr -> + (1 ==) <$> [C.exp| bool { SmallButton($(char* labelPtr)) } |]