initial version based on bare minimum-fork for structure
This commit is contained in:
parent
1fc62e7fc1
commit
d2099fd382
GPG Key ID:
AC88BB432537313A
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
108
Main.hs
108
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
|
||||
19
README.md
19
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:
|
||||
|
||||
|
||||
|
||||
## 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
|
||||
```
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 |] )
|
||||
]
|
||||
}
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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) ) } |]
|
||||
Loading…
Reference in New Issue