module Controller.Menu.File.Export.Diagram.BarChart (eventHandler) where import Control.Applicative ((<$>)) import Control.Monad (when) import Text.Printf (printf) import Data.List (transpose) import Controller (Controller,getFromConfig,onView ,onGridView,setOnConfig) import Controller.Menu.File.Export.Diagram.BarChartParameters (Parameters(..),gnuplotLegend,legendFromInt,intFromLegend,legendList) import qualified Controller.Menu.File.Export.Diagram.Common as Common import Controller.Dialog (nonNumericDataWarningText ,noColumnsSelectedText,saveFileDialog) import Config (barChartExportParameters) import View.Component.Grid (getRowLabels,getColumnLabels) import View.Dialog.Complex (Layout (..),Widget (..),Modifier (..) ,showDialog,cancelButton) import Util.FileType (justPngWildcard) import I18n (__) data Action = Preview | Export eventHandler :: Controller () eventHandler = getFromConfig barChartExportParameters >>= \params -> eventHandlerWith $ params {columns = []} eventHandlerWith :: Parameters -> Controller () eventHandlerWith initParams = do result <- do d <- dialog <$> onGridView getColumnLabels onView $ showDialog (__ "Export") d initParams case result of Nothing -> return () Just (params,Export) -> do saveFile <- saveFileDialog (__ "Export") justPngWildcard setOnConfig $ \c -> c {barChartExportParameters = params} case saveFile of Nothing -> eventHandlerWith params Just imageFilePath -> do success <- Common.plot (gpFileContent params) (dataFileContent params) imageFilePath when (not success) $ eventHandlerWith params Just (params,Preview) -> do setOnConfig $ \c -> c {barChartExportParameters = params} _ <- Common.showPreview (gpFileContent params) (dataFileContent params) eventHandlerWith params dialog :: [String] -> Layout Parameters Action dialog columnLabels = let setCols p cols = p {columns = cols} setBarWidth p w = p {barWidth = w} setGaps p g = p {gaps = g} setLegend p i = p {legend = legendFromInt i} in Modifier Margin $ Column [ Row [ Grid [[ Label $ __ "Bar width" , Widget $ NumberEntry barWidth setBarWidth] ,[ Label $ __ "Gaps" , Widget $ Spinner 0 maxBound gaps setGaps] ,[ Label $ __ "Legend" , Widget $ Choice legendList (intFromLegend . legend) setLegend] ] , Modifier Center $ Modifier (Boxed $ __ "Columns") $ Widget $ MultiListBox columnLabels columns setCols ] , Modifier Center $ Row [ Widget $ DefaultButton (__ "&Export ...") Export , Widget $ Button (__ "&Preview ...") Preview , cancelButton]] dataFileContent :: Parameters -> Controller (Either String String) dataFileContent (Parameters {columns = []}) = return $ Left noColumnsSelectedText dataFileContent (Parameters {columns = cols}) = do numericColumns <- Common.getNumericColumns cols case numericColumns of Left nonNumeric -> return $ Left $ nonNumericDataWarningText nonNumeric Right columns -> do rowLabels <- onGridView getRowLabels let firstLine = "\"\"" : rowLabels columnToLine (label,values) = label:(map show values) dataLines = map columnToLine columns lines = transpose $ firstLine : dataLines return $ Right $ unlines $ map unwords lines gpFileContent :: Parameters -> FilePath -> String gpFileContent params dataFilePath = printf (unlines [ "set key %s top" , "set style data histogram" , "set style histogram clustered gap %d" , "set boxwidth %f" , "set style fill solid" , "plot for [COL=2:%d] \"%s\" using COL:xtic(1) title columnhead" ]) (gnuplotLegend $ legend params) (gaps params) (barWidth params) (1 + (length $ columns params)) dataFilePath