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