mirror of
https://github.com/Drezil/dear-implot.hs.git
synced 2024-11-22 12:36:59 +00:00
Add initial implementation
This commit is contained in:
parent
d8595ce01c
commit
9845f2042a
69
Main.hs
69
Main.hs
@ -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)
|
||||||
|
@ -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) ) } |]
|
||||||
|
Loading…
Reference in New Issue
Block a user