Add initial implementation

This commit is contained in:
Tristan Cacqueray 2021-02-21 21:12:49 +00:00
parent d8595ce01c
commit 9845f2042a
2 changed files with 115 additions and 1 deletions

69
Main.hs
View File

@ -1,4 +1,71 @@
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where module Main (main) where
import Control.Exception
import Control.Monad.IO.Class
import Control.Monad.Managed
import DearImGui
import DearImGui.OpenGL2
import qualified DearImGui.Plot as ImPlot
import DearImGui.SDL
import DearImGui.SDL.OpenGL
import Graphics.GL
import SDL
main :: IO () main :: IO ()
main = putStrLn "go!" main = do
-- Initialize SDL
initializeAll
runManaged do
-- Create a window using SDL. As we're using OpenGL, we need to enable OpenGL too.
win <- do
let title = "Hello, Dear ImGui!"
let config = defaultWindow {windowGraphicsContext = OpenGLContext defaultOpenGL}
managed $ bracket (createWindow title config) destroyWindow
-- Create an OpenGL context
glContext <- managed $ bracket (glCreateContext win) glDeleteContext
-- Create an ImGui context
_ <- managed $ bracket createContext destroyContext
-- Create an ImPlot context
_ <- managed $ bracket ImPlot.createContext ImPlot.destroyContext
-- Initialize ImGui's SDL2 backend
_ <- managed_ $ bracket_ (sdl2InitForOpenGL win glContext) sdl2Shutdown
-- Initialize ImGui's OpenGL backend
_ <- managed_ $ bracket_ openGL2Init openGL2Shutdown
liftIO $ mainLoop win
mainLoop :: Window -> IO ()
mainLoop win = do
-- Process the event loop
untilNothingM pollEventWithImGui
-- Tell ImGui we're starting a new frame
openGL2NewFrame
sdl2NewFrame win
newFrame
-- Build the GUI
bracket_ (ImPlot.beginPlot "Hello, ImPlot!") ImPlot.endPlot do
ImPlot.plotLine "test" [0.0, 0.1, 0.2, 0.3, 0.4] [0.1, 0.2, 0.3, 0.1, 0.5]
-- Render
glClear GL_COLOR_BUFFER_BIT
render
openGL2RenderDrawData =<< getDrawData
glSwapWindow win
mainLoop win
where
untilNothingM m = m >>= maybe (return ()) (\_ -> untilNothingM m)

View File

@ -1,2 +1,49 @@
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
-- | DearImGui bindings for https://github.com/epezent/implot -- | DearImGui bindings for https://github.com/epezent/implot
module DearImGui.Plot where module DearImGui.Plot where
import Control.Monad.IO.Class (MonadIO, liftIO)
import Foreign
import Foreign.C
import qualified Language.C.Inline as C
import qualified Language.C.Inline.Cpp as Cpp
C.context (Cpp.cppCtx <> C.bsCtx)
C.include "implot.h"
Cpp.using "namespace ImPlot"
newtype Context = Context (Ptr ())
createContext :: MonadIO m => m Context
createContext = liftIO do
Context <$> [C.exp| void* { CreateContext() } |]
destroyContext :: MonadIO m => Context -> m ()
destroyContext (Context contextPtr) = liftIO do
[C.exp| void { DestroyContext((ImPlotContext*)$(void* contextPtr)); } |]
beginPlot :: MonadIO m => String -> m Bool
beginPlot name = liftIO do
withCString name \namePtr ->
(0 /=) <$> [C.exp| bool { BeginPlot($(char* namePtr)) } |]
endPlot :: MonadIO m => m ()
endPlot = liftIO do
[C.exp| void { EndPlot(); } |]
plotLine :: (MonadIO m) => String -> [Float] -> [Float] -> m ()
plotLine desc xs ys = liftIO $ do
let size = fromIntegral $ length xs
withCString desc \descPtr -> do
withArray (map realToFrac xs) \xsPtr -> do
withArray (map realToFrac ys) \ysPtr -> do
[C.exp| void { PlotLine( $(char* descPtr), $(float *xsPtr), $(float *ysPtr), $(int size) ) } |]