diff --git a/.gitmodules b/.gitmodules index 1ff6718..1490475 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,6 +1,8 @@ [submodule "implot"] path = implot url = https://github.com/epezent/implot + branch = v0.13 [submodule "imgui"] path = imgui url = https://github.com/ocornut/imgui + branch = v1.87 diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md new file mode 100644 index 0000000..33742f5 --- /dev/null +++ b/CONTRIBUTING.md @@ -0,0 +1,14 @@ +# How to contribute + +- Look at [https://github.com/epezent/implot/blob/master/implot.h](https://github.com/epezent/implot/blob/master/implot.h) for things you + need +- wrap them in `src/DearImGui/Raw/Plot.hs` like shown there +- write a thin user-facing wrapper in `src/DearImGui/Plot.hs` with normal + Haskell-Types (and not things like `CInt`, `Ptr Foo` etc.) +- submit a PR + +# Things to consider + +To have things work the version of `dear-implot` is very tightly bound to the +soucecode-versions of `imgui` used in `dear-imgui` and the corresponding +`implot` used here. diff --git a/Main.hs b/Main.hs deleted file mode 100644 index 6fc732d..0000000 --- a/Main.hs +++ /dev/null @@ -1,108 +0,0 @@ -{-# LANGUAGE BlockArguments #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} - -module Main (main) where - -import Control.Exception -import Control.Monad.IO.Class -import Control.Monad.Managed -import Data.Binary.Get (getInt16le, isEmpty, runGet) -import qualified Data.ByteString as BS -import Data.ByteString.Lazy (fromStrict) -import Data.List (iterate') -import DearImGui -import DearImGui.OpenGL2 -import qualified DearImGui.Plot as ImPlot -import DearImGui.SDL -import DearImGui.SDL.OpenGL -import GHC.Float (int2Float) -import GHC.Int (Int16) -import Graphics.GL -import Pipes -import Pipes.PulseSimple -import Pipes.Safe (runSafeT) -import SDL - -main :: IO () -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 $ runSafeT (runEffect (readPulse "dear-pulse" Nothing 25 >-> mainLoop win)) - --- | Binary decoder -decodeSampleList :: BS.ByteString -> [Int16] -decodeSampleList = runGet get . fromStrict - where - get = do - empty <- isEmpty - if empty - then return [] - else do - sample <- getInt16le - rest <- get - return (sample : rest) - -mainLoop :: MonadIO m => Window -> Consumer' BS.ByteString m () -mainLoop win = do - -- Process the event loop - untilNothingM pollEventWithImGui - - -- Get audio buffer - buf <- await - let maxInt16 :: Int16 - maxInt16 = maxBound - maxInt16f = int2Float $ fromIntegral maxInt16 - samples :: [Float] - samples = map (\x' -> int2Float (fromIntegral x') / maxInt16f) $ decodeSampleList buf - - -- Tell ImGui we're starting a new frame - openGL2NewFrame - sdl2NewFrame win - newFrame - - -- Build the GUI - ImPlot.setNextPlotLimits (0, 1) (-1, 1) - liftIO $ bracket_ (ImPlot.beginPlot "Audio") ImPlot.endPlot do - ImPlot.plotLine "pulse-input" xs samples - - -- Render - glClear GL_COLOR_BUFFER_BIT - - render - openGL2RenderDrawData =<< getDrawData - - glSwapWindow win - - mainLoop win - where - untilNothingM m = m >>= maybe (return ()) (\_ -> untilNothingM m) - xs = range - range :: [Float] - range = take 1764 $ iterate' (+ step) 0.0 - step :: Float - step = 1 / 1764 diff --git a/README.md b/README.md index 245686d..9912b10 100644 --- a/README.md +++ b/README.md @@ -4,21 +4,14 @@ This project contains Haskell bindings to the [dear-imgui](https://github.com/ocornut/imgui) [implot](https://github.com/epezent/implot) project. -The [demo](./Main.hs) shows a LinePlot of a pulseaudio input: - -![](./demo.png) - ## Contribute -To build the project and the demo, make sure these projects are cloned: - -- ./github.com/haskell-game/dear-imgui.hs/ -- ./github.com/TristanCacqueray/pipes-pulse-simple/ -- ./github.com/TristanCacqueray/dear-implot.hs/ - -Then run: +To build the project, make sure the subprojects: ```ShellSession -$ cabal build -$ cabal run test +$ git submodule update --init +``` +then +```ShellSession +$ cabal build ``` diff --git a/cabal.project b/cabal.project index e9879f8..deb98e2 100644 --- a/cabal.project +++ b/cabal.project @@ -1,2 +1,5 @@ -packages: . ../../haskell-game/dear-imgui.hs/ ../pipes-pulse-simple/ -flags: +sdl +opengl2 -vulkan +packages: *.cabal +package dear-imgui + flags: -sdl +glfw +package dear-implot + ghc-options: -Wall -Wcompat -fno-warn-unused-do-bind diff --git a/dear-implot.cabal b/dear-implot.cabal index 12fc48e..b83326c 100644 --- a/dear-implot.cabal +++ b/dear-implot.cabal @@ -5,6 +5,7 @@ build-type: Simple library exposed-modules: + DearImGui.Raw.Plot DearImGui.Plot hs-source-dirs: src @@ -25,23 +26,7 @@ library build-depends: base , StateVar , containers - , dear-imgui + , dear-imgui >= 1.4.0 , inline-c , inline-c-cpp , managed - -executable test - main-is: Main.hs - default-language: Haskell2010 - build-depends: base - , binary - , bytestring - , dear-imgui - , dear-implot - , gl - , managed - , pipes - , pipes-safe - , sdl2 - , pipes-pulse-simple - ghc-options: -Wall diff --git a/demo.png b/demo.png deleted file mode 100644 index 3ae7a4d..0000000 Binary files a/demo.png and /dev/null differ diff --git a/src/DearImGui/Plot.hs b/src/DearImGui/Plot.hs index 096ab2b..db918ab 100644 --- a/src/DearImGui/Plot.hs +++ b/src/DearImGui/Plot.hs @@ -1,56 +1,85 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} --- | DearImGui bindings for https://github.com/epezent/implot -module DearImGui.Plot where +{-| +Module: DearImGui.Plot -import Control.Monad.IO.Class (MonadIO, liftIO) +Main ImPlot module, exporting the functions to make plots happen in Gui. +-} + +module DearImGui.Plot + ( -- * Context Creation and Access + Raw.Plot.PlotContext(..) + , Raw.Plot.createPlotContext + , Raw.Plot.destroyPlotContext + , Raw.Plot.getCurrentPlotContext + , Raw.Plot.setCurrentPlotContext + + -- * Demo so you can play with all features + , Raw.Plot.showPlotDemoWindow + ) + where + +-- base +import Control.Monad + ( when ) +import Data.Bool +import Data.Foldable + ( foldl' ) import Foreign import Foreign.C -import qualified Language.C.Inline as C -import qualified Language.C.Inline.Cpp as Cpp +import qualified GHC.Foreign as Foreign +import System.IO + ( utf8 ) -C.context (Cpp.cppCtx <> C.bsCtx) -C.include "implot.h" -Cpp.using "namespace ImPlot" +-- dear-imgui +import DearImGui.Enums +import DearImGui.Structs +import qualified DearImGui.Raw as Raw +import qualified DearImGui.Raw.Plot as Raw.Plot +import qualified DearImGui.Raw.Font as Raw.Font +import qualified DearImGui.Raw.ListClipper as Raw.ListClipper -newtype Context = Context (Ptr ()) +-- managed +import qualified Control.Monad.Managed as Managed -createContext :: MonadIO m => m Context -createContext = liftIO do - Context <$> [C.exp| void* { CreateContext() } |] +-- StateVar +import Data.StateVar + ( HasGetter(get), HasSetter, ($=!) ) -destroyContext :: MonadIO m => Context -> m () -destroyContext (Context contextPtr) = liftIO do - [C.exp| void { DestroyContext((ImPlotContext*)$(void* contextPtr)); } |] +-- transformers +import Control.Monad.IO.Class + ( MonadIO, liftIO ) -beginPlot :: MonadIO m => String -> m Bool -beginPlot name = liftIO do - withCString name \namePtr -> - (0 /=) <$> [C.exp| bool { BeginPlot($(char* namePtr)) } |] +-- unliftio +import UnliftIO (MonadUnliftIO) +import UnliftIO.Exception (bracket, bracket_) -endPlot :: MonadIO m => m () -endPlot = liftIO do - [C.exp| void { EndPlot(); } |] +-- vector +import qualified Data.Vector as V +import qualified Data.Vector.Storable as VS +import qualified Data.Vector.Unboxed as VU plotLine :: (MonadIO m) => String -> [Float] -> [Float] -> m () -plotLine desc xs ys = liftIO $ do +plotLine label 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) ) } |] + Raw.Plot.plotLine label xsPtr ysPtr size setNextPlotLimits :: MonadIO m => (Double, Double) -> (Double, Double) -> m () -setNextPlotLimits (minX, maxX) (minY, maxY) = - liftIO [C.exp| void { SetNextPlotLimits( $(double minX'), $(double maxX'), $(double minY'), $(double maxY') ) } |] +setNextPlotLimits (minX, maxX) (minY, maxY) = liftIO $ do + Raw.Plot.setNextPlotLimits (minX', maxX') (minY', maxY') where minX' = realToFrac minX maxX' = realToFrac maxX diff --git a/src/DearImGui/Plot/Context.hs b/src/DearImGui/Plot/Context.hs new file mode 100644 index 0000000..2a0e366 --- /dev/null +++ b/src/DearImGui/Plot/Context.hs @@ -0,0 +1,55 @@ +{-# language DerivingStrategies #-} +{-# language DuplicateRecordFields #-} +{-# language GeneralizedNewtypeDeriving #-} +{-# language NamedFieldPuns #-} +{-# language OverloadedStrings #-} +{-# language PatternSynonyms #-} +{-# language TemplateHaskell #-} + +module DearImGui.Context where + +-- containers +import qualified Data.Map.Strict as Map + +-- inline-c +import Language.C.Inline.Context + ( Context(..) ) +import Language.C.Types + ( pattern TypeName ) + +-- dear-imgui +import DearImGui.Structs + +-- dear-imgui-generator +import DearImGui.Generator + ( enumerationsTypesTable ) + +-------------------------------------------------------------------------------- + +imguiContext :: Context +imguiContext = mempty + { ctxTypesTable = enumerationsTypesTable <> + Map.fromList + [ ( TypeName "ImVec2", [t| ImVec2 |] ) + , ( TypeName "ImVec3", [t| ImVec3 |] ) + , ( TypeName "ImVec4", [t| ImVec4 |] ) + , ( TypeName "ImU32", [t| ImU32 |] ) + , ( TypeName "ImGuiID", [t| ImGuiID |] ) + , ( TypeName "ImWchar", [t| ImWchar |] ) + , ( TypeName "ImDrawList", [t| ImDrawList |] ) + , ( TypeName "ImGuiContext", [t| ImGuiContext |] ) + , ( TypeName "ImFont", [t| ImFont |] ) + , ( TypeName "ImFontConfig", [t| ImFontConfig |] ) + , ( TypeName "ImFontGlyphRangesBuilder", [t| ImFontGlyphRangesBuilder |] ) + , ( TypeName "ImGuiListClipper", [t| ImGuiListClipper |] ) + , ( TypeName "ImGuiTableSortSpecs", [t| ImGuiTableSortSpecs |] ) + ] + } + +implotContext :: Context +implotContext = mempty + { ctxTypesTable = + Map.fromList + [ ( TypeName "ImPlotContext", [t| ImPlotContext |] ) + ] + } diff --git a/src/DearImGui/Plot/Enums.hs b/src/DearImGui/Plot/Enums.hs new file mode 100644 index 0000000..597a14b --- /dev/null +++ b/src/DearImGui/Plot/Enums.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} + +module DearImGui.Enums where + +-- base +import GHC.Exts + ( proxy# ) +import GHC.TypeNats + ( Nat, KnownNat, natVal' ) +import Numeric.Natural + ( Natural ) + +-- dear-imgui-generator +import DearImGui.Plot.Generator + ( declareEnumerations ) + +-------------------------------------------------------------------------------- + +class KnownNat ( Count a ) => FiniteEnum a where + type Count a :: Nat + count :: Natural + count = natVal' @( Count a ) proxy# + +declareEnumerations ''FiniteEnum ''Count diff --git a/src/DearImGui/Plot/Generator.hs b/src/DearImGui/Plot/Generator.hs new file mode 100644 index 0000000..b3d5083 --- /dev/null +++ b/src/DearImGui/Plot/Generator.hs @@ -0,0 +1,193 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} + +module DearImGui.Generator + ( declareEnumerations, enumerationsTypesTable ) + where + +-- base +import Control.Arrow + ( second ) +import Data.Bits + ( Bits ) +import Data.Foldable + ( toList ) +import qualified Data.List.NonEmpty as NonEmpty + ( head ) +import Data.String + ( fromString ) +import Data.Traversable + ( for ) +import Foreign.Storable + ( Storable ) + +-- containers +import Data.Map.Strict + ( Map ) +import qualified Data.Map.Strict as Map + ( fromList ) + +-- directory +import System.Directory + ( canonicalizePath ) + +-- filepath +import System.FilePath + ( takeDirectory ) + +-- inline-c +import qualified Language.C.Types as InlineC + ( TypeSpecifier(TypeName) ) + +-- megaparsec +import qualified Text.Megaparsec as Megaparsec + +-- template-haskell +import qualified Language.Haskell.TH as TH +import qualified Language.Haskell.TH.Syntax as TH + +-- text +import qualified Data.Text as Text +import qualified Data.Text.IO as Text + ( readFile ) + +-- dear-imgui-generator +import qualified DearImGui.Generator.Parser as Parser + ( headers ) +import DearImGui.Generator.Tokeniser + ( Tok, tokenise ) +import DearImGui.Generator.Types + ( Comment(..), Enumeration(..), Headers(..) + , generateNames + ) + +-------------------------------------------------------------------------------- +-- Obtaining parsed header data. + +headers :: Headers ( TH.Name, TH.Name ) +headers = $( do + currentPath <- TH.loc_filename <$> TH.location + basicHeaders <- TH.runIO do + headersPath <- canonicalizePath ( takeDirectory currentPath <> "/../../imgui/imgui.h" ) + headersSource <- Text.readFile headersPath + tokensImGui <- case tokenise headersSource of + Left err -> error ( "Couldn't tokenise Dear ImGui headers:\n\n" <> show err ) + Right toks -> pure toks + headersPath <- canonicalizePath ( takeDirectory currentPath <> "/../../implot/implot.h" ) + headersSource <- Text.readFile headersPath + tokensImPlot <- case tokenise headersSource of + Left err -> error ( "Couldn't tokenise Dear ImPlot headers:\n\n" <> show err ) + Right toks -> pure toks + let tokens = tokensImGui<>tokensImPlot + case Megaparsec.parse Parser.headers "" tokens of + Left err -> do + let + errorPos :: Int + errorPos = Megaparsec.errorOffset . NonEmpty.head $ Megaparsec.bundleErrors err + prev, rest :: [ Tok ] + ( prev, rest ) = second ( take 15 ) . splitAt 5 . drop ( errorPos - 5 ) $ tokens + error $ + "Couldn't parse Dear ImGui headers:\n\n" <> + ( unlines ( map Megaparsec.parseErrorPretty . toList $ Megaparsec.bundleErrors err ) ) <> "\n" <> + ( unlines ( map show prev ) <> "\n\n" <> unlines ( map show rest ) ) + Right res -> pure res + TH.lift $ generateNames basicHeaders + ) + +-------------------------------------------------------------------------------- +-- Generating TH splices. + +enumerationsTypesTable :: Map InlineC.TypeSpecifier ( TH.Q TH.Type ) +enumerationsTypesTable = Map.fromList . map mkTypePair $ enums headers + where + mkTypePair :: Enumeration ( TH.Name, TH.Name ) -> ( InlineC.TypeSpecifier, TH.Q TH.Type ) + mkTypePair ( Enumeration { enumName, enumTypeName } ) = + ( InlineC.TypeName $ fromString ( Text.unpack enumName ) + , TH.conT ( fst $ enumTypeName ) + ) + +declareEnumerations :: TH.Name -> TH.Name -> TH.Q [ TH.Dec ] +declareEnumerations finiteEnumName countName = do + concat <$> mapM ( declareEnumeration finiteEnumName countName ) ( enums headers ) + +declareEnumeration :: TH.Name -> TH.Name -> Enumeration ( TH.Name, TH.Name ) -> TH.Q [ TH.Dec ] +declareEnumeration finiteEnumName countName ( Enumeration {..} ) = do + let + tyName, conName :: TH.Name + ( tyName, conName ) = enumTypeName + isFlagEnum :: Bool + isFlagEnum = "Flags" `Text.isInfixOf` enumName + newtypeCon :: TH.Q TH.Con + newtypeCon = + TH.normalC conName + [ TH.bangType + ( TH.bang TH.noSourceUnpackedness TH.noSourceStrictness ) + ( TH.conT underlyingType ) + ] + classes :: [ TH.Q TH.Type ] + classes + | isFlagEnum + = map TH.conT [ ''Eq, ''Ord, ''Show, ''Storable, ''Bits ] + | otherwise + = map TH.conT [ ''Eq, ''Ord, ''Show, ''Storable ] + derivClause :: TH.Q TH.DerivClause + derivClause = TH.derivClause ( Just TH.NewtypeStrategy ) classes + + newtypeDecl <- +#if MIN_VERSION_template_haskell(2,18,0) + ( if null docs + then TH.newtypeD + else + \ ctx name bndrs kd con derivs -> + TH.newtypeD_doc ctx name ( fmap pure bndrs ) ( fmap pure kd ) ( con, Nothing, [] ) derivs + ( Just . Text.unpack . Text.unlines . coerce $ docs ) + ) +#else + TH.newtypeD +#endif + ( pure [] ) tyName [] Nothing newtypeCon [ derivClause ] + + mbAddFiniteEnumInst <- + if hasExplicitCount + then do + finiteEnumInst <- + TH.instanceD ( pure [] ) ( TH.appT ( TH.conT finiteEnumName ) ( TH.conT tyName ) ) + [ TH.tySynInstD ( TH.TySynEqn Nothing + <$> TH.appT ( TH.conT countName ) ( TH.conT tyName ) + <*> TH.litT ( TH.numTyLit enumSize ) + ) + ] + pure ( finiteEnumInst : ) + else pure id + + synonyms <- for patterns \ ( patternName, patternValue, CommentText _patDoc ) -> do + let + patNameStr :: String + patNameStr = Text.unpack patternName + patName <- TH.newName patNameStr + patSynSig <- TH.patSynSigD patName ( TH.conT tyName ) + pat <- +#if MIN_VERSION_template_haskell(2,18,0) + ( if Text.null _patDoc + then TH.patSynD + else + \ nm args dir pat -> + TH.patSynD_doc nm args dir pat + ( Just $ Text.unpack patDoc ) [] + ) +#else + TH.patSynD +#endif + patName ( TH.prefixPatSyn [] ) TH.implBidir + ( TH.conP conName [ TH.litP $ TH.integerL patternValue ] ) + pure ( patSynSig, pat ) + + pure ( newtypeDecl : mbAddFiniteEnumInst ( unpairs synonyms ) ) + +unpairs :: [ ( a, a ) ] -> [ a ] +unpairs [] = [] +unpairs ( ( x, y ) : as ) = x : y : unpairs as diff --git a/src/DearImGui/Plot/Structs.hs b/src/DearImGui/Plot/Structs.hs new file mode 100644 index 0000000..bd2f887 --- /dev/null +++ b/src/DearImGui/Plot/Structs.hs @@ -0,0 +1,136 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE CPP #-} + +module DearImGui.Plot.Structs where + +-- base +import Data.Word + ( Word32 +#ifndef IMGUI_USE_WCHAR32 + , Word16 +#endif + ) + +import Foreign + ( Storable(..), castPtr, plusPtr ) + +-------------------------------------------------------------------------------- +data ImVec2 = ImVec2 { x, y :: {-# unpack #-} !Float } + deriving (Show) + + +instance Storable ImVec2 where + sizeOf ~ImVec2{x, y} = sizeOf x + sizeOf y + + alignment _ = 0 + + poke ptr ImVec2{ x, y } = do + poke (castPtr ptr `plusPtr` (sizeOf x * 0)) x + poke (castPtr ptr `plusPtr` (sizeOf x * 1)) y + + peek ptr = do + x <- peek (castPtr ptr ) + y <- peek (castPtr ptr `plusPtr` (sizeOf x * 1)) + return ImVec2{ x, y } + + +data ImVec3 = ImVec3 { x, y, z :: {-# unpack #-} !Float } + deriving (Show) + + +instance Storable ImVec3 where + sizeOf ~ImVec3{x, y, z} = sizeOf x + sizeOf y + sizeOf z + + alignment _ = 0 + + poke ptr ImVec3{ x, y, z } = do + poke (castPtr ptr `plusPtr` (sizeOf x * 0)) x + poke (castPtr ptr `plusPtr` (sizeOf x * 1)) y + poke (castPtr ptr `plusPtr` (sizeOf x * 2)) z + + peek ptr = do + x <- peek (castPtr ptr ) + y <- peek (castPtr ptr `plusPtr` (sizeOf x * 1)) + z <- peek (castPtr ptr `plusPtr` (sizeOf x * 2)) + return ImVec3{ x, y, z } + + +data ImVec4 = ImVec4 { x, y, z, w :: {-# unpack #-} !Float } + deriving (Show) + + +instance Storable ImVec4 where + sizeOf ~ImVec4{x, y, z, w} = sizeOf x + sizeOf y + sizeOf z + sizeOf w + + alignment _ = 0 + + poke ptr ImVec4{ x, y, z, w } = do + poke (castPtr ptr `plusPtr` (sizeOf x * 0)) x + poke (castPtr ptr `plusPtr` (sizeOf x * 1)) y + poke (castPtr ptr `plusPtr` (sizeOf x * 2)) z + poke (castPtr ptr `plusPtr` (sizeOf x * 3)) w + + peek ptr = do + x <- peek (castPtr ptr ) + y <- peek (castPtr ptr `plusPtr` (sizeOf x * 1)) + z <- peek (castPtr ptr `plusPtr` (sizeOf x * 2)) + w <- peek (castPtr ptr `plusPtr` (sizeOf x * 3)) + return ImVec4{ x, y, z, w } + +-------------------------------------------------------------------------------- + +-- | DearImGui context handle. +data ImGuiContext + +-- | Individual font handle. +data ImFont + +-- | Font configuration handle. +data ImFontConfig + +-- | Glyph ranges builder handle. +data ImFontGlyphRangesBuilder + +-- | Opaque DrawList handle. +data ImDrawList + +-- | 'DearImGui.Raw.ListClipper.ListClipper' pointer tag. +data ImGuiListClipper + +-- | A unique ID used by widgets (typically the result of hashing a stack of string) +-- unsigned Integer (same as ImU32) +type ImGuiID = Word32 + +-- | 32-bit unsigned integer (often used to store packed colors). +type ImU32 = Word32 + +type ImS16 = Int16 + +-- | Single wide character (used mostly in glyph management) +#ifdef IMGUI_USE_WCHAR32 +type ImWchar = Word32 +#else +type ImWchar = Word16 +#endif + +-------------------------------------------------------------------------------- + +-- | DearImPlot context handle +data ImPlotContext + +-- | Double precision version of ImVec2 used by ImPlot. Extensible by end users +data ImPlotPoint + +-- | Range defined by a min/max value. +data ImPlotRange + +-- | Combination of two range limits for X and Y axes. Also an AABB defined by Min()/Max(). +data ImPlotRect + +-- | Plot style structure +data ImPlotStyle + +-- | Input mapping structure. Default values listed. See also MapInputDefault, MapInputReverse. +data ImPlotInputMap + diff --git a/src/DearImGui/Raw/Plot.hs b/src/DearImGui/Raw/Plot.hs new file mode 100644 index 0000000..c142c60 --- /dev/null +++ b/src/DearImGui/Raw/Plot.hs @@ -0,0 +1,106 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ViewPatterns #-} + +{-| +Module: DearImGui.Raw.Plot + +Main ImPlot Raw module. +-} +module DearImGui.Raw.Plot + ( PlotContext(..) + , createPlotContext + , destroyPlotContext + , getCurrentPlotContext + , setCurrentPlotContext + + , showPlotDemoWindow + + , beginPlot + , endPlot + + , plotLine + , setNextPlotLimits + ) where + +-- base +import Control.Monad.IO.Class + ( MonadIO, liftIO ) +import Foreign +import Foreign.C +import System.IO.Unsafe + ( unsafePerformIO ) + +-- dear-imgui +import DearImGui.Context + ( imguiContext, implotContext ) +import DearImGui.Enums +import DearImGui.Structs +import DearImGui.Raw.DrawList (DrawList(..)) + +-- inline-c +import qualified Language.C.Inline as C + +-- inline-c-cpp +import qualified Language.C.Inline.Cpp as Cpp + +C.context (Cpp.cppCtx <> C.bsCtx <> imguiContext <> implotContext) +C.include "imgui.h" +C.include "implot.h" +Cpp.using "namespace ImPlot" + + +-- | Wraps @ImPlotContext*@. +newtype PlotContext = PlotContext (Ptr ImPlotContext) + + +-- | Wraps @ImPlot::CreateContext()@. +createPlotContext :: (MonadIO m) => m PlotContext +createPlotContext = liftIO do + PlotContext <$> [C.exp| ImPlotContext* { CreateContext() } |] + +-- | Wraps @ImPlot::DestroyPlotContext()@. +destroyPlotContext :: (MonadIO m) => PlotContext -> m () +destroyPlotContext (PlotContext contextPtr) = liftIO do + [C.exp| void { DestroyContext($(ImPlotContext* contextPtr)); } |] + +-- | Wraps @ImPlot::GetCurrentPlotContext()@. +getCurrentPlotContext :: MonadIO m => m PlotContext +getCurrentPlotContext = liftIO do + PlotContext <$> [C.exp| ImPlotContext* { GetCurrentContext() } |] + + +-- | Wraps @ImPlot::SetCurrentPlotContext()@. +setCurrentPlotContext :: MonadIO m => PlotContext -> m () +setCurrentPlotContext (PlotContext contextPtr) = liftIO do + [C.exp| void { SetCurrentContext($(ImPlotContext* contextPtr)) } |] + +-- | Create demo window. Demonstrate most ImGui features. Call this to learn +-- about the library! Try to make it always available in your application! +showPlotDemoWindow :: (MonadIO m) => m () +showPlotDemoWindow = liftIO do + [C.exp| void { ShowDemoWindow(); } |] + +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 => CString -> Ptr Float -> Ptr Float -> CInt -> m () +plotLine label xsPtr ysPtr size = liftIO do + [C.exp| void { PlotLine( $(char* descPtr), $(float *xsPtr), $(float *ysPtr), $(int size) ) } |] + +setNextPlotLimits :: MonadIO m => (Double, Double) -> (Double, Double) -> m () +setNextPlotLimits (minX, maxX) (minY, maxY) = liftIO do + [C.exp| void { SetNextPlotLimits( $(double minX), $(double maxX), $(double minY), $(double maxY) ) } |]