Chart 1.0 → 1.1
raw patch · 10 files changed
+729/−399 lines, 10 filesdep ~basedep ~colourdep ~lens
Dependency ranges changed: base, colour, lens, operational
Files
- Chart.cabal +4/−4
- Graphics/Rendering/Chart/Axis/Indexed.hs +3/−0
- Graphics/Rendering/Chart/Axis/LocalTime.hs +3/−1
- Graphics/Rendering/Chart/Axis/Types.hs +59/−23
- Graphics/Rendering/Chart/Axis/Unit.hs +6/−0
- Graphics/Rendering/Chart/Drawing.hs +12/−7
- Graphics/Rendering/Chart/Layout.hs +627/−347
- Graphics/Rendering/Chart/Plot/Bars.hs +2/−2
- Graphics/Rendering/Chart/Simple.hs +2/−2
- Graphics/Rendering/Chart/Simple/Internal.hs +11/−13
Chart.cabal view
@@ -1,5 +1,5 @@ Name: Chart-Version: 1.0+Version: 1.1 License: BSD3 License-file: LICENSE Copyright: Tim Docker, 2006-2010@@ -16,10 +16,10 @@ Build-depends: base >= 3 && < 5 , old-locale , time, mtl, array- , lens >= 3.9- , colour >= 2.2.1+ , lens >= 3.9 && < 3.11+ , colour >= 2.2.1 && < 2.4 , data-default-class < 0.1- , operational >= 0.2.2+ , operational >= 0.2.2 && < 0.3 Exposed-modules: Graphics.Rendering.Chart,
Graphics/Rendering/Chart/Axis/Indexed.hs view
@@ -13,6 +13,8 @@ autoIndexAxis, addIndexes, ) where+ +import Data.Default.Class import Graphics.Rendering.Chart.Axis.Types @@ -34,6 +36,7 @@ -- list of strings are the labels to be used. autoIndexAxis :: Integral i => [String] -> [i] -> AxisData i autoIndexAxis labels vs = AxisData {+ _axis_visibility = def { _axis_show_ticks = False }, _axis_viewport = vport, _axis_tropweiv = invport, _axis_ticks = [],
Graphics/Rendering/Chart/Axis/LocalTime.hs view
@@ -11,7 +11,8 @@ autoTimeAxis, days, months, years ) where-+ +import Data.Default.Class import Data.Time import Data.Fixed import System.Locale (defaultTimeLocale)@@ -87,6 +88,7 @@ TimeSeq -> TimeLabelFn -> TimeLabelAlignment -> AxisFn LocalTime timeAxis tseq lseq labelf lal cseq contextf clal pts = AxisData {+ _axis_visibility = def, _axis_viewport = vmap(min', max'), _axis_tropweiv = invmap(min', max'), _axis_ticks = [ (t,2) | t <- times] ++ [ (t,5) | t <- ltimes, visible t],
Graphics/Rendering/Chart/Axis/Types.hs view
@@ -11,6 +11,7 @@ module Graphics.Rendering.Chart.Axis.Types( AxisData(..),+ AxisVisibility(..), AxisT(..), AxisStyle(..), PlotValue(..),@@ -36,10 +37,13 @@ axisGridAtBigTicks, axisGridAtLabels, axisGridHide,- axisTicksHide,- axisLabelsHide, axisLabelsOverride,+ + axis_show_line,+ axis_show_ticks,+ axis_show_labels, + axis_visibility, axis_viewport, axis_tropweiv, axis_ticks,@@ -75,9 +79,25 @@ fromValue:: Double -> a autoAxis :: AxisFn a +-- | Configures whick visual elements of a axis are shown at the+-- appropriate edge of a plot area.+data AxisVisibility = AxisVisibility+ { -- | Whether to display a line along the axis.+ _axis_show_line :: Bool+ + -- | Whether to display the tick marks.+ , _axis_show_ticks :: Bool++ -- | Whether to display the labels.+ , _axis_show_labels :: Bool+ }+ -- | The basic data associated with an axis showing values of type x. data AxisData x = AxisData {-+ + -- | Which parts of the axis shall be displayed.+ _axis_visibility :: AxisVisibility,+ -- | The _axis_viewport function maps values into device coordinates. _axis_viewport :: Range -> x -> Double, @@ -106,8 +126,11 @@ -- | Control values for how an axis gets displayed. data AxisStyle = AxisStyle {+ -- | 'LineStyle' to use for axis line and ticks. _axis_line_style :: LineStyle,+ -- | 'FontStyle' to use for axis labels. _axis_label_style :: FontStyle,+ -- | 'LineStyle' to use for axis grid. _axis_grid_style :: LineStyle, -- | How far the labels are to be drawn from the axis.@@ -155,25 +178,21 @@ [] -> [] ls -> head ls --- | Modifier to remove ticks from an axis-axisTicksHide :: AxisData x -> AxisData x-axisTicksHide ad = ad{ _axis_ticks = [] }---- | Modifier to remove labels from an axis-axisLabelsHide :: AxisData x -> AxisData x-axisLabelsHide ad = ad{ _axis_labels = []}- -- | Modifier to change labels on an axis axisLabelsOverride :: [(x,String)] -> AxisData x -> AxisData x axisLabelsOverride o ad = ad{ _axis_labels = [o] } minsizeAxis :: AxisT x -> ChartBackend RectSize minsizeAxis (AxisT at as rev ad) = do+ let labelVis = _axis_show_labels $ _axis_visibility $ ad+ tickVis = _axis_show_ticks $ _axis_visibility $ ad+ labels = if labelVis then labelTexts ad else []+ ticks = if tickVis then _axis_ticks ad else [] labelSizes <- withFontStyle (_axis_label_style as) $ do- mapM (mapM textDimension) (labelTexts ad)+ mapM (mapM textDimension) labels let ag = _axis_label_gap as- let tsize = maximum ([0] ++ [ max 0 (-l) | (v,l) <- _axis_ticks ad ])+ let tsize = maximum ([0] ++ [ max 0 (-l) | (v,l) <- ticks ]) let hw = maximum0 (map (maximum0.map fst) labelSizes) let hh = ag + tsize + (sum . intersperse ag . map (maximum0.map snd) $ labelSizes)@@ -216,16 +235,20 @@ renderAxis :: AxisT x -> RectSize -> ChartBackend (PickFn x) renderAxis at@(AxisT et as rev ad) sz = do let ls = _axis_line_style as- withLineStyle (ls {_line_cap = LineCapSquare}) $ do- p <- alignStrokePoints [Point sx sy,Point ex ey]- strokePointPath p- withLineStyle (ls {_line_cap = LineCapButt}) $ do- mapM_ drawTick (_axis_ticks ad)- withFontStyle (_axis_label_style as) $ do- labelSizes <- mapM (mapM textDimension) (labelTexts ad)- let sizes = map ((+ag).maximum0.map coord) labelSizes- let offsets = scanl (+) ag sizes- mapM_ drawLabels (zip offsets (_axis_labels ad))+ vis = _axis_visibility ad+ when (_axis_show_line vis) $ do + withLineStyle (ls {_line_cap = LineCapSquare}) $ do+ p <- alignStrokePoints [Point sx sy,Point ex ey]+ strokePointPath p+ when (_axis_show_ticks vis) $ do+ withLineStyle (ls {_line_cap = LineCapButt}) $ do+ mapM_ drawTick (_axis_ticks ad)+ when (_axis_show_labels vis) $ do+ withFontStyle (_axis_label_style as) $ do+ labelSizes <- mapM (mapM textDimension) (labelTexts ad)+ let sizes = map ((+ag).maximum0.map coord) labelSizes+ let offsets = scanl (+) ag sizes+ mapM_ drawLabels (zip offsets (_axis_labels ad)) return pickfn where (sx,sy,ex,ey,tp,axisPoint,invAxisPoint) = axisMapping at sz@@ -336,6 +359,7 @@ -- labels, and the labelling function makeAxis :: PlotValue x => (x -> String) -> ([x],[x],[x]) -> AxisData x makeAxis labelf (labelvs, tickvs, gridvs) = AxisData {+ _axis_visibility = def, _axis_viewport = newViewport, _axis_tropweiv = newTropweiv, _axis_ticks = newTicks,@@ -355,6 +379,7 @@ makeAxis' :: Ord x => (x -> Double) -> (Double -> x) -> (x -> String) -> ([x],[x],[x]) -> AxisData x makeAxis' t f labelf (labelvs, tickvs, gridvs) = AxisData {+ _axis_visibility = def, _axis_viewport = linMap t (minimum labelvs, maximum labelvs), _axis_tropweiv = invLinMap f t (minimum labelvs, maximum labelvs), _axis_ticks = zip tickvs (repeat 2) ++ zip labelvs (repeat 5),@@ -365,9 +390,11 @@ ---------------------------------------------------------------------- +-- | The default 'LineStyle' of an axis. defaultAxisLineStyle :: LineStyle defaultAxisLineStyle = solidLine 1 $ opaque black +-- | The default 'LineStyle' of a plot area grid. defaultGridLineStyle :: LineStyle defaultGridLineStyle = dashedLine 1 [5,5] $ opaque lightgrey @@ -383,6 +410,14 @@ , _axis_label_gap = 10 } +-- | By default all parts of a axis are visible.+instance Default AxisVisibility where+ def = AxisVisibility+ { _axis_show_line = True+ , _axis_show_ticks = True+ , _axis_show_labels = True+ }+ ---------------------------------------------------------------------- -- | A linear mapping of points in one range to another.@@ -409,6 +444,7 @@ where doubleRange = t v4 - t v3 +$( makeLenses ''AxisVisibility ) $( makeLenses ''AxisData ) $( makeLenses ''AxisStyle )
Graphics/Rendering/Chart/Axis/Unit.hs view
@@ -10,6 +10,8 @@ unitAxis, ) where +import Data.Default.Class+ import Graphics.Rendering.Chart.Axis.Types instance PlotValue () where@@ -19,6 +21,10 @@ unitAxis :: AxisData () unitAxis = AxisData {+ _axis_visibility = def + { _axis_show_ticks = False+ , _axis_show_labels = False + }, _axis_viewport = \(x0,x1) _ -> (x0+x1)/2, _axis_tropweiv = \_ _ -> (), _axis_ticks = [((), 0)],
Graphics/Rendering/Chart/Drawing.hs view
@@ -9,9 +9,7 @@ -- Note that Template Haskell is used to derive accessor functions -- (see 'Control.Lens') for each field of the following data types: ----- * 'LineStyle'------ * 'FontStyle'+-- * 'PointStyle' -- -- These accessors are not shown in this API documentation. They have -- the same name as the field, but with the trailing underscore@@ -22,6 +20,8 @@ -- @ -- +{-# LANGUAGE TemplateHaskell #-}+ module Graphics.Rendering.Chart.Drawing ( -- * Point Types and Drawing PointShape(..)@@ -75,6 +75,13 @@ -- * Backend and general Types , module Graphics.Rendering.Chart.Backend+ + -- * Accessors+ , point_color+ , point_border_color+ , point_border_width+ , point_radius+ , point_shape ) where import Data.Default.Class@@ -304,10 +311,7 @@ | PointShapeStar -- ^ Combination of a cross and a plus. -- | Abstract data type for the style of a plotted point.------ The contained Cairo action draws a point in the desired--- style, at the supplied device coordinates.-data PointStyle = PointStyle +data PointStyle = PointStyle { _point_color :: AlphaColour Double -- ^ The color to fill the point with. , _point_border_color :: AlphaColour Double@@ -463,3 +467,4 @@ solidFillStyle :: AlphaColour Double -> FillStyle solidFillStyle cl = FillStyleSolid cl +$( makeLenses ''PointStyle )
Graphics/Rendering/Chart/Layout.hs view
@@ -10,15 +10,17 @@ -- Note that Template haskell is used to derive accessor functions -- (see 'Control.Lens') for each field of the following data types: ----- * 'Layout1'+-- * 'Layout'+-- +-- * 'LayoutLR' -- -- * 'StackedLayouts' -- -- * 'LayoutAxis' -- -- These accessors are not shown in this API documentation. They have--- the same name as the field, but with the trailing underscore--- dropped. Hence for data field f_::F in type D, they have type+-- the same name as the field, but with the leading underscore+-- dropped. Hence for data field _f::F in type D, they have type -- -- @ -- f :: Control.Lens.Lens' D F@@ -28,51 +30,67 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ExistentialQuantification #-} -module Graphics.Rendering.Chart.Layout(- Layout1(..),- LayoutAxis(..),- Layout1Pick(..),- StackedLayouts(..),- StackedLayout(..),- MAxisFn,-- defaultLayout1,- layout1ToRenderable,- linkAxes,- independentAxes,-- updateAllAxesStyles,- setLayout1Foreground,+module Graphics.Rendering.Chart.Layout+ ( Layout(..)+ , LayoutLR(..)+ , LayoutAxis(..)+ , LayoutPick(..)+ , StackedLayouts(..)+ , StackedLayout(..)+ , MAxisFn+ + , layoutToRenderable+ , layoutLRToRenderable - defaultLayoutAxis,- laxis_title_style,- laxis_title,- laxis_style,- laxis_visible,- laxis_generate,- laxis_override,- laxis_reverse,+ , setLayoutForeground+ , updateAllAxesStyles+ , setLayoutLRForeground+ , updateAllAxesStylesLR - layout1_background,- layout1_plot_background,- layout1_title,- layout1_title_style,- layout1_left_axis,- layout1_right_axis,- layout1_top_axis,- layout1_bottom_axis,- layout1_yaxes_control,- layout1_margin,- layout1_plots,- layout1_legend,- layout1_grid_last,+ , defaultLayoutAxis+ , laxis_title_style+ , laxis_title+ , laxis_style+ , laxis_generate+ , laxis_override+ , laxis_reverse+ + , layout_background+ , layout_plot_background+ , layout_title+ , layout_title_style+ , layout_x_axis+ , layout_top_axis_visibility+ , layout_bottom_axis_visibility+ , layout_y_axis+ , layout_left_axis_visibility+ , layout_right_axis_visibility+ , layout_margin+ , layout_plots+ , layout_legend+ , layout_grid_last+ + , layoutlr_background+ , layoutlr_plot_background+ , layoutlr_title+ , layoutlr_title_style+ , layoutlr_x_axis+ , layoutlr_top_axis_visibility+ , layoutlr_bottom_axis_visibility+ , layoutlr_left_axis+ , layoutlr_right_axis+ , layoutlr_left_axis_visibility+ , layoutlr_right_axis_visibility+ , layoutlr_plots+ , layoutlr_legend+ , layoutlr_margin+ , layoutlr_grid_last - defaultStackedLayouts,- slayouts_layouts,- slayouts_compress_xlabels,- slayouts_compress_legend,+ , defaultStackedLayouts+ , slayouts_layouts+ , slayouts_compress_legend - renderStackedLayouts,+ , renderStackedLayouts ) where import Graphics.Rendering.Chart.Axis@@ -94,148 +112,468 @@ -- given the points plotted against that axis. type MAxisFn t = [t] -> Maybe (AxisData t) -data LayoutAxis x = LayoutAxis {- _laxis_title_style :: FontStyle,- _laxis_title :: String,- _laxis_style :: AxisStyle,+-- | Type of axis that is used in 'Layout' and 'LayoutLR'.+-- +-- To generate the actual axis type ('AxisData' and 'AxisT')+-- the '_laxis_generate' function is called and custom settings+-- are applied with '_laxis_override'. Note that the 'AxisVisibility'+-- values in 'Layout' and 'LayoutLR' override visibility related +-- settings of the axis.+data LayoutAxis x = LayoutAxis+ { _laxis_title_style :: FontStyle+ -- ^ Font style to use for the axis title.+ , _laxis_title :: String+ -- ^ Title displayed for the axis.+ , _laxis_style :: AxisStyle+ -- ^ Axis style applied. - -- | Function that determines whether an axis should be visible,- -- based upon the points plotted on this axis. The default value- -- is 'not.null'.- _laxis_visible :: [x] -> Bool,+ , _laxis_generate :: AxisFn x+ -- ^ Function that generates the axis data, based upon the+ -- points plotted. The default value is 'autoAxis'.+ + , _laxis_override :: AxisData x -> AxisData x+ -- ^ Function that can be used to override the generated axis data.+ -- The default value is 'id'.+ + , _laxis_reverse :: Bool+ -- ^ True if left to right (bottom to top) is to show descending values.+ + } - -- | Function that generates the axis data, based upon the- -- points plotted. The default value is 'autoAxis'.- _laxis_generate :: AxisFn x,+-- | Information on what is at a specifc location of a 'Layout' or 'LayoutLR'.+-- This is delivered by the 'PickFn' of a 'Renderable'.+data LayoutPick x y1 y2 = LayoutPick_Legend String -- ^ A legend entry.+ | LayoutPick_Title String -- ^ The title.+ | LayoutPick_XTopAxisTitle String -- ^ The title of the top x axis.+ | LayoutPick_XBottomAxisTitle String -- ^ The title of the bottom x axis.+ | LayoutPick_YLeftAxisTitle String -- ^ The title of the left y axis.+ | LayoutPick_YRightAxisTitle String -- ^ The title of the right y axis.+ | LayoutPick_PlotArea x y1 y2 -- ^ The plot area at the given plot coordinates.+ | LayoutPick_XTopAxis x -- ^ The top x axis at the given plot coordinate.+ | LayoutPick_XBottomAxis x -- ^ The bottom x axis at the given plot coordinate.+ | LayoutPick_YLeftAxis y1 -- ^ The left y axis at the given plot coordinate.+ | LayoutPick_YRightAxis y2 -- ^ The right y axis at the given plot coordinate.+ deriving (Show) - -- | Function that can be used to override the generated axis data.- -- The default value is 'id'.- _laxis_override :: AxisData x -> AxisData x,+type LegendItem = (String,Rect -> ChartBackend ()) - -- | True if left to right (bottom to top) is to show descending values.- _laxis_reverse :: Bool+-- | A Layout value is a single plot area, with single x and y+-- axis. The title is at the top and the legend at the bottom. It's+-- parametrized by the types of values to be plotted on the x+-- and y axes.+data Layout x y = Layout + { _layout_background :: FillStyle+ -- ^ How to fill the background of everything.+ , _layout_plot_background :: Maybe FillStyle+ -- ^ How to fill the background of the plot, + -- if different from the overall background. -}+ , _layout_title :: String+ -- ^ Title to display above the chart.+ , _layout_title_style :: FontStyle+ -- ^ Font style to use for the title. --- | A Layout1 value is a single plot area, with optional: axes on--- each of the 4 sides; title at the top; legend at the bottom. It's--- parameterised by the types of values to be plotted on the horizonal--- and vertical axes.-data Layout1 x y = Layout1 {+ , _layout_x_axis :: LayoutAxis x+ -- ^ Rules to generate the x axis.+ , _layout_top_axis_visibility :: AxisVisibility+ -- ^ Visibility options for the top axis.+ , _layout_bottom_axis_visibility :: AxisVisibility+ -- ^ Visibility options for the bottom axis. - _layout1_background :: FillStyle,- _layout1_plot_background :: Maybe FillStyle,+ , _layout_y_axis :: LayoutAxis y+ -- ^ Rules to generate the y axis.+ , _layout_left_axis_visibility :: AxisVisibility+ -- ^ Visibility options for the left axis.+ , _layout_right_axis_visibility :: AxisVisibility+ -- ^ Visibility options for the right axis. - _layout1_title :: String,- _layout1_title_style :: FontStyle,+ , _layout_plots :: [Plot x y]+ -- ^ The data sets to plot in the chart.+ -- The are ploted over each other. - _layout1_bottom_axis :: LayoutAxis x,- _layout1_top_axis :: LayoutAxis x,- _layout1_left_axis :: LayoutAxis y,- _layout1_right_axis :: LayoutAxis y,+ , _layout_legend :: Maybe LegendStyle+ -- ^ How to style the legend.+ , _layout_margin :: Double+ -- ^ The margin distance to use.+ , _layout_grid_last :: Bool+ -- ^ If the grid shall be rendered+ -- beneath (@False@) or over (@True@) all plots.+ } - -- | Function to map points from the left/right plot- -- to the left/right axes. The default value is 'id'.- _layout1_yaxes_control :: ([y],[y]) -> ([y],[y]),+instance (Ord x, Ord y) => ToRenderable (Layout x y) where+ toRenderable = setPickFn nullPickFn . layoutToRenderable - _layout1_margin :: Double,- _layout1_plots :: [Either (Plot x y) (Plot x y)],- _layout1_legend :: Maybe LegendStyle,+-- | Render the given 'Layout'.+layoutToRenderable :: forall x y . (Ord x, Ord y) => Layout x y -> Renderable (LayoutPick x y y)+layoutToRenderable l = fillBackground (_layout_background l) + $ gridToRenderable (layoutToGrid l)+ where+ layoutToGrid l = aboveN+ [ tval $ titleToRenderable (_layout_margin l) (_layout_title_style l) (_layout_title l)+ , weights (1,1) $ tval $ gridToRenderable $+ addMarginsToGrid (lm,lm,lm,lm) (layoutPlotAreaToGrid l)+ , tval $ renderLegend l (getLegendItems l)+ ] - -- | True if the grid is to be rendered on top of the Plots.- _layout1_grid_last :: Bool-}+ lm = _layout_margin l+ +getLayoutXVals :: Layout x y -> [x]+getLayoutXVals l = concatMap (fst . _plot_all_points) (_layout_plots l) -instance (Ord x, Ord y) => ToRenderable (Layout1 x y) where- toRenderable = setPickFn nullPickFn . layout1ToRenderable+-- | Extract all 'LegendItem's from the plots of a 'Layout'.+getLegendItems :: Layout x y -> [LegendItem]+getLegendItems l = concat [ _plot_legend p | p <- _layout_plots l ] -data Layout1Pick x y = L1P_Legend String- | L1P_Title String- | L1P_BottomAxisTitle String- | L1P_TopAxisTitle String- | L1P_LeftAxisTitle String- | L1P_RightAxisTitle String- | L1P_PlotArea x y y- | L1P_BottomAxis x- | L1P_TopAxis x- | L1P_LeftAxis y- | L1P_RightAxis y- deriving (Show)+-- | Render the given 'LegendItem's for a 'Layout'.+renderLegend :: Layout x y -> [LegendItem] -> Renderable (LayoutPick x y y)+renderLegend l legItems = gridToRenderable g+ where+ g = besideN [ tval $ mkLegend (_layout_legend l) (_layout_margin l) legItems+ , weights (1,1) $ tval $ emptyRenderable ] -type LegendItem = (String,Rect -> ChartBackend ())+-- | Render the plot area of a 'Layout'. This consists of the +-- actual plot area with all plots, the axis and their titles.+layoutPlotAreaToGrid :: forall x y. (Ord x, Ord y) =>+ Layout x y -> Grid (Renderable (LayoutPick x y y))+layoutPlotAreaToGrid l = buildGrid LayoutGridElements{+ lge_plots = mfill (_layout_plot_background l) $ plotsToRenderable l,+ lge_taxis = (tAxis,_laxis_title $ _layout_x_axis l, _laxis_title_style $ _layout_x_axis l),+ lge_baxis = (bAxis,_laxis_title $ _layout_x_axis l, _laxis_title_style $ _layout_x_axis l),+ lge_laxis = (lAxis,_laxis_title $ _layout_y_axis l, _laxis_title_style $ _layout_y_axis l),+ lge_raxis = (rAxis,"", def),+ lge_margin = _layout_margin l+ }+ where+ xvals = [ x | p <- (_layout_plots l), x <- fst $ _plot_all_points p]+ yvals = [ y | p <- (_layout_plots l), y <- snd $ _plot_all_points p] + bAxis = mkAxis E_Bottom (overrideAxisVisibility l _layout_x_axis _layout_bottom_axis_visibility) xvals+ tAxis = mkAxis E_Top (overrideAxisVisibility l _layout_x_axis _layout_top_axis_visibility ) xvals+ lAxis = mkAxis E_Left (overrideAxisVisibility l _layout_y_axis _layout_left_axis_visibility ) yvals+ rAxis = mkAxis E_Right (overrideAxisVisibility l _layout_y_axis _layout_right_axis_visibility ) yvals+ axes = (bAxis,lAxis,tAxis,rAxis)++ plotsToRenderable l = Renderable {+ minsize = return (0,0),+ render = renderPlots l+ }++ -- | Render the plots of a 'Layout' to a plot area of given size.+ renderPlots :: Layout x y -> RectSize -> ChartBackend (PickFn (LayoutPick x y y))+ renderPlots l sz@(w,h) = do+ when (not (_layout_grid_last l)) (renderGrids sz axes)+ withClipRegion (Rect (Point 0 0) (Point w h)) $ do+ mapM_ rPlot (_layout_plots l)+ when (_layout_grid_last l) (renderGrids sz axes)+ return pickfn+ where+ rPlot p = renderSinglePlot sz bAxis lAxis p++ xr = (0, w)+ yr = (h, 0)++ pickfn :: PickFn (LayoutPick x y y)+ pickfn (Point x y) = do -- Maybe monad+ xat <- mxat+ yat <- myat+ return (LayoutPick_PlotArea (mapx xat x) (mapy yat y) (mapy yat y))+ where+ mxat = case (bAxis,tAxis) of+ (Just at,_) -> Just at+ (_,Just at) -> Just at+ (Nothing,Nothing) -> Nothing+ myat = case (lAxis,rAxis) of+ (Just at,_) -> Just at+ (_,Just at) -> Just at+ (Nothing,Nothing) -> Nothing+ mapx (AxisT _ _ rev ad) x = _axis_tropweiv ad (optPairReverse rev xr) x+ mapy (AxisT _ _ rev ad) y = _axis_tropweiv ad (optPairReverse rev yr) y++-- | Empty 'Layout' without title and plots. The background is white and +-- the grid is drawn beneath all plots. There will be a legend. The top+-- and right axis will not be visible.+instance (PlotValue x, PlotValue y) => Default (Layout x y) where+ def = Layout+ { _layout_background = solidFillStyle $ opaque white+ , _layout_plot_background = Nothing++ , _layout_title = ""+ , _layout_title_style = def { _font_size = 15+ , _font_weight = FontWeightBold }+ + , _layout_x_axis = def+ , _layout_top_axis_visibility = def { _axis_show_line = False+ , _axis_show_ticks = False+ , _axis_show_labels = False }+ , _layout_bottom_axis_visibility = def+ , _layout_y_axis = def+ , _layout_left_axis_visibility = def+ , _layout_right_axis_visibility = def { _axis_show_line = False+ , _axis_show_ticks = False+ , _axis_show_labels = False }++ , _layout_margin = 10+ , _layout_plots = []+ , _layout_legend = Just def+ , _layout_grid_last = False+ }++----------------------------------------------------------------------+ +-- | A LayoutLR value is a single plot area, with an x axis and+-- independent left and right y axes, with a title at the top;+-- legend at the bottom. It's parametrized by the types of values+-- to be plotted on the x and two y axes.+data LayoutLR x y1 y2 = LayoutLR + { _layoutlr_background :: FillStyle+ -- ^ How to fill the background of everything.+ , _layoutlr_plot_background :: Maybe FillStyle+ -- ^ How to fill the background of the plot, + -- if different from the overall background.++ , _layoutlr_title :: String+ -- ^ Title to display above the chart.+ , _layoutlr_title_style :: FontStyle+ -- ^ Font style to use for the title.++ , _layoutlr_x_axis :: LayoutAxis x+ -- ^ Rules to generate the x axis.+ , _layoutlr_top_axis_visibility :: AxisVisibility+ -- ^ Visibility options for the top axis.+ , _layoutlr_bottom_axis_visibility :: AxisVisibility+ -- ^ Visibility options for the bottom axis.++ , _layoutlr_left_axis :: LayoutAxis y1+ -- ^ Rules to generate the left y axis.+ , _layoutlr_left_axis_visibility :: AxisVisibility+ -- ^ Visibility options for the left axis.+ , _layoutlr_right_axis :: LayoutAxis y2+ -- ^ Rules to generate the right y axis.+ , _layoutlr_right_axis_visibility :: AxisVisibility+ -- ^ Visibility options for the right axis.+ + , _layoutlr_plots :: [Either (Plot x y1) (Plot x y2)]+ -- ^ The data sets to plot in the chart.+ -- The are ploted over each other.+ -- The either type associates the plot with the+ -- left or right y axis.++ , _layoutlr_legend :: Maybe LegendStyle+ -- ^ How to style the legend.+ , _layoutlr_margin :: Double+ -- ^ The margin distance to use.+ , _layoutlr_grid_last :: Bool+ -- ^ If the grid shall be rendered+ -- beneath (@False@) or over (@True@) all plots.+ }++instance (Ord x, Ord yl, Ord yr) => ToRenderable (LayoutLR x yl yr) where+ toRenderable = setPickFn nullPickFn . layoutLRToRenderable++-- | Render the given 'LayoutLR'.+layoutLRToRenderable :: forall x yl yr . (Ord x, Ord yl, Ord yr) + => LayoutLR x yl yr -> Renderable (LayoutPick x yl yr)+layoutLRToRenderable l = fillBackground (_layoutlr_background l) + $ gridToRenderable (layoutLRToGrid l)+ where+ layoutLRToGrid l = aboveN+ [ tval $ titleToRenderable (_layoutlr_margin l) (_layoutlr_title_style l) (_layoutlr_title l)+ , weights (1,1) $ tval $ gridToRenderable $+ addMarginsToGrid (lm,lm,lm,lm) (layoutLRPlotAreaToGrid l)+ , tval $ renderLegendLR l (getLegendItemsLR l)+ ]++ lm = _layoutlr_margin l++getLayoutLRXVals :: LayoutLR x yl yr -> [x]+getLayoutLRXVals l = concatMap deEither $ _layoutlr_plots l+ where+ deEither :: Either (Plot x yl) (Plot x yr) -> [x]+ deEither (Left x) = fst $ _plot_all_points x+ deEither (Right x) = fst $ _plot_all_points x++-- | Extract all 'LegendItem's from the plots of a 'LayoutLR'.+-- Left and right plot legend items are still separated.+getLegendItemsLR :: LayoutLR x yl yr -> ([LegendItem],[LegendItem])+getLegendItemsLR l = (+ concat [ _plot_legend p | (Left p ) <- (_layoutlr_plots l) ],+ concat [ _plot_legend p | (Right p) <- (_layoutlr_plots l) ]+ )++-- | Render the given 'LegendItem's for a 'LayoutLR'.+renderLegendLR :: LayoutLR x yl yr -> ([LegendItem],[LegendItem]) -> Renderable (LayoutPick x yl yr)+renderLegendLR l (lefts,rights) = gridToRenderable g+ where+ g = besideN [ tval $ mkLegend (_layoutlr_legend l) (_layoutlr_margin l) lefts+ , weights (1,1) $ tval $ emptyRenderable+ , tval $ mkLegend (_layoutlr_legend l) (_layoutlr_margin l) rights ]+ lm = _layoutlr_margin l++layoutLRPlotAreaToGrid :: forall x yl yr. (Ord x, Ord yl, Ord yr) + => LayoutLR x yl yr + -> Grid (Renderable (LayoutPick x yl yr))+layoutLRPlotAreaToGrid l = buildGrid LayoutGridElements{+ lge_plots = mfill (_layoutlr_plot_background l) $ plotsToRenderable l,+ lge_taxis = (tAxis,_laxis_title $ _layoutlr_x_axis l, _laxis_title_style $ _layoutlr_x_axis l),+ lge_baxis = (bAxis,_laxis_title $ _layoutlr_x_axis l, _laxis_title_style $ _layoutlr_x_axis l),+ lge_laxis = (lAxis,_laxis_title $ _layoutlr_left_axis l, _laxis_title_style $ _layoutlr_left_axis l),+ lge_raxis = (rAxis,_laxis_title $ _layoutlr_right_axis l, _laxis_title_style $ _layoutlr_right_axis l),+ lge_margin = _layoutlr_margin l+ }+ where+ xvals = [ x | (Left p) <- _layoutlr_plots l, x <- fst $ _plot_all_points p]+ ++ [ x | (Right p) <- _layoutlr_plots l, x <- fst $ _plot_all_points p]+ yvalsL = [ y | (Left p) <- _layoutlr_plots l, y <- snd $ _plot_all_points p]+ yvalsR = [ y | (Right p) <- _layoutlr_plots l, y <- snd $ _plot_all_points p]+ + bAxis = mkAxis E_Bottom (overrideAxisVisibility l _layoutlr_x_axis _layoutlr_bottom_axis_visibility) xvals+ tAxis = mkAxis E_Top (overrideAxisVisibility l _layoutlr_x_axis _layoutlr_top_axis_visibility ) xvals+ lAxis = mkAxis E_Left (overrideAxisVisibility l _layoutlr_left_axis _layoutlr_left_axis_visibility ) yvalsL+ rAxis = mkAxis E_Right (overrideAxisVisibility l _layoutlr_right_axis _layoutlr_right_axis_visibility) yvalsR+ axes = (bAxis,lAxis,tAxis,rAxis)++ plotsToRenderable l = Renderable {+ minsize = return (0,0),+ render = renderPlots l+ }++ renderPlots :: LayoutLR x yl yr -> RectSize -> ChartBackend (PickFn (LayoutPick x yl yr))+ renderPlots l sz@(w,h) = do+ when (not (_layoutlr_grid_last l)) (renderGrids sz axes)+ withClipRegion (Rect (Point 0 0) (Point w h)) $ do+ mapM_ rPlot (_layoutlr_plots l)+ when (_layoutlr_grid_last l) (renderGrids sz axes)+ return pickfn+ where+ rPlot (Left p) = renderSinglePlot sz bAxis lAxis p+ rPlot (Right p) = renderSinglePlot sz bAxis rAxis p++ xr = (0, w)+ yr = (h, 0)++ pickfn (Point x y) = do -- Maybe monad+ xat <- mxat+ (yatL,yatR) <- myats+ return (LayoutPick_PlotArea (mapx xat x) (mapy yatL y) (mapy yatR y))+ where+ mxat = case (bAxis,tAxis) of+ (Just at,_) -> Just at+ (_,Just at) -> Just at+ (Nothing,Nothing) -> Nothing+ myats = case (lAxis,rAxis) of+ (Just at1,Just at2) -> Just (at1,at2)+ (_,_) -> Nothing+ mapx (AxisT _ _ rev ad) x = _axis_tropweiv ad (optPairReverse rev xr) x+ mapy (AxisT _ _ rev ad) y = _axis_tropweiv ad (optPairReverse rev yr) y++----------------------------------------------------------------------+ -- | A layout with its y type hidden, so that it can be stacked--- with other layouts (with differing y types)-data StackedLayout x = forall y . Ord y => StackedLayout (Layout1 x y)+-- with other layouts with differing y axis, but the same x axis.+-- See 'StackedLayouts'.+data StackedLayout x = forall y . (Ord y) => StackedLayout (Layout x y)+ -- ^ A 'Layout' to stack.+ | forall yl yr . (Ord yl, Ord yr) => StackedLayoutLR (LayoutLR x yl yr)+ -- ^ A 'LayoutLR' to stack. --- | A container for a set of vertically stacked layouts-data StackedLayouts x = StackedLayouts {- _slayouts_layouts :: [StackedLayout x],- _slayouts_compress_xlabels :: Bool,- _slayouts_compress_legend :: Bool-}+-- | A container for a set of vertically 'StackedLayout's.+-- The x axis of the different layouts will be aligned.+data StackedLayouts x = StackedLayouts + { _slayouts_layouts :: [StackedLayout x]+ -- ^ The stacked layouts from top (first element) to bottom (last element).+ , _slayouts_compress_legend :: Bool+ -- ^ If the different legends shall be combined in one legend at the bottom.+ } {-# DEPRECATED defaultStackedLayouts "Use the according Data.Default instance!" #-} defaultStackedLayouts :: StackedLayouts x defaultStackedLayouts = def +-- | A empty 'StackedLayout' with compressions applied. instance Default (StackedLayouts x) where- def = StackedLayouts [] True True+ def = StackedLayouts [] True -- | Render several layouts with the same x-axis type and range, -- vertically stacked so that their origins and x-values are aligned. ----- The legends from all the charts may be optionally combined, and shown--- once on the bottom chart. The x labels may be optionally removed so that--- they are only shown once.-renderStackedLayouts :: (Ord x) => StackedLayouts x -> Renderable ()+-- The legends from all the charts may be optionally combined, and shown+-- once on the bottom chart. See 'StackedLayouts' for further information.+renderStackedLayouts :: forall x. (Ord x) => StackedLayouts x -> Renderable () renderStackedLayouts (StackedLayouts{_slayouts_layouts=[]}) = emptyRenderable renderStackedLayouts slp@(StackedLayouts{_slayouts_layouts=sls@(sl1:_)}) = gridToRenderable g where g = fullOverlayUnder (fillBackground bg emptyRenderable) $ foldr (above.mkGrid) nullt (zip sls [0,1..])- - mkGrid ((StackedLayout l),i)- = (noPickFn $ layout1TitleToRenderable l)+ + mkGrid :: (StackedLayout x, Int) -> Grid (Renderable ())+ mkGrid (sl, i)+ = titleR `wideAbove`- (addMarginsToGrid (lm,lm,lm,lm) $ mkPlotArea baxis taxis)+ (addMarginsToGrid (lm,lm,lm,lm) $ mkPlotArea usedAxis) `aboveWide`- (if showLegend then noPickFn $ renderLegend l legenditems else emptyRenderable)-+ (if showLegend then legendR else emptyRenderable) where+ titleR = case sl of+ StackedLayout l -> noPickFn $ titleToRenderable (_layout_margin l) (_layout_title_style l) (_layout_title l)+ StackedLayoutLR l -> noPickFn $ titleToRenderable (_layoutlr_margin l) (_layoutlr_title_style l) (_layoutlr_title l)+ legendR = case sl of+ StackedLayout l -> noPickFn $ renderLegend l $ fst legenditems+ StackedLayoutLR l -> noPickFn $ renderLegendLR l legenditems+ legenditems = case (_slayouts_compress_legend slp,isBottomPlot) of- (False,_) -> getLegendItems l- (True,True) -> alllegendItems+ (False,_) -> case sl of+ StackedLayout l -> (getLegendItems l, [])+ StackedLayoutLR l -> getLegendItemsLR l+ (True,True) -> allLegendItems (True,False) -> ([],[])-- mkPlotArea bx tx = fmap (mapPickFn (const ()))- $ layout1PlotAreaToGrid l{_layout1_bottom_axis=bx,_layout1_top_axis=tx}+ + mkPlotArea :: LayoutAxis x -> Grid (Renderable ())+ mkPlotArea axis = case sl of+ StackedLayout l -> fmap noPickFn + $ layoutPlotAreaToGrid + $ l { _layout_x_axis = axis }+ StackedLayoutLR l -> fmap noPickFn + $ layoutLRPlotAreaToGrid + $ l { _layoutlr_x_axis = axis } showLegend = not (null (fst legenditems)) || not (null (snd legenditems)) - isTopPlot = i == 0- isBottomPlot = i == length sls -1-- lm = _layout1_margin l-- baxis = mkAxis (_layout1_bottom_axis l) (isBottomPlot || not (_slayouts_compress_xlabels slp))- taxis = mkAxis (_layout1_top_axis l) (isTopPlot || not (_slayouts_compress_xlabels slp))-- mkAxis a showLabels = a{- _laxis_generate=const (_laxis_generate a all_xvals),- _laxis_override= if showLabels then id else \ad -> ad{_axis_labels=[]}- }+ isBottomPlot = i == length sls - 1 - bg = (\(StackedLayout l) -> _layout1_background l) sl1+ lm = case sl of+ StackedLayout l -> _layout_margin l+ StackedLayoutLR l -> _layoutlr_margin l+ + xAxis :: LayoutAxis x+ xAxis = case sl of+ StackedLayout l -> _layout_x_axis l+ StackedLayoutLR l -> _layoutlr_x_axis l+ + usedAxis :: LayoutAxis x+ usedAxis = xAxis + { _laxis_generate = const (_laxis_generate xAxis all_xvals) }+ + bg = case sl1 of+ StackedLayout l -> _layout_background l+ StackedLayoutLR l -> _layoutlr_background l - all_xvals = concatMap (\(StackedLayout l) -> getLayout1XVals l) sls+ getXVals :: StackedLayout x -> [x]+ getXVals (StackedLayout l) = getLayoutXVals l+ getXVals (StackedLayoutLR l) = getLayoutLRXVals l+ + all_xvals = concatMap getXVals sls - alllegendItems = (concatMap (fst.legendItems) sls, concatMap (snd.legendItems) sls)- legendItems (StackedLayout l) = (getLegendItems l)+ allLegendItems = (concatMap (fst.legendItems) sls, concatMap (snd.legendItems) sls) + legendItems :: StackedLayout x -> ([LegendItem], [LegendItem])+ legendItems (StackedLayout l) = (getLegendItems l, [])+ lebendItems (StackedLayoutLR l) = getLegendItemsLR l+ noPickFn :: Renderable a -> Renderable () noPickFn = mapPickFn (const ()) +----------------------------------------------------------------------+ addMarginsToGrid :: (Double,Double,Double,Double) -> Grid (Renderable a) -> Grid (Renderable a) addMarginsToGrid (t,b,l,r) g = aboveN [@@ -250,241 +588,178 @@ bs = tval $ spacer (0,b) rs = tval $ spacer (r,0) -layout1ToRenderable :: (Ord x, Ord y) =>- Layout1 x y -> Renderable (Layout1Pick x y)-layout1ToRenderable l = - fillBackground (_layout1_background l) $ gridToRenderable (layout1ToGrid l)--layout1ToGrid :: (Ord x, Ord y) =>- Layout1 x y -> Grid (Renderable (Layout1Pick x y))-layout1ToGrid l = aboveN- [ tval $ layout1TitleToRenderable l- , weights (1,1) $ tval $ gridToRenderable $- addMarginsToGrid (lm,lm,lm,lm) (layout1PlotAreaToGrid l)- , tval $ layout1LegendsToRenderable l- ]- where- lm = _layout1_margin l--layout1TitleToRenderable :: (Ord x, Ord y) => Layout1 x y- -> Renderable (Layout1Pick x y)-layout1TitleToRenderable l | null (_layout1_title l) = emptyRenderable-layout1TitleToRenderable l = addMargins (lm/2,0,0,0)- (mapPickFn L1P_Title title)+titleToRenderable :: Double -> FontStyle -> String -> Renderable (LayoutPick x yl yr)+titleToRenderable lm fs "" = emptyRenderable+titleToRenderable lm fs s = addMargins (lm/2,0,0,0) (mapPickFn LayoutPick_Title title) where- title = label (_layout1_title_style l) HTA_Centre VTA_Centre- (_layout1_title l)- lm = _layout1_margin l+ title = label fs HTA_Centre VTA_Centre s -getLayout1XVals :: Layout1 x y -> [x]-getLayout1XVals l = concatMap (fst._plot_all_points.deEither) (_layout1_plots l)- where- deEither (Left x) = x- deEither (Right x) = x+mkLegend :: Maybe LegendStyle -> Double -> [LegendItem] -> Renderable (LayoutPick x yl yr)+mkLegend ls lm vals = case ls of+ Nothing -> emptyRenderable+ Just ls -> case filter ((/="").fst) vals of+ [] -> emptyRenderable ;+ lvs -> addMargins (0,lm,lm,lm) $+ mapPickFn LayoutPick_Legend $ legendToRenderable (Legend ls lvs) -getLegendItems :: Layout1 x y -> ([LegendItem],[LegendItem])-getLegendItems l = (- concat [ _plot_legend p | (Left p ) <- (_layout1_plots l) ],- concat [ _plot_legend p | (Right p) <- (_layout1_plots l) ]- )--renderLegend :: Layout1 x y -> ([LegendItem],[LegendItem]) -> Renderable (Layout1Pick x y)-renderLegend l (lefts,rights) = gridToRenderable g- where- g = besideN [ tval $ mkLegend lefts- , weights (1,1) $ tval $ emptyRenderable- , tval $ mkLegend rights ]-- lm = _layout1_margin l-- mkLegend vals = case (_layout1_legend l) of- Nothing -> emptyRenderable- Just ls -> case filter ((/="").fst) vals of- [] -> emptyRenderable ;- lvs -> addMargins (0,lm,lm,lm) $- mapPickFn L1P_Legend $ legendToRenderable (Legend ls lvs)+data LayoutGridElements x yl yr = LayoutGridElements {+ lge_plots :: Renderable (LayoutPick x yl yr),+ + lge_taxis :: (Maybe (AxisT x),String,FontStyle),+ lge_baxis :: (Maybe (AxisT x),String,FontStyle),+ lge_laxis :: (Maybe (AxisT yl),String,FontStyle),+ lge_raxis :: (Maybe (AxisT yr),String,FontStyle), -layout1LegendsToRenderable :: (Ord x, Ord y) =>- Layout1 x y -> Renderable (Layout1Pick x y)-layout1LegendsToRenderable l = renderLegend l (getLegendItems l)+ lge_margin :: Double+} -layout1PlotAreaToGrid :: forall x y. (Ord x, Ord y) =>- Layout1 x y -> Grid (Renderable (Layout1Pick x y))-layout1PlotAreaToGrid l = layer2 `overlay` layer1+buildGrid :: (Ord x, Ord yl, Ord yr) => LayoutGridElements x yl yr -> Grid (Renderable (LayoutPick x yl yr))+buildGrid lge = layer2 `overlay` layer1 where layer1 = aboveN [ besideN [er, er, er, er ]- , besideN [er, er, er, er ] , besideN [er, er, er, weights (1,1) plots ] ] layer2 = aboveN- [ besideN [er, er, er, ttitle, er, er, er ]- , besideN [er, er, tl, taxis, tr, er, er ]+ [ besideN [er, er, tl, taxis, tr, er, er ] , besideN [ltitle, lam, laxis, er, raxis, ram, rtitle ] , besideN [er, er, bl, baxis, br, er, er ] , besideN [er, er, er, btitle, er, er, er ] ]- - (ttitle,_) = atitle HTA_Centre VTA_Bottom 0 _layout1_top_axis L1P_TopAxisTitle - (btitle,_) = atitle HTA_Centre VTA_Top 0 _layout1_bottom_axis L1P_BottomAxisTitle- (ltitle,lam) = atitle HTA_Right VTA_Centre 270 _layout1_left_axis L1P_LeftAxisTitle- (rtitle,ram) = atitle HTA_Left VTA_Centre 270 _layout1_right_axis L1P_RightAxisTitle er = tval $ emptyRenderable- - atitle :: HTextAnchor -> VTextAnchor - -> Double - -> (Layout1 x y -> LayoutAxis z) - -> (String -> Layout1Pick x y) - -> (Grid (Renderable (Layout1Pick x y)), Grid (Renderable (Layout1Pick x y)))- atitle ha va rot af pf = if ttext == "" then (er,er) else (label,gap)- where- label = tval $ mapPickFn pf $ rlabel tstyle ha va rot ttext- gap = tval $ spacer (_layout1_margin l,0)- tstyle = _laxis_title_style (af l)- ttext = _laxis_title (af l) - plots = tval $ mfill (_layout1_plot_background l) $ plotsToRenderable l- where- mfill Nothing = id- mfill (Just fs) = fillBackground fs+ plots = tval $ lge_plots lge - (ba,la,ta,ra) = getAxes l+ (tdata,tlbl,tstyle) = lge_taxis lge+ (bdata,blbl,bstyle) = lge_baxis lge+ (ldata,llbl,lstyle) = lge_laxis lge+ (rdata,rlbl,rstyle) = lge_raxis lge++ (ttitle,_) = mktitle HTA_Centre VTA_Bottom 0 tlbl tstyle LayoutPick_XTopAxisTitle+ (btitle,_) = mktitle HTA_Centre VTA_Top 0 blbl bstyle LayoutPick_XBottomAxisTitle+ (ltitle,lam) = mktitle HTA_Right VTA_Centre 270 llbl lstyle LayoutPick_YLeftAxisTitle+ (rtitle,ram) = mktitle HTA_Left VTA_Centre 270 rlbl rstyle LayoutPick_YRightAxisTitle+ baxis = tval $ maybe emptyRenderable- (mapPickFn L1P_BottomAxis . axisToRenderable) ba+ (mapPickFn LayoutPick_XBottomAxis . axisToRenderable) bdata taxis = tval $ maybe emptyRenderable- (mapPickFn L1P_TopAxis . axisToRenderable) ta+ (mapPickFn LayoutPick_XTopAxis . axisToRenderable) tdata laxis = tval $ maybe emptyRenderable- (mapPickFn L1P_LeftAxis . axisToRenderable) la+ (mapPickFn LayoutPick_YLeftAxis . axisToRenderable) ldata raxis = tval $ maybe emptyRenderable- (mapPickFn L1P_RightAxis . axisToRenderable) ra-- tl = tval $ axesSpacer fst ta fst la- bl = tval $ axesSpacer fst ba snd la- tr = tval $ axesSpacer snd ta fst ra- br = tval $ axesSpacer snd ba snd ra--plotsToRenderable :: Layout1 x y -> Renderable (Layout1Pick x y)-plotsToRenderable l = Renderable {- minsize = return (0,0),- render = renderPlots l- }--renderPlots :: Layout1 x y -> RectSize -> ChartBackend (PickFn (Layout1Pick x y))-renderPlots l sz@(w,h) = do- when (not (_layout1_grid_last l)) renderGrids- withClipRegion (Rect (Point 0 0) (Point w h)) $ do- mapM_ rPlot (_layout1_plots l)- when (_layout1_grid_last l) renderGrids- return pickfn-- where- (bAxis,lAxis,tAxis,rAxis) = getAxes l+ (mapPickFn LayoutPick_YRightAxis . axisToRenderable) rdata - rPlot (Left p) = rPlot1 bAxis lAxis p- rPlot (Right p) = rPlot1 bAxis rAxis p+ tl = tval $ axesSpacer fst tdata fst ldata+ bl = tval $ axesSpacer fst bdata snd ldata+ tr = tval $ axesSpacer snd tdata fst rdata+ br = tval $ axesSpacer snd bdata snd rdata - xr = (0, w)- yr = (h, 0)- reverse rev (a,b) = if rev then (b,a) else (a,b)+ mktitle :: HTextAnchor -> VTextAnchor + -> Double+ -> String -> FontStyle+ -> (String -> LayoutPick x yl yr) + -> ( Grid (Renderable (LayoutPick x yl yr))+ , Grid (Renderable (LayoutPick x yl yr)) )+ mktitle ha va rot lbl style pf = if lbl == "" then (er,er) else (label,gap)+ where+ label = tval $ mapPickFn pf $ rlabel style ha va rot lbl+ gap = tval $ spacer (lge_margin lge,0) - rPlot1 (Just (AxisT _ xs xrev xaxis)) (Just (AxisT _ ys yrev yaxis)) p =- let - xr1 = reverse xrev xr- yr1 = reverse yrev yr- yrange = if yrev then (0, h) else (h, 0)- pmfn (x,y) = Point (mapv xr1 (_axis_viewport xaxis xr1) x)- (mapv yr1 (_axis_viewport yaxis yr1) y)- mapv (min,max) _ LMin = min- mapv (min,max) _ LMax = max- mapv _ f (LValue v) = f v- in _plot_render p pmfn- rPlot1 _ _ _ = return ()+-- | Render the grids of the given axis to a plot area of given size.+renderGrids :: RectSize -> (Maybe (AxisT x), Maybe (AxisT yl), Maybe (AxisT x), Maybe (AxisT yr)) -> ChartBackend ()+renderGrids sz (bAxis, lAxis, tAxis, rAxis) = do+ maybeM () (renderAxisGrid sz) tAxis+ maybeM () (renderAxisGrid sz) bAxis+ maybeM () (renderAxisGrid sz) lAxis+ maybeM () (renderAxisGrid sz) rAxis - pickfn (Point x y) = do -- Maybe monad- xat <- mxat- (yat1,yat2) <- myats- return (L1P_PlotArea (mapx xat x) (mapy yat1 y) (mapy yat2 y))- where- mxat = case (bAxis,tAxis) of- (Just at,_) -> Just at- (_,Just at) -> Just at- (Nothing,Nothing) -> Nothing- myats = case (lAxis,rAxis) of- (Just at,Nothing) -> Just (at,at)- (Nothing,Just at) -> Just (at,at)- (Just at1,Just at2) -> Just (at1,at2)- (Nothing,Nothing) -> Nothing- mapx (AxisT _ _ rev ad) x = _axis_tropweiv ad (reverse rev xr) x- mapy (AxisT _ _ rev ad) y = _axis_tropweiv ad (reverse rev yr) y+-- | Swap the contents of the pair depending on the flag.+optPairReverse :: Bool -> (a,a) -> (a,a)+optPairReverse rev (a,b) = if rev then (b,a) else (a,b) - renderGrids = do- maybeM () (renderAxisGrid sz) tAxis- maybeM () (renderAxisGrid sz) bAxis- maybeM () (renderAxisGrid sz) lAxis- maybeM () (renderAxisGrid sz) rAxis+-- | Render a single set of plot data onto a plot area of given size using+-- the given x and y axis.+renderSinglePlot :: RectSize -> Maybe (AxisT x) -> Maybe (AxisT y) -> Plot x y -> ChartBackend ()+renderSinglePlot (w, h) (Just (AxisT _ xs xrev xaxis)) (Just (AxisT _ ys yrev yaxis)) p =+ let xr = optPairReverse xrev (0, w)+ yr = optPairReverse yrev (h, 0)+ yrange = if yrev then (0, h) else (h, 0)+ pmfn (x,y) = Point (mapv xr (_axis_viewport xaxis xr) x)+ (mapv yr (_axis_viewport yaxis yr) y)+ mapv (min,max) _ LMin = min+ mapv (min,max) _ LMax = max+ mapv _ f (LValue v) = f v+ in _plot_render p pmfn+renderSinglePlot _ _ _ _ = return () +axesSpacer :: (Ord x, Ord y) + => ((Double, Double) -> Double) -> Maybe (AxisT x)+ -> ((Double, Double) -> Double) -> Maybe (AxisT y)+ -> Renderable a axesSpacer f1 a1 f2 a2 = embedRenderable $ do oh1 <- maybeM (0,0) axisOverhang a1 oh2 <- maybeM (0,0) axisOverhang a2 return (spacer (f1 oh1, f2 oh2)) -getAxes :: Layout1 x y ->- (Maybe (AxisT x), Maybe (AxisT y), Maybe (AxisT x), Maybe (AxisT y))-getAxes l = (bAxis,lAxis,tAxis,rAxis)+-- | Construct a axis for the given edge using the attributes +-- from a 'LayoutAxis' the given values.+mkAxis :: RectEdge -> LayoutAxis z -> [z] -> Maybe (AxisT z)+mkAxis edge laxis vals = case axisVisible of+ False -> Nothing+ True -> Just $ AxisT edge style rev adata where- (xvals0,xvals1,yvals0,yvals1) = allPlottedValues (_layout1_plots l)- xvals = xvals0 ++ xvals1- (yvals0',yvals1') = _layout1_yaxes_control l (yvals0,yvals1)-- bAxis = mkAxis E_Bottom (_layout1_bottom_axis l) xvals- tAxis = mkAxis E_Top (_layout1_top_axis l) xvals- lAxis = mkAxis E_Left (_layout1_left_axis l) yvals0'- rAxis = mkAxis E_Right (_layout1_right_axis l) yvals1'-- mkAxis t laxis vals = case _laxis_visible laxis vals of- False -> Nothing- True -> Just (AxisT t style rev adata)- where- style = _laxis_style laxis- rev = _laxis_reverse laxis- adata = (_laxis_override laxis) (_laxis_generate laxis vals)+ style = _laxis_style laxis+ rev = _laxis_reverse laxis+ adata = (_laxis_override laxis) (_laxis_generate laxis vals)+ vis = _axis_visibility adata+ axisVisible = _axis_show_labels vis || _axis_show_line vis || _axis_show_ticks vis -allPlottedValues :: [(Either (Plot x y) (Plot x' y'))]- -> ( [x], [x'], [y], [y'] )-allPlottedValues plots = (xvals0,xvals1,yvals0,yvals1)- where- xvals0 = [ x | (Left p) <- plots, x <- fst $ _plot_all_points p]- yvals0 = [ y | (Left p) <- plots, y <- snd $ _plot_all_points p]- xvals1 = [ x | (Right p) <- plots, x <- fst $ _plot_all_points p]- yvals1 = [ y | (Right p) <- plots, y <- snd $ _plot_all_points p]+-- | Override the visibility of a selected axis with the selected 'AxisVisibility'.+overrideAxisVisibility :: layout + -> (layout -> LayoutAxis z) + -> (layout -> AxisVisibility) + -> LayoutAxis z +overrideAxisVisibility ly selAxis selVis = + let vis = selVis ly+ in (selAxis ly) { _laxis_override = (\ad -> ad { _axis_visibility = selVis ly }) + . _laxis_override (selAxis ly)+ } -{-# DEPRECATED defaultLayout1 "Use the according Data.Default instance!" #-}-defaultLayout1 :: (PlotValue x,PlotValue y) => Layout1 x y-defaultLayout1 = def+mfill :: Maybe FillStyle -> Renderable a -> Renderable a+mfill Nothing = id+mfill (Just fs) = fillBackground fs -instance (PlotValue x, PlotValue y) => Default (Layout1 x y) where- def = Layout1 - { _layout1_background = solidFillStyle $ opaque white- , _layout1_plot_background = Nothing+-- | Empty 'LayoutLR' without title and plots. The background is white and +-- the grid is drawn beneath all plots. There will be a legend. The top+-- axis will not be visible.+instance (PlotValue x, PlotValue y1, PlotValue y2) => Default (LayoutLR x y1 y2) where+ def = LayoutLR+ { _layoutlr_background = solidFillStyle $ opaque white+ , _layoutlr_plot_background = Nothing - , _layout1_title = ""- , _layout1_title_style = def { _font_size = 15- , _font_weight = FontWeightBold }+ , _layoutlr_title = ""+ , _layoutlr_title_style = def { _font_size = 15+ , _font_weight = FontWeightBold } - , _layout1_top_axis = def {_laxis_visible = const False}- , _layout1_bottom_axis = def- , _layout1_left_axis = def- , _layout1_right_axis = def+ , _layoutlr_x_axis = def+ , _layoutlr_top_axis_visibility = def { _axis_show_line = False+ , _axis_show_ticks = False+ , _axis_show_labels = False }+ , _layoutlr_bottom_axis_visibility = def - , _layout1_yaxes_control = id+ , _layoutlr_left_axis = def+ , _layoutlr_left_axis_visibility = def+ , _layoutlr_right_axis = def+ , _layoutlr_right_axis_visibility = def+ + , _layoutlr_plots = [] - , _layout1_margin = 10- , _layout1_plots = []- , _layout1_legend = Just def- , _layout1_grid_last = False+ , _layoutlr_legend = Just def+ , _layoutlr_margin = 10+ , _layoutlr_grid_last = False } {-# DEPRECATED defaultLayoutAxis "Use the according Data.Default instance!" #-}@@ -496,7 +771,6 @@ { _laxis_title_style = def { _font_size=10 } , _laxis_title = "" , _laxis_style = def- , _laxis_visible = not.null , _laxis_generate = autoAxis , _laxis_override = id , _laxis_reverse = False@@ -505,28 +779,34 @@ ---------------------------------------------------------------------- -- Template haskell to derive an instance of Data.Accessor.Accessor -- for each field.-$( makeLenses ''Layout1 )+$( makeLenses ''Layout )+$( makeLenses ''LayoutLR ) $( makeLenses ''LayoutAxis ) $( makeLenses ''StackedLayouts ) -- | Helper to update all axis styles on a Layout1 simultaneously.-updateAllAxesStyles :: (AxisStyle -> AxisStyle) -> Layout1 x y -> Layout1 x y-updateAllAxesStyles uf = (layout1_top_axis . laxis_style %~ uf) .- (layout1_bottom_axis . laxis_style %~ uf) .- (layout1_left_axis . laxis_style %~ uf) .- (layout1_right_axis . laxis_style %~ uf)+updateAllAxesStyles :: (AxisStyle -> AxisStyle) -> Layout x y -> Layout x y+updateAllAxesStyles uf = (layout_x_axis . laxis_style %~ uf) .+ (layout_y_axis . laxis_style %~ uf) --- | Helper to set the forground color uniformly on a Layout1.-setLayout1Foreground :: AlphaColour Double -> Layout1 x y -> Layout1 x y-setLayout1Foreground fg =+-- | Helper to update all axis styles on a LayoutLR simultaneously.+updateAllAxesStylesLR :: (AxisStyle -> AxisStyle) -> LayoutLR x yl yr -> LayoutLR x yl yr+updateAllAxesStylesLR uf = (layoutlr_x_axis . laxis_style %~ uf)+ . (layoutlr_left_axis . laxis_style %~ uf)+ . (layoutlr_right_axis . laxis_style %~ uf)++-- | Helper to set the forground color uniformly on a Layout.+setLayoutForeground :: AlphaColour Double -> Layout x y -> Layout x y+setLayoutForeground fg = updateAllAxesStyles ( (axis_line_style . line_color .~ fg) . (axis_label_style . font_color .~ fg))- . (layout1_title_style . font_color .~ fg)- . (layout1_legend %~ fmap (legend_label_style .> font_color .~ fg))---linkAxes :: ([a], [a]) -> ([a], [a])-linkAxes (ys1,ys2) = (ys1++ys2,ys1++ys2)+ . (layout_title_style . font_color .~ fg)+ . (layout_legend %~ fmap (legend_label_style .> font_color .~ fg)) -independentAxes :: (a, b) -> (a, b)-independentAxes (ys1,ys2) = (ys1,ys2)+-- | Helper to set the forground color uniformly on a LayoutLR.+setLayoutLRForeground :: AlphaColour Double -> LayoutLR x yl yr -> LayoutLR x yl yr+setLayoutLRForeground fg = updateAllAxesStylesLR + ( (axis_line_style . line_color .~ fg)+ . (axis_label_style . font_color .~ fg))+ . (layoutlr_title_style . font_color .~ fg)+ . (layoutlr_legend %~ fmap (legend_label_style .> font_color .~ fg))
Graphics/Rendering/Chart/Plot/Bars.hs view
@@ -69,8 +69,8 @@ -- | How bars for a given (x,[y]) are aligned with respect to screen -- coordinate corresponding to x (deviceX). data PlotBarsAlignment = BarsLeft -- ^ The left edge of bars is at deviceX- | BarsCentered -- ^ The right edge of bars is at deviceX- | BarsRight -- ^ Bars are centered around deviceX+ | BarsCentered -- ^ Bars are centered around deviceX+ | BarsRight -- ^ The right edge of bars is at deviceX deriving (Show) -- | Value describing how to plot a set of bars.
Graphics/Rendering/Chart/Simple.hs view
@@ -27,8 +27,8 @@ ----------------------------------------------------------------------------- module Graphics.Rendering.Chart.Simple( plot, PlotKind(..), xcoords, plotPDF, plotPS,- plotLayout, plotPNG, Layout1DDD,- layout1DddToRenderable+ plotLayout, plotPNG, LayoutDDD,+ layoutDddToRenderable , PlotPDFType(..) , PlotPSType(..) , PlotPNGType(..)
Graphics/Rendering/Chart/Simple/Internal.hs view
@@ -21,11 +21,9 @@ , Triangle, DownTriangle, Plus, Star , FilledCircle ] --- When defaultLayout1 has been generalized, change this signature to --- [InternalPlot x y] -> Layout1 x y z-iplot :: [InternalPlot Double Double] -> Layout1 Double Double-iplot foobar = (def :: Layout1 Double Double) {- _layout1_plots = concat $ zipWith toplot (ip foobar) [0..]+iplot :: (PlotValue x, PlotValue y) => [InternalPlot x y] -> Layout x y+iplot foobar = def {+ _layout_plots = concat $ zipWith toplot (ip foobar) [0..] } where ip (xs@(IPX _ _):xyss) = map (\ys -> (xs,ys)) yss ++ ip rest@@ -35,7 +33,7 @@ ip [] = [] isIPY (IPY _ _) = True isIPY _ = False- toplot (IPX xs _, IPY ys yks) ind = map Left plots+ toplot (IPX xs _, IPY ys yks) ind = plots where vs = zip xs ys plots = case catMaybes $ map plotas yks of@@ -140,16 +138,16 @@ deriving ( Eq, Show, Ord ) data InternalPlot x y = IPY [y] [PlotKind] | IPX [x] [PlotKind] -newtype Layout1DDD = Layout1DDD { plotLayout :: Layout1 Double Double }+newtype LayoutDDD = LayoutDDD { plotLayout :: Layout Double Double } -layout1DddToRenderable :: Layout1DDD -> Renderable (Layout1Pick Double Double)-layout1DddToRenderable = layout1ToRenderable . plotLayout+layoutDddToRenderable :: LayoutDDD -> Renderable (LayoutPick Double Double Double)+layoutDddToRenderable = layoutToRenderable . plotLayout -instance ToRenderable Layout1DDD where+instance ToRenderable LayoutDDD where toRenderable = setPickFn nullPickFn . toRenderable -uplot :: [UPlot] -> Layout1DDD-uplot us = Layout1DDD $ iplot $ nameDoubles $ evalfuncs us+uplot :: [UPlot] -> LayoutDDD+uplot us = LayoutDDD $ iplot $ nameDoubles $ evalfuncs us where nameDoubles :: [UPlot] -> [InternalPlot Double Double] nameDoubles (X xs: uus) = case grabName uus of@@ -191,7 +189,7 @@ pl :: [UPlot] -> t instance (PlotArg a, PlotType r) => PlotType (a -> r) where pl args = \ a -> pl (toUPlot a ++ args)-instance PlotType Layout1DDD where+instance PlotType LayoutDDD where pl args = uplot (reverse args) -- | Save a plot as a PDF file.