dynamic-graph (empty) → 0.1.0.0
raw patch · 13 files changed
+441/−0 lines, 13 filesdep +GLFW-bdep +GLUtildep +OpenGLsetup-changed
Dependencies added: GLFW-b, GLUtil, OpenGL, base, either, pipes, transformers
Files
- Graphics/DynamicGraph/SimpleLine.hs +66/−0
- Graphics/DynamicGraph/TextureLine.hs +97/−0
- Graphics/DynamicGraph/Util.hs +19/−0
- Graphics/DynamicGraph/Waterfall.hs +142/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- dynamic-graph.cabal +30/−0
- shaders/simple_line.frag +6/−0
- shaders/simple_line.vert +7/−0
- shaders/texture_line.frag +6/−0
- shaders/texture_line.vert +9/−0
- shaders/waterfall.frag +15/−0
- shaders/waterfall.vert +12/−0
+ Graphics/DynamicGraph/SimpleLine.hs view
@@ -0,0 +1,66 @@+{-| Draw and update line graphs with OpenGL.++ Based on: <https://en.wikibooks.org/wiki/OpenGL_Programming/Scientific_OpenGL_Tutorial_01>++ You probably want to use "Graphics.DynamicGraph.TextureLine" as it is better.+-}+module Graphics.DynamicGraph.SimpleLine (+ graph+ ) where++import Control.Monad+import Graphics.UI.GLFW as G+import Graphics.Rendering.OpenGL+import Graphics.GLUtil++import Control.Monad.Trans.Class+import Control.Monad.Trans.Either+import Foreign.Storable+import Foreign.Ptr++import Paths_dynamic_graph++{-| @(graph windowWidth windowHeight bufLen)@ creates a window+ of width @windowWidth@ and height @windowHeight@ for displaying a line+ graph. A function is returned for updating the line graph. It takes+ a pointer to a c array of length @bufLen@ consisting of pairs of \<x,+ y\> coordinates for updating the graph as this is the format that+ OpenGL requires.+-}+graph :: Int -> Int -> Int -> EitherT String IO (Ptr GLfloat -> IO ())+graph width height bufLen = do+ res' <- lift $ createWindow width height "" Nothing Nothing+ win <- maybe (left "error creating window") return res'++ lift $ do+ makeContextCurrent (Just win)++ --Load the shaders+ vertFN <- getDataFileName "shaders/simple_line.vert"+ fragFN <- getDataFileName "shaders/simple_line.frag"+ vs <- loadShader VertexShader vertFN+ fs <- loadShader FragmentShader fragFN+ p <- linkShaderProgram [vs, fs]++ --Set stuff+ clearColor $= Color4 1 1 1 1+ currentProgram $= Just p++ ab <- genObjectName++ loc <- get $ attribLocation p "coord"++ let stride = fromIntegral $ sizeOf (undefined::GLfloat) * 2+ vad = VertexArrayDescriptor 2 Float stride offset0++ bindBuffer ArrayBuffer $= Just ab+ vertexAttribArray loc $= Enabled+ vertexAttribPointer loc $= (ToFloat, vad)++ return $ \ptr -> do+ makeContextCurrent (Just win)+ clear [ColorBuffer]+ bufferData ArrayBuffer $= (fromIntegral $ 2 * bufLen * sizeOf (undefined :: GLfloat), ptr, StaticDraw)+ drawArrays LineStrip 0 (fromIntegral bufLen)+ swapBuffers win+
+ Graphics/DynamicGraph/TextureLine.hs view
@@ -0,0 +1,97 @@+{-| Draw and update line graphs with OpenGL.++ Based on: <https://en.wikibooks.org/wiki/OpenGL_Programming/Scientific_OpenGL_Tutorial_02>+-}+module Graphics.DynamicGraph.TextureLine (+ graph,+ graphAsConsumer+ ) where++import Control.Monad+import Graphics.UI.GLFW as G+import Graphics.Rendering.OpenGL+import Graphics.GLUtil++import Control.Monad.Trans.Class+import Control.Monad.Trans.Either+import Foreign.Storable+import Foreign.Marshal.Array++import Pipes++import Paths_dynamic_graph++{-| @(graph windowWidth windowHeight samples xResolution)@ creates a window+ of width @windowWidth@ and height @windowHeight@ for displaying a line+ graph. A function is returned for updating the line graph. It takes an+ instance of IsPixelData of length @samples@ as the y values and draws+ a line graph with @xResolution@ vertices. +-}+graph :: IsPixelData a => Int -> Int -> Int -> Int -> EitherT String IO (a -> IO ())+graph width height samples xResolution = do+ res' <- lift $ createWindow width height "" Nothing Nothing+ win <- maybe (left "error creating window") return res'++ lift $ makeContextCurrent (Just win)+ mtu <- lift $ get maxVertexTextureImageUnits+ when (mtu <= 0) $ left "No texture units accessible from vertex shader"++ lift $ do+ --Load the shaders+ vertFN <- getDataFileName "shaders/texture_line.vert"+ fragFN <- getDataFileName "shaders/texture_line.frag"+ vs <- loadShader VertexShader vertFN+ fs <- loadShader FragmentShader fragFN+ p <- linkShaderProgram [vs, fs]++ --Set stuff+ clearColor $= Color4 1 1 1 1+ currentProgram $= Just p++ ab <- genObjectName ++ loc <- get $ attribLocation p "coord"++ let stride = fromIntegral $ sizeOf (undefined::GLfloat) + vad = VertexArrayDescriptor 1 Float stride offset0++ bindBuffer ArrayBuffer $= Just ab+ vertexAttribArray loc $= Enabled+ vertexAttribPointer loc $= (ToFloat, vad)++ let xCoords :: [GLfloat]+ xCoords = take xResolution $ iterate (+ 2 / fromIntegral xResolution) (-1)+ withArray xCoords $ \ptr -> + bufferData ArrayBuffer $= (fromIntegral $ sizeOf(undefined::GLfloat) * xResolution, ptr, StaticDraw)++ let yCoords :: [GLfloat]+ yCoords = take samples $ repeat 0++ --texture Texture2D $= Enabled+ to <- loadTexture (TexInfo (fromIntegral samples) 1 TexMono yCoords)+ + --activeTexture $= TextureUnit 0+ --loc <- get $ uniformLocation p "texture"+ --asUniform (0 :: GLint) loc ++ textureFilter Texture2D $= ((Linear', Nothing), Linear')++ textureWrapMode Texture2D S $= (Repeated, ClampToEdge)+ textureWrapMode Texture2D T $= (Repeated, ClampToEdge)++ return $ \vbd -> do+ makeContextCurrent (Just win)+ clear [ColorBuffer]++ reloadTexture to (TexInfo (fromIntegral samples) 1 TexMono vbd)++ drawArrays LineStrip 0 (fromIntegral xResolution)+ swapBuffers win++toConsumer :: Monad m => (a -> m b) -> Consumer a m ()+toConsumer func = forever $ await >>= lift . func++-- | Same as above, but returns a Consumer instead of an update function+graphAsConsumer :: IsPixelData a => Int -> Int -> Int -> Int -> EitherT String IO (Consumer a IO ())+graphAsConsumer width height samples xResolution = liftM toConsumer $ graph width height samples xResolution+
+ Graphics/DynamicGraph/Util.hs view
@@ -0,0 +1,19 @@+module Graphics.DynamicGraph.Util (+ setupGLFW+ ) where++import Control.Monad+import Control.Monad.Trans.Class+import Control.Monad.Trans.Either++import Graphics.UI.GLFW as G++-- | Utility function to setup GLFW for graph drawing+setupGLFW :: EitherT String IO ()+setupGLFW = do+ lift $ setErrorCallback $ Just $ \error msg -> do+ print error+ putStrLn msg++ res <- lift $ G.init+ unless res (left "error initializing glfw")
+ Graphics/DynamicGraph/Waterfall.hs view
@@ -0,0 +1,142 @@+{-| Draw and update waterfall plots with OpenGL. Useful for spectrograms.+-}+module Graphics.DynamicGraph.Waterfall (+ jet,+ jet_mod,+ hot,+ bw,+ wb,+ graph+ ) where++import Control.Monad+import Graphics.UI.GLFW as G+import Graphics.Rendering.OpenGL+import Graphics.GLUtil++import Control.Monad.Trans.Class+import Control.Monad.Trans.Either+import Foreign.Storable+import Foreign.Marshal.Array++import Pipes++import Paths_dynamic_graph++-- | The matlab / octave \"jet\" color map+jet :: [GLfloat]+jet = [0, 0, 0.5, 0, 0, 1, 0, 0.5, 1, 0, 1, 1, 0.5, 1, 0.5, 1, 1, 0, 1, 0.5, 0, 1, 0, 0, 0.5, 0, 0]++-- | \"jet\" modified so that low values are a darker blue+jet_mod :: [GLfloat]+jet_mod = [0, 0, 0.1, 0, 0, 1, 0, 0.5, 1, 0, 1, 1, 0.5, 1, 0.5, 1, 1, 0, 1, 0.5, 0, 1, 0, 0, 0.5, 0, 0]++-- | The matlab / octave \"hot\" color map+hot :: [GLfloat]+hot = [0, 0, 0, 1, 0, 0, 1, 1, 0, 1, 1, 1]++-- | Ranges from black to white+bw :: [GLfloat]+bw = [0, 0, 0, 1, 1, 1]++-- | Ranges from white to black+wb :: [GLfloat]+wb = [1, 1, 1, 0, 0, 0]++{-| @(graph windowWidth windowHeight width height colormap)@ creates+ a window of width @windowWidth@ and height @windowHeight@ for displaying+ a waterfall plot. A Consumer is returned for updating the waterfall+ plot. Feeding an instance of IsPixelData of length @width@ shifts all+ rows of the waterfall down and updates the top row with the data. The+ waterfall is @height@ rows high. @colorMap@ is used to map values to+ display color.+-}+graph :: IsPixelData a => Int -> Int -> Int -> Int -> [GLfloat] -> EitherT String IO (Consumer a IO ())+graph windowWidth windowHeight width height colorMap = do+ res' <- lift $ createWindow windowWidth windowHeight "" Nothing Nothing+ win <- maybe (left "error creating window") return res'++ lift $ do+ makeContextCurrent (Just win)++ --Load the shaders+ vertFN <- getDataFileName "shaders/waterfall.vert"+ fragFN <- getDataFileName "shaders/waterfall.frag"+ vs <- loadShader VertexShader vertFN+ fs <- loadShader FragmentShader fragFN+ p <- linkShaderProgram [vs, fs]++ --Set stuff+ currentProgram $= Just p++ ab <- genObjectName ++ loc <- get $ attribLocation p "coord"++ let stride = fromIntegral $ sizeOf (undefined::GLfloat) * 2+ vad = VertexArrayDescriptor 2 Float stride offset0++ bindBuffer ArrayBuffer $= Just ab+ vertexAttribArray loc $= Enabled+ vertexAttribPointer loc $= (ToFloat, vad)++ let xCoords :: [GLfloat]+ xCoords = [-1, -1, 1, -1, 1, 1, -1, 1]+ withArray xCoords $ \ptr -> + bufferData ArrayBuffer $= (fromIntegral $ sizeOf(undefined::GLfloat) * 8, ptr, StaticDraw)++ let yCoords :: [GLfloat]+ yCoords = take (width * height) $ repeat 0++ activeTexture $= TextureUnit 0+ texture Texture2D $= Enabled+ to <- loadTexture (TexInfo (fromIntegral width) (fromIntegral height) TexMono yCoords)+ + loc <- get $ uniformLocation p "texture"+ asUniform (0 :: GLint) loc ++ textureFilter Texture2D $= ((Linear', Nothing), Linear')+ textureWrapMode Texture2D S $= (Repeated, ClampToEdge)+ textureWrapMode Texture2D T $= (Repeated, Repeat)++ activeTexture $= TextureUnit 1+ texture Texture2D $= Enabled+ to <- loadTexture (TexInfo (fromIntegral $ length colorMap `quot` 3) 1 TexRGB colorMap)+ textureFilter Texture2D $= ((Linear', Nothing), Linear')+ textureWrapMode Texture2D S $= (Repeated, ClampToEdge)+ textureWrapMode Texture2D T $= (Repeated, ClampToEdge)++ loc <- get $ uniformLocation p "colorMap"+ asUniform (1 :: GLint) loc ++ let lcm :: GLfloat+ lcm = fromIntegral $ length colorMap `quot` 3+ loc <- get $ uniformLocation p "scale"+ asUniform ((lcm - 1) / lcm) loc ++ loc <- get $ uniformLocation p "offset"+ asUniform (0.5 / lcm) loc ++ --No idea why this is needed+ activeTexture $= TextureUnit 0++ loc <- get $ uniformLocation p "voffset"++ let pipe yoffset = do+ dat <- await++ lift $ do+ makeContextCurrent (Just win)++ let textureOffset = (yoffset + height - 1) `mod` height++ withPixels dat $ \ptr -> texSubImage2D Texture2D 0 (TexturePosition2D 0 (fromIntegral textureOffset)) (TextureSize2D (fromIntegral width) 1) (PixelData Red Float ptr)++ asUniform (fromIntegral yoffset / fromIntegral height :: GLfloat) loc++ drawArrays Quads 0 4+ swapBuffers win++ pipe $ if yoffset + 1 >= height then 0 else yoffset + 1++ return $ pipe 0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Adam Walker++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Adam Walker nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ dynamic-graph.cabal view
@@ -0,0 +1,30 @@+-- Initial dynamic-graph.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: dynamic-graph+version: 0.1.0.0+synopsis: Draw and update graphs in real time with OpenGL+description: Draw and update graphs in real time with OpenGL. Suitable for displaying large amounts of frequently changing data. At this time, line graphs and waterfall plots are supported. Axis drawing will be added in a future version.+license: BSD3+license-file: LICENSE+author: Adam Walker+maintainer: adamwalker10@gmail.com+copyright: 2014 Adam Walker+category: Graphics+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10+data-files: shaders/simple_line.vert, shaders/simple_line.frag, shaders/texture_line.vert, shaders/texture_line.frag, shaders/waterfall.vert, shaders/waterfall.frag++source-repository head+ type: git+ location: https://github.com/adamwalker/dynamic-graph++library+ exposed-modules: Graphics.DynamicGraph.SimpleLine, Graphics.DynamicGraph.TextureLine, Graphics.DynamicGraph.Waterfall, Graphics.DynamicGraph.Util+ -- other-modules: + -- other-extensions: + build-depends: base >=4.6 && <4.8, GLFW-b >=1.4 && <1.5, OpenGL >=2.9 && <2.10, GLUtil >=0.7 && <0.8, transformers >=0.3 && <0.5, either >=4.1 && <4.2, pipes+ -- hs-source-dirs: + default-language: Haskell2010+ other-modules: Paths_dynamic_graph
+ shaders/simple_line.frag view
@@ -0,0 +1,6 @@+#version 110++void main() {+ gl_FragColor = vec4(0, 0, 1, 0);+}+
+ shaders/simple_line.vert view
@@ -0,0 +1,7 @@+#version 110++attribute vec2 coord;++void main(){+ gl_Position = vec4(coord, 0, 1);+}
+ shaders/texture_line.frag view
@@ -0,0 +1,6 @@+#version 110++void main() {+ gl_FragColor = vec4(0, 0, 1, 0);+}+
+ shaders/texture_line.vert view
@@ -0,0 +1,9 @@+#version 110++attribute float coord;+uniform sampler2D texture;++void main(){+ float y = texture2D(texture, vec2((coord + 1.0)/2.0, 0)).r;+ gl_Position = vec4(coord, y, 0, 1);+}
+ shaders/waterfall.frag view
@@ -0,0 +1,15 @@+#version 110++uniform sampler2D texture;+uniform sampler2D colorMap;+varying vec2 f_coord;++uniform float offset;+uniform float scale;++void main() {+ float intensity = texture2D(texture, f_coord).r;+ gl_FragColor = texture2D(colorMap, vec2(intensity * scale + offset, 0));+ //gl_FragColor = vec4(0, 0, intensity, 0); +}+
+ shaders/waterfall.vert view
@@ -0,0 +1,12 @@+#version 110++attribute vec2 coord;+varying vec2 f_coord;+uniform float voffset;++void main(){+ gl_Position = vec4(coord, 0, 1);+ float f_x = (coord.x + 1.0) / 2.0;+ float f_y = (coord.y + 1.0) / 2.0 + voffset;+ f_coord = vec2(f_x, f_y);+}