diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,22 +4,38 @@ An ambitious attempt to provide mathematica like dynamic plotting for free. -* Written in haskell +* Written in haskell. * Based on plot ([hackage](http://hackage.haskell.org/package/plot)) ([github](https://github.com/amcphail/plot)). -* GUI written using gtk2hs (using [gtk3](http://hackage.haskell.org/package/gtk3) package) -* GUI designed using glade +* GUI written using gtk2hs (using [gtk](http://hackage.haskell.org/package/gtk)). +* GUI designed using glade. +* Also available at [hackage](http://hackage.haskell.org/package/plot-lab). ## Installation - ``` - $ cabal install plot-lab - ``` +### Linux -Manual installations can be done using the package from [hackage](http://hackage.haskell.org/package/plot-lab) +The installation for gtk requires that [gtk2hs-buildtools](https://hackage.haskell.org/package/gtk2hs-buildtools) be installed, and the binary be in your $PATH. +The below commands take care of that, without permanently changing the $PATH. +``` +$ cabal update +$ cabal install gtk2hs-buildtools +$ env PATH="~/.cabal/bin:$PATH" cabal install plot-lab +``` + +### Windows + +* Install gtk2hs with instructions from [here](http://projects.haskell.org/gtk2hs/download/#Windows). + +* Then use cabal to install plot-lab. + +```batch +cmd> cabal install plot-lab +``` + ## Usage -The window displays the sum of two gaussian distributions with sliders for mean and std. deviation -The plan is to add custom function input facilities and make it more interactive +The window displays the sum of two gaussian distributions with sliders for mean and std. deviation. +The plan is to add custom function input facilities and make it more interactive. -The package is too raw to be used with custom functions right now. Those with haskell knowledge might be able to make changes and get what they want +The package is too raw to be used with custom functions right now. Those with haskell knowledge might be able to make changes and get what they want. diff --git a/plot-lab.cabal b/plot-lab.cabal --- a/plot-lab.cabal +++ b/plot-lab.cabal @@ -1,11 +1,11 @@ Name: plot-lab -Version: 0.0.1.8 +Version: 0.0.1.9 License: GPL-2 License-file: LICENSE Author: Sumit Sahrawat -Maintainer: sumit.sahrawat.apm13 iitbhu ac in +Maintainer: sumit.sahrawat.apm13@iitbhu.ac.in Stability: experimental -Homepage: github.com/sumitsahrawat/plot-lab +Homepage: https://github.com/sumitsahrawat/plot-lab Synopsis: A plotting tool with Mathematica like Manipulation abilities Description: Mathematica has a nice plotting feature that allows for plotting of functions that depend on more than one variable, and then allows changing the value @@ -31,6 +31,7 @@ , gtk >=0.13 && <0.14 , hmatrix >=0.16 && <0.17 , text >=1.2 && <1.3 + , vector >=0.10.12.2 && <0.10.13.0 hs-source-dirs: src other-modules: Paths_plot_lab @@ -38,7 +39,7 @@ , PlotLab.FigureSettings , PlotLab.Main --- ghc-options: -O2 + ghc-options: -Wall default-language: Haskell2010 source-repository head diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,8 +1,9 @@ module Main where +import Paths_plot_lab (getDataFileName) import qualified PlotLab.Main -import Paths_plot_lab (getDataFileName) +main :: IO () main = do mainGlade <- getDataFileName "main-window.glade" plotGlade <- getDataFileName "plot-window.glade" diff --git a/src/PlotLab/Events.hs b/src/PlotLab/Events.hs --- a/src/PlotLab/Events.hs +++ b/src/PlotLab/Events.hs @@ -1,95 +1,106 @@ module PlotLab.Events (attachHandlers) where -import PlotLab.FigureSettings +import PlotLab.FigureSettings -import Data.Maybe (fromJust) -import Data.Colour.Names -import Graphics.Rendering.Plot -import Graphics.UI.Gtk hiding(Circle,Cross) -import Data.Text (pack, unpack) -import Numeric.LinearAlgebra (linspace) -import Data.IORef (IORef, newIORef, readIORef, modifyIORef) -import Data.Char (toLower) +import Data.Char (toLower) +import Data.Colour.Names +import Data.IORef (IORef, modifyIORef, readIORef) +import Data.Maybe (fromJust) +import Data.Text (unpack) +import Data.Vector.Storable (Vector) +import Graphics.Rendering.Plot +import Graphics.UI.Gtk hiding (Circle, Color, Cross) +import Numeric.LinearAlgebra (linspace) +attachHandlers :: (Ordinate a, ComboBoxClass self) => + Builder + -> IORef FigureSettings + -> [Adjustment] + -> (DrawingArea -> + IORef FigureSettings -> [Adjustment] -> IO ()) + -> ([Double] -> a) + -> ((Vector Double, [FormattedSeries]) + -> FigureSettings -> Figure ()) + -> self + -> IO (ConnectId Button) attachHandlers builder iofset adjs updateCanvas g buildFigure combo = do -- Canvas canvas <- builderGetObject builder castToDrawingArea "Plotting Canvas" let redraw = updateCanvas canvas iofset adjs - onExpose canvas $ \_ -> redraw >> return False + _ <- onExpose canvas $ \_ -> redraw >> return False -- Adjustments for parameter sliders - mapM_ (\x -> onValueChanged x redraw) adjs + mapM_ (`onValueChanged` redraw) adjs -- Plot-Title Entry titleEntry <- builderGetObject builder castToEntry "Plot Title Entry" - onEntryActivate titleEntry $ do + _ <- onEntryActivate titleEntry $ do titleNew <- entryGetText titleEntry modifyIORef iofset $ \f -> f { plotTitle = Just titleNew } redraw -- Plot-Title Font Size titleSize <- builderGetObject builder castToAdjustment "Title Font Size" - onValueChanged titleSize $ do + _ <- onValueChanged titleSize $ do size <- adjustmentGetValue titleSize modifyIORef iofset $ \f -> f { plotTitleSize = size } redraw -- Subtitle Entry subEntry <- builderGetObject builder castToEntry "Subtitle Entry" - onEntryActivate subEntry $ do + _ <- onEntryActivate subEntry $ do titleNew <- entryGetText subEntry modifyIORef iofset $ \f -> f { subTitle = Just titleNew } redraw -- Subtitle Font Size subSize <- builderGetObject builder castToAdjustment "Subtitle Font Size" - onValueChanged subSize $ do + _ <- onValueChanged subSize $ do size <- adjustmentGetValue subSize modifyIORef iofset $ \f -> f { subTitleSize = size } redraw -- Show X-Axis CheckButton showX <- builderGetObject builder castToCheckButton "X-Axis Check" - onToggled showX $ do + _ <- onToggled showX $ do state <- toggleButtonGetActive showX - fset <- readIORef iofset modifyIORef iofset - (\f -> f { showXAxis = if state then True else False }) + (\f -> f { showXAxis = state }) redraw -- Show Y-Axis CheckButton showY <- builderGetObject builder castToCheckButton "Y-Axis Check" - onToggled showY $ do + _ <- onToggled showY $ do state <- toggleButtonGetActive showY - fset <- readIORef iofset modifyIORef iofset - (\f -> f { showYAxis = if state then True else False }) + (\f -> f { showYAxis = state }) redraw + let adjustmentPairValues (a1, a2) = do v1 <- adjustmentGetValue a1 + v2 <- adjustmentGetValue a2 + return (v1, v2) -- X-Axis Range xLower <- builderGetObject builder castToAdjustment "X-Lower" xUpper <- builderGetObject builder castToAdjustment "X-Upper" let updateX x = onValueChanged x $ do - xl <- adjustmentGetValue xLower - xu <- adjustmentGetValue xUpper + (xl, xu) <- adjustmentPairValues (xLower, xUpper) modifyIORef iofset $ \f -> f { xRange = Just (xl, xu) } redraw in mapM_ updateX [xLower, xUpper] -- X-Range Auto-determination CheckBox - rangeEntries <- builderGetObject builder castToHBox "X-Range Entries" + xRangeEntries <- builderGetObject builder castToHBox "X-Range Entries" autoXCheck <- builderGetObject builder castToCheckButton "X-Range Check" - onToggled autoXCheck $ do + _ <- onToggled autoXCheck $ do state <- toggleButtonGetActive autoXCheck if state then error "Invalid xRange" -- do modifyIORef iofset $ \f -> f { xRange = Nothing } - -- widgetHideAll rangeEntries + -- widgetHideAll xRangeEntries else do lower <- builderGetObject builder castToAdjustment "X-Lower" upper <- builderGetObject builder castToAdjustment "X-Upper" - l <- adjustmentGetValue lower - u <- adjustmentGetValue upper - widgetShowAll rangeEntries + (l, u) <- adjustmentPairValues (lower, upper) + widgetShowAll xRangeEntries modifyIORef iofset $ \f -> f { xRange = Just (l, u) } redraw @@ -97,58 +108,56 @@ yLower <- builderGetObject builder castToAdjustment "Y-Lower" yUpper <- builderGetObject builder castToAdjustment "Y-Upper" let updateY y = onValueChanged y $ do - yl <- adjustmentGetValue yLower - yu <- adjustmentGetValue yUpper + (yl, yu) <- adjustmentPairValues (yLower, yUpper) modifyIORef iofset $ \f -> f { yRange = Just (yl, yu) } redraw in mapM_ updateY [yLower, yUpper] -- Y-Range Auto-determination CheckBox - rangeEntries <- builderGetObject builder castToHBox "Y-Range Entries" + yRangeEntries <- builderGetObject builder castToHBox "Y-Range Entries" autoYCheck <- builderGetObject builder castToCheckButton "Y-Range Check" - onToggled autoYCheck $ do + _ <- onToggled autoYCheck $ do state <- toggleButtonGetActive autoYCheck if state then do modifyIORef iofset $ \f -> f { yRange = Nothing } - widgetHideAll rangeEntries + widgetHideAll yRangeEntries else do lower <- builderGetObject builder castToAdjustment "Y-Lower" upper <- builderGetObject builder castToAdjustment "Y-Upper" - l <- adjustmentGetValue lower - u <- adjustmentGetValue upper - widgetShowAll rangeEntries + (l, u) <- adjustmentPairValues (lower, upper) + widgetShowAll yRangeEntries modifyIORef iofset $ \f -> f { yRange = Just (l, u) } redraw -- Sampling Rate sampleRate <- builderGetObject builder castToAdjustment "Sampling Adj" - onValueChanged sampleRate $ do + _ <- onValueChanged sampleRate $ do rate <- adjustmentGetValue sampleRate modifyIORef iofset $ \f -> f { samplingRate = floor rate } redraw -- X-Label Entry xLabelEntry <- builderGetObject builder castToEntry "X-Label Entry" - onEntryActivate xLabelEntry $ do - labelNew <- entryGetText xLabelEntry - modifyIORef iofset $ \f -> f { xLabel = Just labelNew } + _ <- onEntryActivate xLabelEntry $ do + label' <- entryGetText xLabelEntry + modifyIORef iofset $ \f -> f { xLabel = Just label' } redraw -- X-Label Size xlSize <- builderGetObject builder castToAdjustment "X-Label Size" - onValueChanged xlSize $ do + _ <- onValueChanged xlSize $ do size <- adjustmentGetValue xlSize modifyIORef iofset $ \f -> f { xLabelSize = size } redraw -- Y-Label Entry yLabelEntry <- builderGetObject builder castToEntry "Y-Label Entry" - onEntryActivate yLabelEntry $ do - labelNew <- entryGetText yLabelEntry - modifyIORef iofset $ \f -> f { yLabel = Just labelNew } + _ <- onEntryActivate yLabelEntry $ do + label' <- entryGetText yLabelEntry + modifyIORef iofset $ \f -> f { yLabel = Just label' } redraw ylSize <- builderGetObject builder castToAdjustment "Y-Label Size" - onValueChanged ylSize $ do + _ <- onValueChanged ylSize $ do size <- adjustmentGetValue ylSize modifyIORef iofset $ \f -> f { yLabelSize = size } redraw @@ -171,7 +180,8 @@ samples = (\(x, y) -> rate * floor (y - x)) (fromJust $ xRange fset) domain = linspace samples (fromJust $ xRange fset) f = g vars - dset = (domain, [line f blue]) + colour = blue :: Color + dset = (domain, [line f colour]) dimensions = exportSize fset parseType txt = case txt of @@ -179,10 +189,10 @@ "SVG" -> SVG "PS" -> PS "PDF" -> PDF + _ -> error "Invalid FileType!" - filetype = let ftype = if comboText == Nothing - then error "Invalid FileType!" - else unpack $ fromJust comboText + + filetype = let ftype = maybe (error "Invalid FileType!") unpack comboText in parseType ftype parseExt fileType = case fileType of @@ -191,5 +201,5 @@ PS -> "PS" PDF -> "PDF" - filename = nameText ++ "." ++ (map toLower $ parseExt filetype) + filename = nameText ++ "." ++ map toLower (parseExt filetype) writeFigure filetype filename dimensions $ buildFigure dset fset diff --git a/src/PlotLab/FigureSettings.hs b/src/PlotLab/FigureSettings.hs --- a/src/PlotLab/FigureSettings.hs +++ b/src/PlotLab/FigureSettings.hs @@ -1,6 +1,9 @@ -module PlotLab.FigureSettings (FigureSettings(..), defaultSettings) where +module PlotLab.FigureSettings + ( FigureSettings (..) + , defaultSettings + ) where -import Graphics.Rendering.Plot +import Graphics.Rendering.Plot data FigureSettings = FigureSettings @@ -26,6 +29,7 @@ , fileName :: String } +defaultSettings :: FigureSettings defaultSettings = FigureSettings { fontFamily = "Sans" , plotTitle = Nothing diff --git a/src/PlotLab/Main.hs b/src/PlotLab/Main.hs --- a/src/PlotLab/Main.hs +++ b/src/PlotLab/Main.hs @@ -1,16 +1,17 @@ module PlotLab.Main (main) where -import Control.Monad (when) -import Data.Maybe (fromJust) -import Data.Colour.Names -import Graphics.Rendering.Plot -import Graphics.UI.Gtk hiding(Circle,Cross) -import Data.IORef (IORef, newIORef, readIORef, modifyIORef) -import Numeric.LinearAlgebra (linspace) -import Data.Text (pack, unpack) +import PlotLab.Events (attachHandlers) +import PlotLab.FigureSettings -import PlotLab.Events (attachHandlers) -import PlotLab.FigureSettings +import Control.Monad (when) +import Data.Colour.Names +import Data.IORef (IORef, modifyIORef, newIORef, + readIORef) +import Data.Maybe (fromJust) +import Data.Text (pack) +import Graphics.Rendering.Plot +import Graphics.UI.Gtk hiding (Circle, Color, Cross, Scale) +import Numeric.LinearAlgebra (linspace) -- import Control.Concurrent -- import Control.Concurrent.MVar @@ -37,10 +38,12 @@ -------------------------------------------------------------------------------- -updateAxis axis show location range scale label size = do +updateAxis :: AxisType -> Bool -> (AxisPosn, AxisSide) -> Maybe (Double, Double) + -> Scale -> Maybe String -> FontSize -> Plot () +updateAxis axis state location range scale label size = do let (position, side) = location - when show $ addAxis axis position + when state $ addAxis axis position (when (label /= Nothing) $ withAxisLabel $ do setText $ fromJust label setFontSize size) if range == Nothing @@ -53,35 +56,35 @@ buildFigure dset fset = do withTextDefaults $ setFontFamily (fontFamily fset) - let title = plotTitle fset - size = plotTitleSize fset - in updateFigureText withTitle title size + let str = plotTitle fset + size = plotTitleSize fset + in updateFigureText withTitle str size - let title = subTitle fset - size = subTitleSize fset - in updateFigureText withSubTitle title size + let str = subTitle fset + size = subTitleSize fset + in updateFigureText withSubTitle str size setPlots 1 1 withPlot (1, 1) $ do setDataset dset -- X-Axis - let show = showXAxis fset - text = xLabel fset + let state = showXAxis fset + label = xLabel fset size = xLabelSize fset loc = xLocation fset range = xRange fset scale = plotScaleX fset - in updateAxis XAxis show loc range scale text size + in updateAxis XAxis state loc range scale label size -- Y-Axis - let show = showYAxis fset - text = yLabel fset + let state = showYAxis fset + label = yLabel fset size = yLabelSize fset loc = yLocation fset range = yRange fset scale = plotScaleY fset - in updateAxis YAxis show loc range scale text size + in updateAxis YAxis state loc range scale label size -------------------------------------------------------------------------------- @@ -92,8 +95,8 @@ addSlidersToBox :: [AdjustmentSettings] -> VBox -> IO [Adjustment] addSlidersToBox conf box = do let newAdj (a, b, c, d, e, f) = adjustmentNew a b c d e f - newAdjList conf = mapM newAdj conf - newHScaleList adjs = mapM hScaleNew adjs + newAdjList = mapM newAdj + newHScaleList = mapM hScaleNew adjs <- newAdjList conf sliders <- newHScaleList adjs @@ -112,14 +115,15 @@ vars <- mapM adjustmentGetValue adjs let rate = samplingRate fset - samples = (\(x, y) -> rate * floor (y - x)) (fromJust $ xRange fset) + samples = (\(x, y) -> rate * ceiling (y - x)) (fromJust $ xRange fset) domain = linspace samples (fromJust $ xRange fset) f = g vars - dset = (domain, [line f blue]) + colour = blue :: Color + dset = (domain, [line f colour]) r = render $ buildFigure dset fset - region <- regionRectangle $ Rectangle 0 0 w h - drawWindowBeginPaintRegion drw region + box <- regionRectangle $ Rectangle 0 0 w h + drawWindowBeginPaintRegion drw box renderWithDrawable drw (r s) drawWindowEndPaint drw @@ -130,7 +134,7 @@ -- Call PlotLab.Events.attachHandlers to attach Event Handlers figureWindow :: String -> IORef FigureSettings -> [AdjustmentSettings] -> ([Double] -> Double -> Double) -> IO () -figureWindow plotGlade iofset conf g = do +figureWindow plotGlade iofset conf fun = do builder <- builderNew builderAddFromFile builder plotGlade @@ -138,10 +142,10 @@ adjs <- addSlidersToBox conf plotBox fset <- readIORef iofset - let updateEntryText entryGlade text = - when (text /= Nothing) $ do entry <- builderGetObject builder - castToEntry entryGlade - entrySetText entry $ fromJust text + let updateEntryText entryGlade txt = + when (txt /= Nothing) $ do entry <- builderGetObject builder + castToEntry entryGlade + entrySetText entry $ fromJust txt in do updateEntryText "Plot Title Entry" $ plotTitle fset updateEntryText "Subtitle Entry" $ subTitle fset updateEntryText "X-Label Entry" $ xLabel fset @@ -193,15 +197,15 @@ -- Export ComboBox combo <- comboBoxNewText - mapM (\(x, y) -> comboBoxInsertText combo x $ pack y) - [(1, "PNG"), (2, "SVG"), (3, "PS"), (4, "PDF")] + _ <- mapM (\(x, y) -> comboBoxInsertText combo x $ pack y) + [(1, "PNG"), (2, "SVG"), (3, "PS"), (4, "PDF")] comboBoxSetActive combo 0 comboArea <- builderGetObject builder castToHBox "File Name" boxPackEndDefaults comboArea combo -- Attach Event Handlers - attachHandlers builder iofset adjs updateCanvas g buildFigure combo + _ <- attachHandlers builder iofset adjs updateCanvas fun buildFigure combo -- Show Widgets plotWindow <- builderGetObject builder castToWindow "Plot Window" @@ -214,8 +218,8 @@ -------------------------------------------------------------------------------- giveSettings :: FigureSettings -> IO (IORef FigureSettings) -giveSettings fst = do - ref <- newIORef fst +giveSettings fset = do + ref <- newIORef fset modifyIORef ref $ \f -> f { plotTitle = Just "Example: Sum of two gaussian distributions" @@ -228,33 +232,33 @@ -------------------------------------------------------------------------------- -mu1 = (-5.00, -5.00, 5.00, 0.01, 0.01, 0.00) -sigma1 = ( 1.00, 0.01, 6.00, 0.01, 0.01, 0.00) -mu2 = ( 0.00, -5.00, 5.00, 0.01, 0.01, 0.00) -sigma2 = ( 1.00, 0.01, 6.00, 0.01, 0.01, 0.00) - --------------------------------------------------------------------------------- - -- Gaussian Distribution -h :: [Double] -> Double -> Double -h [s, m] x = exp (-((x - m) ** 2) / (2 * (s ** 2))) / (s * sqrt (2 * pi)) +func :: [Double] -> Double -> Double +func [s, m] x = exp (-((x - m) ** 2) / (2 * (s ** 2))) / (s * sqrt (2 * pi)) +func _ _ = error "Invalid arguments" g :: [Double] -> Double -> Double -g [a, b, c, d] x = h [a, b] x + h [c, d] x +g [a, b, c, d] x = func [a, b] x + func [c, d] x +g _ _ = error "Invalid arguments" -------------------------------------------------------------------------------- +main :: FilePath -> String -> IO () main mainGlade plotGlade = do - initGUI + _ <- initGUI builder <- builderNew builderAddFromFile builder mainGlade mainWindow <- builderGetObject builder castToWindow "Main Window" plotButton <- builderGetObject builder castToButton "Plot Button" - onDestroy mainWindow mainQuit + _ <- onDestroy mainWindow mainQuit widgetShowAll mainWindow settings <- giveSettings defaultSettings - onClicked plotButton $ - figureWindow plotGlade settings [sigma2, mu2, sigma1, mu1] g + _ <- onClicked plotButton $ + let mu1 = (-5.00, -5.00, 5.00, 0.01, 0.01, 0.00) + sigma1 = ( 1.00, 0.01, 6.00, 0.01, 0.01, 0.00) + mu2 = ( 0.00, -5.00, 5.00, 0.01, 0.01, 0.00) + sigma2 = ( 1.00, 0.01, 6.00, 0.01, 0.01, 0.00) + in figureWindow plotGlade settings [sigma2, mu2, sigma1, mu1] g mainGUI --------------------------------------------------------------------------------