initial version based on bare minimum-fork for structure

.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

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.

Main.hs

@@ -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

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:
+To build the project, make sure the subprojects:
-
-- ./github.com/haskell-game/dear-imgui.hs/
-- ./github.com/TristanCacqueray/pipes-pulse-simple/
-- ./github.com/TristanCacqueray/dear-implot.hs/
-
-Then run:
 
 ```ShellSession
-$ cabal build
+$ git submodule update --init
-$ cabal run test
+```
+then
+```ShellSession
+$ cabal build
 ```

cabal.project

@@ -1,2 +1,5 @@
-packages: . ../../haskell-game/dear-imgui.hs/ ../pipes-pulse-simple/
+packages: *.cabal
-flags: +sdl +opengl2 -vulkan
+package dear-imgui
+  flags: -sdl +glfw
+package dear-implot
+  ghc-options: -Wall -Wcompat -fno-warn-unused-do-bind

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

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 GHC.Foreign as Foreign
-import qualified Language.C.Inline.Cpp as Cpp
+import System.IO
+  ( utf8 )
 
-C.context (Cpp.cppCtx <> C.bsCtx)
+-- dear-imgui
-C.include "implot.h"
+import DearImGui.Enums
-Cpp.using "namespace ImPlot"
+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
+-- StateVar
-createContext = liftIO do
+import Data.StateVar
-  Context <$> [C.exp| void* { CreateContext() } |]
+  ( HasGetter(get), HasSetter, ($=!) )
 
-destroyContext :: MonadIO m => Context -> m ()
+-- transformers
-destroyContext (Context contextPtr) = liftIO do
+import Control.Monad.IO.Class
-  [C.exp| void { DestroyContext((ImPlotContext*)$(void* contextPtr)); } |]
+  ( MonadIO, liftIO )
 
-beginPlot :: MonadIO m => String -> m Bool
+-- unliftio
-beginPlot name = liftIO do
+import UnliftIO (MonadUnliftIO)
-  withCString name \namePtr ->
+import UnliftIO.Exception (bracket, bracket_)
-    (0 /=) <$> [C.exp| bool { BeginPlot($(char* namePtr)) } |]
 
-endPlot :: MonadIO m => m ()
+-- vector
-endPlot = liftIO do
+import qualified Data.Vector as V
-  [C.exp| void { EndPlot(); } |]
+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) =
+setNextPlotLimits (minX, maxX) (minY, maxY) = liftIO $ do
-  liftIO [C.exp| void { SetNextPlotLimits( $(double minX'), $(double maxX'), $(double minY'), $(double maxY') ) } |]
+  Raw.Plot.setNextPlotLimits (minX', maxX') (minY', maxY')
   where
     minX' = realToFrac minX
     maxX' = realToFrac maxX

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

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

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

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
+

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