mirror of
https://github.com/Drezil/dear-implot.hs.git
synced 2024-11-14 17:07:01 +00:00
Add demo
This commit is contained in:
parent
bb1bb02e1c
commit
1fc62e7fc1
1
.gitignore
vendored
Normal file
1
.gitignore
vendored
Normal file
@ -0,0 +1 @@
|
|||||||
|
/imgui.ini
|
45
Main.hs
45
Main.hs
@ -1,18 +1,28 @@
|
|||||||
{-# LANGUAGE BlockArguments #-}
|
{-# LANGUAGE BlockArguments #-}
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE RankNTypes #-}
|
||||||
|
|
||||||
module Main (main) where
|
module Main (main) where
|
||||||
|
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
import Control.Monad.Managed
|
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
|
||||||
import DearImGui.OpenGL2
|
import DearImGui.OpenGL2
|
||||||
import qualified DearImGui.Plot as ImPlot
|
import qualified DearImGui.Plot as ImPlot
|
||||||
import DearImGui.SDL
|
import DearImGui.SDL
|
||||||
import DearImGui.SDL.OpenGL
|
import DearImGui.SDL.OpenGL
|
||||||
|
import GHC.Float (int2Float)
|
||||||
|
import GHC.Int (Int16)
|
||||||
import Graphics.GL
|
import Graphics.GL
|
||||||
|
import Pipes
|
||||||
|
import Pipes.PulseSimple
|
||||||
|
import Pipes.Safe (runSafeT)
|
||||||
import SDL
|
import SDL
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
@ -42,21 +52,43 @@ main = do
|
|||||||
-- Initialize ImGui's OpenGL backend
|
-- Initialize ImGui's OpenGL backend
|
||||||
_ <- managed_ $ bracket_ openGL2Init openGL2Shutdown
|
_ <- managed_ $ bracket_ openGL2Init openGL2Shutdown
|
||||||
|
|
||||||
liftIO $ mainLoop win
|
liftIO $ runSafeT (runEffect (readPulse "dear-pulse" Nothing 25 >-> mainLoop win))
|
||||||
|
|
||||||
mainLoop :: Window -> IO ()
|
-- | 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
|
mainLoop win = do
|
||||||
-- Process the event loop
|
-- Process the event loop
|
||||||
untilNothingM pollEventWithImGui
|
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
|
-- Tell ImGui we're starting a new frame
|
||||||
openGL2NewFrame
|
openGL2NewFrame
|
||||||
sdl2NewFrame win
|
sdl2NewFrame win
|
||||||
newFrame
|
newFrame
|
||||||
|
|
||||||
-- Build the GUI
|
-- Build the GUI
|
||||||
bracket_ (ImPlot.beginPlot "Hello, ImPlot!") ImPlot.endPlot do
|
ImPlot.setNextPlotLimits (0, 1) (-1, 1)
|
||||||
ImPlot.plotLine "test" [0.0, 0.1, 0.2, 0.3, 0.4] [0.1, 0.2, 0.3, 0.1, 0.5]
|
liftIO $ bracket_ (ImPlot.beginPlot "Audio") ImPlot.endPlot do
|
||||||
|
ImPlot.plotLine "pulse-input" xs samples
|
||||||
|
|
||||||
-- Render
|
-- Render
|
||||||
glClear GL_COLOR_BUFFER_BIT
|
glClear GL_COLOR_BUFFER_BIT
|
||||||
@ -69,3 +101,8 @@ mainLoop win = do
|
|||||||
mainLoop win
|
mainLoop win
|
||||||
where
|
where
|
||||||
untilNothingM m = m >>= maybe (return ()) (\_ -> untilNothingM m)
|
untilNothingM m = m >>= maybe (return ()) (\_ -> untilNothingM m)
|
||||||
|
xs = range
|
||||||
|
range :: [Float]
|
||||||
|
range = take 1764 $ iterate' (+ step) 0.0
|
||||||
|
step :: Float
|
||||||
|
step = 1 / 1764
|
||||||
|
22
README.md
22
README.md
@ -1,2 +1,24 @@
|
|||||||
# implot binding
|
# implot binding
|
||||||
|
|
||||||
|
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:
|
||||||
|
|
||||||
|
```ShellSession
|
||||||
|
$ cabal build
|
||||||
|
$ cabal run test
|
||||||
|
```
|
||||||
|
@ -1,2 +1,2 @@
|
|||||||
packages: . ../../haskell-game/dear-imgui.hs/
|
packages: . ../../haskell-game/dear-imgui.hs/ ../pipes-pulse-simple/
|
||||||
flags: +sdl +opengl2 -vulkan
|
flags: +sdl +opengl2 -vulkan
|
||||||
|
@ -22,17 +22,26 @@ library
|
|||||||
include-dirs:
|
include-dirs:
|
||||||
implot
|
implot
|
||||||
imgui
|
imgui
|
||||||
build-depends:
|
build-depends: base
|
||||||
base
|
, StateVar
|
||||||
, containers
|
, containers
|
||||||
, managed
|
, dear-imgui
|
||||||
, inline-c
|
, inline-c
|
||||||
, inline-c-cpp
|
, inline-c-cpp
|
||||||
, StateVar
|
, managed
|
||||||
, dear-imgui
|
|
||||||
|
|
||||||
executable test
|
executable test
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
build-depends: base, sdl2, gl, dear-imgui, dear-implot, managed
|
build-depends: base
|
||||||
|
, binary
|
||||||
|
, bytestring
|
||||||
|
, dear-imgui
|
||||||
|
, dear-implot
|
||||||
|
, gl
|
||||||
|
, managed
|
||||||
|
, pipes
|
||||||
|
, pipes-safe
|
||||||
|
, sdl2
|
||||||
|
, pipes-pulse-simple
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
|
Loading…
Reference in New Issue
Block a user