diff --git a/Main.hs b/Main.hs
deleted file mode 100644
--- a/Main.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module Main where
-
-import qualified PlotLab.Main
-import Paths_plot_lab (getDataFileName)
-
-main = do
- mainGlade <- getDataFileName "main-window.glade"
- plotGlade <- getDataFileName "plot-window.glade"
- PlotLab.Main.main mainGlade plotGlade
diff --git a/button-panel.glade b/button-panel.glade
deleted file mode 100644
--- a/button-panel.glade
+++ /dev/null
@@ -1,1023 +0,0 @@
-
-
-
-
-
-
diff --git a/main-window.glade b/main-window.glade
deleted file mode 100644
--- a/main-window.glade
+++ /dev/null
@@ -1,34 +0,0 @@
-
-
-
-
-
-
diff --git a/plot-lab.cabal b/plot-lab.cabal
--- a/plot-lab.cabal
+++ b/plot-lab.cabal
@@ -1,5 +1,5 @@
Name: plot-lab
-Version: 0.0.1.6
+Version: 0.0.1.7
License: GPL-2
License-file: LICENSE
Author: Sumit Sahrawat
@@ -18,7 +18,7 @@
Build-type: Simple
Extra-source-files: README.md
-Data-files: button-panel.glade, main-window.glade, plot-window.glade
+Data-dir: ui
executable plot-lab
Main-is: Main.hs
@@ -28,6 +28,12 @@
, gtk >=0.13 && <0.14
, hmatrix >=0.16 && <0.17
, text >=1.2 && <1.3
+
+ hs-source-dirs: src
+ other-modules: Paths_plot_lab
+ , PlotLab.Events
+ , PlotLab.FigureSettings
+ , PlotLab.Main
-- ghc-options: -O2
default-language: Haskell2010
diff --git a/plot-window.glade b/plot-window.glade
deleted file mode 100644
--- a/plot-window.glade
+++ /dev/null
@@ -1,959 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,9 @@
+module Main where
+
+import qualified PlotLab.Main
+import Paths_plot_lab (getDataFileName)
+
+main = do
+ mainGlade <- getDataFileName "main-window.glade"
+ plotGlade <- getDataFileName "plot-window.glade"
+ PlotLab.Main.main mainGlade plotGlade
diff --git a/src/PlotLab/Events.hs b/src/PlotLab/Events.hs
new file mode 100644
--- /dev/null
+++ b/src/PlotLab/Events.hs
@@ -0,0 +1,195 @@
+module PlotLab.Events (attachHandlers) where
+
+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)
+
+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
+
+ -- Adjustments for parameter sliders
+ mapM_ (\x -> onValueChanged x redraw) adjs
+
+ -- Plot-Title Entry
+ titleEntry <- builderGetObject builder castToEntry "Plot Title Entry"
+ 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
+ size <- adjustmentGetValue titleSize
+ modifyIORef iofset $ \f -> f { plotTitleSize = size }
+ redraw
+
+ -- Subtitle Entry
+ subEntry <- builderGetObject builder castToEntry "Subtitle Entry"
+ 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
+ size <- adjustmentGetValue subSize
+ modifyIORef iofset $ \f -> f { subTitleSize = size }
+ redraw
+
+ -- Show X-Axis CheckButton
+ showX <- builderGetObject builder castToCheckButton "X-Axis Check"
+ onToggled showX $ do
+ state <- toggleButtonGetActive showX
+ fset <- readIORef iofset
+ modifyIORef iofset
+ (\f -> f { showXAxis = if state then True else False })
+ redraw
+
+ -- Show Y-Axis CheckButton
+ showY <- builderGetObject builder castToCheckButton "Y-Axis Check"
+ onToggled showY $ do
+ state <- toggleButtonGetActive showY
+ fset <- readIORef iofset
+ modifyIORef iofset
+ (\f -> f { showYAxis = if state then True else False })
+ redraw
+
+ -- 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
+ 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"
+ autoXCheck <- builderGetObject builder castToCheckButton "X-Range Check"
+ onToggled autoXCheck $ do
+ state <- toggleButtonGetActive autoXCheck
+ if state
+ then error "Invalid xRange"
+ -- do modifyIORef iofset $ \f -> f { xRange = Nothing }
+ -- widgetHideAll rangeEntries
+ else do lower <- builderGetObject builder castToAdjustment "X-Lower"
+ upper <- builderGetObject builder castToAdjustment "X-Upper"
+ l <- adjustmentGetValue lower
+ u <- adjustmentGetValue upper
+ widgetShowAll rangeEntries
+ modifyIORef iofset $ \f -> f { xRange = Just (l, u) }
+ redraw
+
+ -- Y-Axis Range
+ yLower <- builderGetObject builder castToAdjustment "Y-Lower"
+ yUpper <- builderGetObject builder castToAdjustment "Y-Upper"
+ let updateY y = onValueChanged y $ do
+ yl <- adjustmentGetValue yLower
+ yu <- adjustmentGetValue 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"
+ autoYCheck <- builderGetObject builder castToCheckButton "Y-Range Check"
+ onToggled autoYCheck $ do
+ state <- toggleButtonGetActive autoYCheck
+ if state
+ then do modifyIORef iofset $ \f -> f { yRange = Nothing }
+ widgetHideAll rangeEntries
+ else do lower <- builderGetObject builder castToAdjustment "Y-Lower"
+ upper <- builderGetObject builder castToAdjustment "Y-Upper"
+ l <- adjustmentGetValue lower
+ u <- adjustmentGetValue upper
+ widgetShowAll rangeEntries
+ modifyIORef iofset $ \f -> f { yRange = Just (l, u) }
+ redraw
+
+ -- Sampling Rate
+ sampleRate <- builderGetObject builder castToAdjustment "Sampling Adj"
+ 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 }
+ redraw
+
+ -- X-Label Size
+ xlSize <- builderGetObject builder castToAdjustment "X-Label Size"
+ 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 }
+ redraw
+
+ ylSize <- builderGetObject builder castToAdjustment "Y-Label Size"
+ onValueChanged ylSize $ do
+ size <- adjustmentGetValue ylSize
+ modifyIORef iofset $ \f -> f { yLabelSize = size }
+ redraw
+
+ -- Export Filename extry
+
+ -- Export Button
+ export <- builderGetObject builder castToButton "Export Button"
+ onClicked export $ do
+ fset <- readIORef iofset
+ vars <- mapM adjustmentGetValue adjs
+
+ comboText <- comboBoxGetActiveText combo
+ nameEntry <- builderGetObject builder castToEntry "File Entry"
+ nameText <- entryGetText nameEntry
+
+ modifyIORef iofset $ \f -> f { fileName = nameText }
+
+ let rate = samplingRate fset
+ samples = (\(x, y) -> rate * floor (y - x)) (fromJust $ xRange fset)
+ domain = linspace samples (fromJust $ xRange fset)
+ f = g vars
+ dset = (domain, [line f blue])
+ dimensions = exportSize fset
+
+ parseType txt = case txt of
+ "PNG" -> PNG
+ "SVG" -> SVG
+ "PS" -> PS
+ "PDF" -> PDF
+
+ filetype = let ftype = if comboText == Nothing
+ then error "Invalid FileType!"
+ else unpack $ fromJust comboText
+ in parseType ftype
+
+ parseExt fileType = case fileType of
+ PNG -> "PNG"
+ SVG -> "SVG"
+ PS -> "PS"
+ PDF -> "PDF"
+
+ 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
new file mode 100644
--- /dev/null
+++ b/src/PlotLab/FigureSettings.hs
@@ -0,0 +1,50 @@
+module PlotLab.FigureSettings (FigureSettings(..), defaultSettings) where
+
+import Graphics.Rendering.Plot
+
+data FigureSettings =
+ FigureSettings
+ { fontFamily :: String
+ , plotTitle :: Maybe String
+ , plotTitleSize :: Double
+ , subTitle :: Maybe String
+ , subTitleSize :: Double
+ , xRange :: Maybe (Double, Double)
+ , yRange :: Maybe (Double, Double)
+ , samplingRate :: Int
+ , xLabel :: Maybe String
+ , xLabelSize :: Double
+ , yLabel :: Maybe String
+ , yLabelSize :: Double
+ , showXAxis :: Bool
+ , xLocation :: (AxisPosn, AxisSide)
+ , showYAxis :: Bool
+ , yLocation :: (AxisPosn, AxisSide)
+ , plotScaleX :: Graphics.Rendering.Plot.Scale
+ , plotScaleY :: Graphics.Rendering.Plot.Scale
+ , exportSize :: (Int, Int)
+ , fileName :: String
+ }
+
+defaultSettings = FigureSettings
+ { fontFamily = "Sans"
+ , plotTitle = Nothing
+ , plotTitleSize = 10
+ , subTitle = Nothing
+ , subTitleSize = 10
+ , xRange = Nothing
+ , yRange = Nothing
+ , samplingRate = 10
+ , xLabel = Nothing
+ , xLabelSize = 10
+ , yLabel = Nothing
+ , yLabelSize = 10
+ , showXAxis = True
+ , xLocation = (Side Lower, Lower)
+ , showYAxis = True
+ , yLocation = (Side Lower, Lower)
+ , plotScaleX = Linear
+ , plotScaleY = Linear
+ , exportSize = (1000, 1000)
+ , fileName = "plot"
+ }
diff --git a/src/PlotLab/Main.hs b/src/PlotLab/Main.hs
new file mode 100644
--- /dev/null
+++ b/src/PlotLab/Main.hs
@@ -0,0 +1,275 @@
+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 Control.Concurrent
+-- import Control.Concurrent.MVar
+-- import qualified Graphics.Rendering.Pango as P
+-- import qualified Graphics.Rendering.Cairo as C
+-- import Data.Packed.Vector
+-- import Data.Packed.Random
+-- import Data.Packed()
+-- import Numeric.LinearAlgebra.Instances
+-- import Numeric.LinearAlgebra.Interface
+-- import Numeric.GSL.Statistics
+-- import Debug.Trace
+-- import qualified Data.Array.IArray as A
+
+--------------------------------------------------------------------------------
+
+updateFigureText :: (Text () -> Figure ())
+ -> (Maybe String) -> Double -> Figure ()
+updateFigureText withSomething txt size =
+ withSomething $ do if txt == Nothing
+ then setText ""
+ else setText (fromJust txt)
+ setFontSize size
+
+--------------------------------------------------------------------------------
+
+updateAxis axis show location range scale label size = do
+ let (position, side) = location
+
+ when show $ addAxis axis position
+ (when (label /= Nothing) $ withAxisLabel $ do setText $ fromJust label
+ setFontSize size)
+ if range == Nothing
+ then setRangeFromData axis side scale
+ else uncurry (setRange axis side scale) (fromJust range)
+
+--------------------------------------------------------------------------------
+
+buildFigure :: (Dataset a) => a -> FigureSettings -> Figure ()
+buildFigure dset fset = do
+ withTextDefaults $ setFontFamily (fontFamily fset)
+
+ let title = plotTitle fset
+ size = plotTitleSize fset
+ in updateFigureText withTitle title size
+
+ let title = subTitle fset
+ size = subTitleSize fset
+ in updateFigureText withSubTitle title size
+
+ setPlots 1 1
+ withPlot (1, 1) $ do
+ setDataset dset
+
+ -- X-Axis
+ let show = showXAxis fset
+ text = xLabel fset
+ size = xLabelSize fset
+ loc = xLocation fset
+ range = xRange fset
+ scale = plotScaleX fset
+ in updateAxis XAxis show loc range scale text size
+
+ -- Y-Axis
+ let show = showYAxis fset
+ text = yLabel fset
+ size = yLabelSize fset
+ loc = yLocation fset
+ range = yRange fset
+ scale = plotScaleY fset
+ in updateAxis YAxis show loc range scale text size
+
+--------------------------------------------------------------------------------
+
+type AdjustmentSettings = (Double, Double, Double, Double, Double, Double)
+
+--------------------------------------------------------------------------------
+
+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
+
+ adjs <- newAdjList conf
+ sliders <- newHScaleList adjs
+ mapM_ (\x -> scaleSetValuePos x PosRight) sliders
+ mapM_ (\x -> scaleSetDigits x 2) sliders
+ mapM_ (\x -> boxPackEnd box x PackNatural 0) sliders
+ return adjs
+
+--------------------------------------------------------------------------------
+
+updateCanvas :: DrawingArea -> IORef FigureSettings -> [Adjustment] -> IO ()
+updateCanvas canvas iofset adjs = do
+ fset <- readIORef iofset
+ s@(w, h) <- widgetGetSize canvas
+ drw <- widgetGetDrawWindow canvas
+ vars <- mapM adjustmentGetValue adjs
+
+ let rate = samplingRate fset
+ samples = (\(x, y) -> rate * floor (y - x)) (fromJust $ xRange fset)
+ domain = linspace samples (fromJust $ xRange fset)
+ f = g vars
+ dset = (domain, [line f blue])
+ r = render $ buildFigure dset fset
+
+ region <- regionRectangle $ Rectangle 0 0 w h
+ drawWindowBeginPaintRegion drw region
+ renderWithDrawable drw (r s)
+ drawWindowEndPaint drw
+
+--------------------------------------------------------------------------------
+
+-- Create a new window
+-- Initially fill the values
+-- Call PlotLab.Events.attachHandlers to attach Event Handlers
+figureWindow :: String -> IORef FigureSettings -> [AdjustmentSettings]
+ -> ([Double] -> Double -> Double) -> IO ()
+figureWindow plotGlade iofset conf g = do
+ builder <- builderNew
+ builderAddFromFile builder plotGlade
+
+ plotBox <- builderGetObject builder castToVBox "Plot Region"
+ adjs <- addSlidersToBox conf plotBox
+ fset <- readIORef iofset
+
+ let updateEntryText entryGlade text =
+ when (text /= Nothing) $ do entry <- builderGetObject builder
+ castToEntry entryGlade
+ entrySetText entry $ fromJust text
+ in do updateEntryText "Plot Title Entry" $ plotTitle fset
+ updateEntryText "Subtitle Entry" $ subTitle fset
+ updateEntryText "X-Label Entry" $ xLabel fset
+ updateEntryText "Y-Label Entry" $ yLabel fset
+ updateEntryText "File Entry" $ Just (fileName fset)
+
+ let adjApplyValue adjGlade val = do
+ adj <- builderGetObject builder castToAdjustment adjGlade
+ adjustmentSetValue adj val
+ in do adjApplyValue "Title Font Size" $ plotTitleSize fset
+ adjApplyValue "Subtitle Font Size" $ subTitleSize fset
+ adjApplyValue "Sampling Adj" $ fromIntegral $ samplingRate fset
+ adjApplyValue "X-Label Size" $ xLabelSize fset
+ adjApplyValue "Y-Label Size" $ yLabelSize fset
+
+ let checkApplyState checkGlade state = do
+ check <- builderGetObject builder castToCheckButton checkGlade
+ toggleButtonSetActive check $ if state then True else False
+ in do checkApplyState "X-Axis Check" $ showXAxis fset
+ checkApplyState "Y-Axis Check" $ showYAxis fset
+ checkApplyState "Y-Range Check" $ yRange fset == Nothing
+
+ -- Y-Axis Range and CheckButton
+ let range = yRange fset
+ in if range == Nothing
+ then do entries <- builderGetObject builder castToHBox "Y-Range Entries"
+ widgetHideAll entries
+ else let (l, u) = fromJust range
+ in do lower <- builderGetObject builder castToAdjustment "Y-Lower"
+ upper <- builderGetObject builder castToAdjustment "Y-Upper"
+ adjustmentSetValue lower l
+ adjustmentSetValue upper u
+ -- X-Axis Range
+ let range = xRange fset
+ in if range == Nothing
+ then error "Invalid xRange"
+ else let (l, u) = fromJust range
+ in do lower <- builderGetObject builder castToAdjustment "X-Lower"
+ upper <- builderGetObject builder castToAdjustment "X-Upper"
+ adjustmentSetValue lower l
+ adjustmentSetValue upper u
+
+ -- Export Size
+ let (w, h) = exportSize fset
+ in do width <- builderGetObject builder castToAdjustment "Export Width"
+ height <- builderGetObject builder castToAdjustment "Export Height"
+ adjustmentSetValue width $ fromIntegral w
+ adjustmentSetValue height $ fromIntegral h
+
+ -- Export ComboBox
+ combo <- comboBoxNewText
+ 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
+
+ -- Show Widgets
+ plotWindow <- builderGetObject builder castToWindow "Plot Window"
+ widgetShowAll plotWindow
+
+ -- Hide the useless checkButton for now
+ check <- builderGetObject builder castToCheckButton "X-Range Check"
+ widgetHide check
+
+--------------------------------------------------------------------------------
+
+giveSettings :: FigureSettings -> IO (IORef FigureSettings)
+giveSettings fst = do
+ ref <- newIORef fst
+
+ modifyIORef ref $ \f ->
+ f { plotTitle = Just "Example: Sum of two gaussian distributions"
+ , subTitle = Just "Play with the sliders, and other options"
+ , xRange = Just (-5, 5)
+ , yRange = Just ( 0, 2)
+ , plotTitleSize = 12.5
+ }
+ return ref
+
+--------------------------------------------------------------------------------
+
+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))
+
+g :: [Double] -> Double -> Double
+g [a, b, c, d] x = h [a, b] x + h [c, d] x
+
+--------------------------------------------------------------------------------
+
+main mainGlade plotGlade = do
+ initGUI
+ builder <- builderNew
+ builderAddFromFile builder mainGlade
+ mainWindow <- builderGetObject builder castToWindow "Main Window"
+ plotButton <- builderGetObject builder castToButton "Plot Button"
+ onDestroy mainWindow mainQuit
+ widgetShowAll mainWindow
+ settings <- giveSettings defaultSettings
+ onClicked plotButton $
+ figureWindow plotGlade settings [sigma2, mu2, sigma1, mu1] g
+ mainGUI
+
+--------------------------------------------------------------------------------
+
+-- xs = linspace ln (-2.5, 2.5) :: Vector Double
+-- ys = ln |> [exp (-x ** 2) | x <- [(-2.5),(-2.475)..2.5] :: [Double]]
+
+-- figure = buildFigure (domain, [point (ys, xs) (Cross, red),
+-- line f1 red, line f2 green,
+-- line f3 blue, line f4 black]) default_fset
+
+-- export = writeFigure SVG "plot.svg" (1000,1000) $ buildFigure dset fset
+
+--------------------------------------------------------------------------------
+
+-- applyParameters :: (Function a) => a -> [Double] -> (Double -> Double)
+
+--------------------------------------------------------------------------------